根據其他列滿足的條件計算列的行平均

Question

我想根據其他列中的值對某些列進行行平均。 如果我們采用以下數據集：

library(data.table)
test <- data.table(s1=c(0,4,29,9,1,2,10),
                   s2=c(20,17,11,15,32,15,10),
                   s3=c(1,0,2,1,4,7,0),
                   m1=c(0,4,29,NA,1,22,8),
                   m2=c(20,17,NA,15,32,15,12),
                   m3=c(1,0,1,1,1,NA,0),
                   z=c(1,5,25,5,30,20,10)
)

我想取s1, s2, s3平均值s1, s2, s3並根據m1, m2, m3 ， z值創建一個新列； 具體使用以下條件。

ifelse( !is.na(m) & m<z, s, NA)

也就是說，如果m不是NA且m < z ，則僅將s用於行平均。

截至目前，我已經完成了這項工作，但似乎太冗長了

test[,t1:=ifelse(!is.na(m1) & m1<z,s1,NA),]
test[,t2:=ifelse(!is.na(m2) & m2<z,s2,NA),]
test[,t3:=ifelse(!is.na(m3) & m3<z,s3,NA),]

test[,s_avg:=rowMeans(.SD,na.rm = TRUE),.SDcols=c('t1','t2','t3')]

也將理解替代的數據data.frame解決方案。

編輯：不需要t列。

Answer 1

一種選擇是使用Map對“ s”和“ m”的相應列進行比較

nm1 <- grep("s\\d+", names(test), value = TRUE)
nm2 <- grep("m\\d+", names(test), value = TRUE)
test[, paste0("t", 1:3) := Map(function(x, y) 
         ifelse(y < z & !is.na(y), x, NA), .SD[, ..nm1], .SD[, ..nm2]) ]

然后，執行OP中的最后一步。 目前尚不清楚OP是否需要“ t”列。

test[,s_avg:=rowMeans(.SD,na.rm = TRUE),.SDcols=c('t1','t2','t3')]
test
#    s1 s2 s3 m1 m2 m3  z t1 t2 t3 s_avg
#1:  0 20  1  0 20  1  1  0 NA NA   0.0
#2:  4 17  0  4 17  0  5  4 NA  0   2.0
#3: 29 11  2 29 NA  1 25 NA NA  2   2.0
#4:  9 15  1 NA 15  1  5 NA NA  1   1.0
#5:  1 32  4  1 32  1 30  1 NA  4   2.5
#6:  2 15  7 22 15 NA 20 NA 15 NA  15.0
#7: 10 10  0  8 12  0 10 10 NA  0   5.0

如果我們不需要't'列，則可以在上面的步驟中創建s_avg

test[,  s_avg := rowMeans(mapply(function(x, y) x *(NA^!(y < z & !is.na(y))),
                     .SD[, ..nm1], .SD[, ..nm2]), na.rm = TRUE) ]
test
#   s1 s2 s3 m1 m2 m3  z s_avg
#1:  0 20  1  0 20  1  1   0.0
#2:  4 17  0  4 17  0  5   2.0
#3: 29 11  2 29 NA  1 25   2.0
#4:  9 15  1 NA 15  1  5   1.0
#5:  1 32  4  1 32  1 30   2.5
#6:  2 15  7 22 15 NA 20  15.0
#7: 10 10  0  8 12  0 10   5.0

甚至grep步驟都可以在上面的代碼行中完成。

---

另一種選擇是在創建行索引后將其melt為“長”格式，然后對索引進行連接以創建“ s_avg”

test[, ind := seq_len(.N)]
test[melt(test, measure = patterns("^s\\d+", "^m\\d+"),
     value.name = c("s", "m"))[!is.na(m) & m < z][, 
     .(s_avg = mean(s, na.rm = TRUE)), ind], 
             on = .(ind)][order(ind)][, ind := NULL][]
#    s1 s2 s3 m1 m2 m3  z s_avg
#1:  0 20  1  0 20  1  1   0.0
#2:  4 17  0  4 17  0  5   2.0
#3: 29 11  2 29 NA  1 25   2.0
#4:  9 15  1 NA 15  1  5   1.0
#5:  1 32  4  1 32  1 30   2.5
#6:  2 15  7 22 15 NA 20  15.0
#7: 10 10  0  8 12  0 10   5.0

Answer 2

似乎您不需要ifelse 。 只需使用i表達。

iter <- 1:3
t <- paste0("t", iter)
s <- paste0("s", iter)
m <- paste0("m", iter)
for (i in iter) test[!is.na(get(m[i])) & get(m[i]) < z, (t[i]) := get(s[i])]
test[, s_avg := rowMeans(.SD, na.rm = TRUE), .SDcols = t]
print(test)
#>    s1 s2 s3 m1 m2 m3  z t1 t2 t3 s_avg
#> 1:  0 20  1  0 20  1  1  0 NA NA   0.0
#> 2:  4 17  0  4 17  0  5  4 NA  0   2.0
#> 3: 29 11  2 29 NA  1 25 NA NA  2   2.0
#> 4:  9 15  1 NA 15  1  5 NA NA  1   1.0
#> 5:  1 32  4  1 32  1 30  1 NA  4   2.5
#> 6:  2 15  7 22 15 NA 20 NA 15 NA  15.0
#> 7: 10 10  0  8 12  0 10 10 NA  0   5.0

Answer 3

方法1：

test[ , avg := rowMeans( test[, .(ifelse( m1 < z, s1, NA),
                                  ifelse( m2 < z, s2, NA),
                                  ifelse( m3 < z, s3, NA)) ],
                         na.rm = TRUE ) ]

方法2：使用表達式

expr <- paste0("ifelse( m", 1:3, " < z, s", 1:3, ", NA )")
test[ , avg := rowMeans( test[, lapply( expr, function(x) eval(parse(text = x)))],
                         na.rm = TRUE ) ]

輸出：

test
#    Time Zone quadrat s1 s2 s3 m1 m2 m3  z  avg
# 1:    0    1       1  0 20  1  0 20  1  1  0.0
# 2:    0    1       2  4 17  0  4 17  0  5  2.0
# 3:    0    0       3 29 11  2 29 NA  1 25  2.0
# 4:    7    1       1  9 15  1 NA 15  1  5  1.0
# 5:    7    0       2  1 32  4  1 32  1 30  2.5
# 6:    7    0       3  2 15  7 22 15 NA 20 15.0
# 7:   12    1       1 10 10  0  8 12  0 10  5.0