需要识别满足 R 中复杂逻辑条件的所有行

Question

我有一个数据表/数据框，其中包含一些逻辑向量列 - 每个逻辑向量代表每周调查中某个物种的存在与否。我想确定那些物种存在超过 21 天或更长时间的行 - 物种未被记录的时间段是无关紧要的）。

这意味着我需要识别所有那些 'TRUE' 存在于至少 2 列中的行（仅在下面的示例中的列名中带有“检测到”的那些列）相隔 3 列或更多列（因为每一列代表每周调查）。

所以如果V1 和 V4 是 TRUE，我的 'result' 列是 TRUE。如果只有 V6、V7、V8 为 TRUE，则我的结果列为 FALSE。如果 V2 和 V9 为 TRUE，我的结果为 TRUE 等等

这是更大模拟的一部分，dt 中的列数（以及每周调查的数量）因其他模拟参数而异，因此无法使用列索引来完成。但是感兴趣的列都可以被赋予相同的后缀 ('detected')，如以下示例代码所示。

dt 中还有其他 TRUE/FALSE 列（没有 'detected' 后缀）。

示例数据：

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

Answer 1

您可以使用 melt 和 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

Answer 2

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)

Answer 3

我得到的结果与所选答案不同。也许我误解了 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

Answer 4

只是在感兴趣的情况下发布 - 我比较了每个解决方案的时间 - 将 dt 的宽度固定为 8 个逻辑向量并测试具有 20 行（short.dt）和 2000 行（long.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

需要识别满足 R 中复杂逻辑条件的所有行

Need to identify all rows meeting a complex logical condition in R

if-statement

r

logical-operators

data.table