如何根据重量复制观察结果答案

【问题标题】：How to replicate observations based on weight如何根据重量复制观察结果
【发布时间】：2016-12-01 14:57:47
【问题描述】：

假设我们有，

library(data.table)
dt <- data.table(id = 1:4, x1 = 10:13, x2=21:24, wt=c(1,0,0.5,0.7))

返回，

   id x1 x2  wt
1:  1 10 21 1.0
2:  2 11 22 0.0
3:  3 12 23 0.5
4:  4 13 24 0.7

我想在以下条件下复制观察结果：

如果wt 为0 或1，我们将flag 分别赋值为1 和0
如果 0 wt flag 赋值为 0。此外，我们使用 wt = 1-wt 复制此观察结果并将 flag 赋值为 1。

我期望的回报是

   id x1 x2  wt flag
1:  1 10 21 1.0    0
2:  2 11 22 0.0    1
3:  3 12 23 0.5    0
4:  3 12 23 0.5    1
5:  4 13 24 0.7    0
6:  4 13 24 0.3    1

我已经尝试过我的代码

dt[,flag:=ifelse(wt==1,0, ifelse(wt==0, 1, 0))]
dt[,freq:=ifelse(wt > 0 & wt < 1, 2, 1)]
dtr <- dt[rep(1:.N, freq)][,Indx:=1:.N, by = id]
dtr[freq==2&Indx==2, wt:=1-wt]
dtr[Indx==2,flag:=1]
dtr[,`:=`(freq=NULL, Indx=NULL)]

但是，我认为它没有效率。

你有什么建议吗？

【问题讨论】：

在data.table 中按行工作将是低效的。我建议使用base R 解决方案。

标签： r data.table

【解决方案1】：

这是使用数据框的一种方式：

dt <- data.frame(id = 1:4, x1 = 10:13, x2=21:24, wt=c(1,0,0.5,0.7))

# create the flag column
dt$flag = 1 - ceiling(dt$wt)

#create a new data frame with the rows that fulfill condition 2 
dt2 = dt[dt$wt < 1 && dt$wt > 0, ]
dt2$wt = 1 - dt2$wt
dt2$flag = 1

#rbind it to the original data frame and reorder by id
dt = rbind(dt,dt2)
dt = dt[order(dt$id),]

结果：

   id x1 x2  wt flag
1   1 10 21 1.0    0
2   2 11 22 0.0    1
3   3 12 23 0.5    0
31  3 12 23 0.5    1
4   4 13 24 0.7    0
41  4 13 24 0.3    1

【讨论】：

【解决方案2】：

我们可以更改一些步骤以使其更紧凑，即删除ifelse并通过将逻辑转换为二进制直接使用赋值，复制行而不创建列，然后获取索引（'i1'）分配 'flag' 和 'wt' 中的值。

dt1 <- dt[, flag := +(wt == 0)][rep(1:.N, (wt > 0 & wt < 1) +1)][]
i1 <- dt1[, .I[seq_len(.N)==2], id]$V1
dt1[i1, c('flag', 'wt') := .(1, 1-wt)][]
#    id x1 x2  wt flag
#1:  1 10 21 1.0    0
#2:  2 11 22 0.0    1
#3:  3 12 23 0.5    0
#4:  3 12 23 0.5    1
#5:  4 13 24 0.7    0
#6:  4 13 24 0.3    1

【讨论】：

【解决方案3】：

tidyverse 方式：

dt2 <- dt %>%
  mutate( flag = if_else(wt == 0, 1, 0, missing = NULL)) %>%
  mutate( flag = if_else(wt == 1, 0, flag, missing = NULL)) %>%
  mutate( flag2 = if_else(wt %in% c(1,0), 1, 2, missing = NULL)) %>%
  slice(rep(1:n(), flag2)) %>%
  group_by(id) %>%
  mutate( wt = if_else( row_number() == 1, 1-wt, wt, missing = NULL)) %>%
  mutate( flag = if_else( row_number() == 1, 1, flag, missing = NULL)) %>%
  select(id, x1, x2, wt, flag)

这给了

#Source: local data frame [6 x 5]
#Groups: id [4]
#
#     id    x1    x2    wt  flag
#  <int> <int> <int> <dbl> <dbl>
#1     1    10    21   0.0     1
#2     2    11    22   1.0     1
#3     3    12    23   0.5     1
#4     3    12    23   0.5     0
#5     4    13    24   0.3     1
#6     4    13    24   0.7     0

附言我认为我们改变组中的第一行或最后一行并不重要，所以我选择了row_number() == 1

【讨论】：