我有一個包含一些邏輯向量列的資料表/資料框 - 每個邏輯向量代表每周調查中某個物種的存在或不存在。我想確定該物種在 21 天或更長時間記憶體在的那些行 - 物種未記錄在其間的時期是無關緊要的）。
這意味著我需要識別至少 2 列中存在“TRUE”的所有行（僅在下面的示例中的列名中具有“檢測到”的那些列）相隔 3 列或更多列（因為每列代表每周民意調查）。
因此，如果例如 V1 和 V4 為 TRUE，則我的“結果”列為 TRUE。如果只有 V6、V7、V8 為 TRUE，則我的結果列為 FALSE。如果 V2 和 V9 為 TRUE，我的結果為 TRUE 等。
這是更大模擬的一部分，dt 中的列數（以及每周調查的數量）取決于其他模擬引數，因此無法使用列索引來實作。但是可以為感興趣的列都賦予相同的后綴（“檢測到”），如下面的示例代碼所示。
dt 中還有其他 TRUE/FALSE 列（不以“檢測到”為后綴）。
示例資料：
library(data.table)
set.seed(123)
#first column
colref <- 1:20
#number of columns will vary in the dt, so here we generate a random number
n<-sample(5:10,1)
# function to create some logical vectors for the dt
create.col<-function(n){replicate(n,sample(c(TRUE,FALSE),20,replace=TRUE,prob = c(0.2,0.8)),simplify=FALSE)}
# create the dt
dt<-setDT(create.col(n))
# affix "detected" to columns of interest
colnames(dt) <- paste("detected", colnames(dt), sep = "_")
dt<-data.table(colref,dt)
dt
# need to create logical vector 'result' column identifying rows where TRUE is present in columns separated by three or more positions in the dt, with the 'detected' suffix
uj5u.com熱心網友回復：
你可以使用meltand rle：
melt(dt,id.vars="colref")[,.(detect=with(rle(value),
which.max(!values & lengths>=3)>1&sum(values)>1))
,by=colref]
colref detect
<int> <lgcl>
1: 1 TRUE
2: 2 TRUE
3: 3 FALSE
4: 4 FALSE
5: 5 FALSE
6: 6 FALSE
7: 7 FALSE
8: 8 TRUE
9: 9 TRUE
10: 10 FALSE
11: 11 FALSE
12: 12 FALSE
13: 13 FALSE
14: 14 FALSE
15: 15 FALSE
16: 16 TRUE
17: 17 FALSE
18: 18 FALSE
19: 19 FALSE
20: 20 FALSE
colref detected
uj5u.com熱心網友回復：
library(tidyverse)
check_three_apart <- function(x) {
# for logical vector x, check if any TRUEs spaced at least 3 indices away
spacing <- which(x) %>% diff()
if (is_empty(spacing)) {
return(FALSE)
} else {
return(any(spacing >= 3))
}
}
dt <- dt %>%
mutate(three_apart = select(., starts_with("detected")) %>% apply(1, check_three_apart))
print(dt)
uj5u.com熱心網友回復：
我得到的結果與所選答案不同。也許我誤解了 OP 的要求。
unique(melt(dt, id="colref",measure=patterns("detected"),value.name = "result") %>%
.[, id:=1:.N, by=.(colref)] %>%
.[result==T] %>%
.[order(colref,variable), diff:=id-shift(id), by=.(colref)] %>%
.[diff>=3,.(colref,result)])[dt, on="colref"]
輸出：
colref result detected_V1 detected_V2 detected_V3 detected_V4 detected_V5 detected_V6 detected_V7
<int> <lgcl> <lgcl> <lgcl> <lgcl> <lgcl> <lgcl> <lgcl> <lgcl>
1: 1 TRUE TRUE TRUE FALSE FALSE FALSE TRUE FALSE
2: 2 TRUE TRUE FALSE FALSE TRUE FALSE FALSE FALSE
3: 3 NA FALSE FALSE FALSE FALSE FALSE TRUE TRUE
4: 4 NA FALSE FALSE FALSE TRUE TRUE TRUE FALSE
5: 5 TRUE TRUE FALSE FALSE TRUE TRUE FALSE FALSE
6: 6 NA FALSE FALSE FALSE FALSE TRUE FALSE FALSE
7: 7 NA FALSE FALSE TRUE FALSE FALSE FALSE FALSE
8: 8 TRUE TRUE TRUE FALSE FALSE FALSE TRUE FALSE
9: 9 TRUE FALSE TRUE FALSE FALSE FALSE FALSE TRUE
10: 10 NA FALSE FALSE FALSE FALSE FALSE FALSE FALSE
11: 11 NA FALSE FALSE FALSE FALSE FALSE TRUE FALSE
12: 12 NA FALSE FALSE FALSE FALSE FALSE FALSE FALSE
13: 13 NA TRUE FALSE FALSE FALSE FALSE FALSE FALSE
14: 14 NA FALSE FALSE FALSE FALSE FALSE FALSE TRUE
15: 15 NA FALSE FALSE FALSE FALSE FALSE TRUE FALSE
16: 16 TRUE FALSE FALSE TRUE FALSE FALSE FALSE TRUE
17: 17 NA TRUE FALSE FALSE FALSE FALSE FALSE FALSE
18: 18 NA TRUE FALSE FALSE FALSE FALSE FALSE FALSE
19: 19 NA FALSE FALSE FALSE FALSE FALSE FALSE FALSE
20: 20 NA FALSE FALSE FALSE FALSE FALSE FALSE FALSE
uj5u.com熱心網友回復：
只是在感興趣的情況下發布 - 我比較了每個解決方案的時間 - 將 dt 的寬度固定為 8 個邏輯向量并測驗 20 行（short.dt）和 2000 行（long.dt）的 dt。其他一切與上面的示例相同。
短 dt 的最快解決方案是長 dt 的最慢解決方案，這真的很有趣。
bm.long = microbenchmark(
long.chk_3_apart = long.dt %>% mutate(three_apart = select(., starts_with("detected")) %>% apply(1, check_three_apart)),
long.unique = unique(data.table::melt(long.dt, id="colref",measure=patterns("detected"),value.name = "result") %>%
.[, id:=1:.N, by=.(colref)] %>%
.[result==T] %>%
.[order(colref,variable), diff:=id-shift(id), by=.(colref)] %>%
.[diff>=3,.(colref,result)])[long.dt, on="colref"],
long.melt = data.table::melt(long.dt,id.vars="colref")[,.(detect=with(rle(value),which.max(!values & lengths>=3)>1&sum(values)>1)),by=colref]
)
bm.short = microbenchmark(
short.chk_3_apart = short.dt %>% mutate(three_apart = select(., starts_with("detected")) %>% apply(1, check_three_apart)),
short.unique = unique(data.table::melt(short.dt, id="colref",measure=patterns("detected"),value.name = "result") %>%
.[, id:=1:.N, by=.(colref)] %>%
.[result==T] %>%
.[order(colref,variable), diff:=id-shift(id), by=.(colref)] %>%
.[diff>=3,.(colref,result)])[short.dt, on="colref"],
short.melt = data.table::melt(short.dt,id.vars="colref")[,.(detect=with(rle(value),which.max(!values & lengths>=3)>1&sum(values)>1)),by=colref]
)
bm.long
Unit: milliseconds
expr min lq mean median uq max neval
long.chk_3_apart 23.9713 28.10315 30.72980 28.97950 33.56685 42.4375 100
long.unique 29.0775 33.97245 37.18426 35.78765 40.09710 53.4566 100
long.melt 46.0760 51.91215 56.63633 55.82730 58.76905 112.5073 100
> bm.short
Unit: microseconds
expr min lq mean median uq max neval
short.chk_3_apart 2620.7 2979.55 3666.362 3295.95 3662.30 12386.6 100
short.unique 3716.9 4261.35 4697.893 4382.30 4804.35 11289.2 100
short.melt 941.5 1078.95 1161.753 1137.45 1214.90 1749.4 100
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/432496.html