R:如何按组查找数据帧中的第一个非零元素

Question

我有以下数据框

ID     date        Flag
ABC    2018-03-21  N/A
ABC    2018-03-17  0
ABC    2018-03-12  0 
ABC    2018-03-10  0 
ABC    2018-03-09  1
ABC    2018-03-08  0
ABC    2018-03-07  1
DEF    2018-03-24  N/A
DEF    2018-03-21  0
DEF    2018-03-20  0
DEF    2018-03-14  0
DEF    2018-03-13  0
DEF    2018-03-12  0
DEF    2018-03-11  0
DEF    2018-03-10  0
DEF    2018-03-09  0       
DEF    2018-03-08  1       
DEF    2018-03-07  0
DEF    2018-03-06  0
DEF    2018-03-05  1

我想对这个数据集进行子集化，这样我就只在每个组的第一个记录和标志列中的第一个 1 值之间有行，如果没有 1，则该组根本不应该出现。

类似这样的事情:

ID     date        Flag
ABC    2018-03-21  N/A
ABC    2018-03-17  0
ABC    2018-03-12  0 
ABC    2018-03-10  0 
DEF    2018-03-24  N/A
DEF    2018-03-21  0
DEF    2018-03-20  0
DEF    2018-03-14  0
DEF    2018-03-13  0
DEF    2018-03-12  0
DEF    2018-03-11  0
DEF    2018-03-10  0
DEF    2018-03-09  0          

我在 Dplyr : how to find the first-non missing string by groups? 看到了一些答案但它是非缺失值，我有非缺失值和 0 值。

Answer 1

library(data.table)
setDT(df)

df[, if(1 %in% Flag) head(.SD, which.max(Flag == 1) - 1)
   , by = ID]

#      ID       date Flag
#  1: ABC 2018-03-21   NA
#  2: ABC 2018-03-17    0
#  3: ABC 2018-03-12    0
#  4: ABC 2018-03-10    0
#  5: DEF 2018-03-24   NA
#  6: DEF 2018-03-21    0
#  7: DEF 2018-03-20    0
#  8: DEF 2018-03-14    0
#  9: DEF 2018-03-13    0
# 10: DEF 2018-03-12    0
# 11: DEF 2018-03-11    0
# 12: DEF 2018-03-10    0
# 13: DEF 2018-03-09    0

或者在dplyr中(相同的结果)

library(dplyr)
df %>% 
  group_by(ID) %>% 
  filter(1 %in% Flag) %>% 
  slice(1:(which.max(Flag == 1) - 1))

使用的数据:

df <- fread("
ID     date        Flag
ABC    2018-03-21  NA
ABC    2018-03-17  0
ABC    2018-03-12  0 
ABC    2018-03-10  0 
ABC    2018-03-09  1
ABC    2018-03-08  0
ABC    2018-03-07  1
DEF    2018-03-24  NA
DEF    2018-03-21  0
DEF    2018-03-20  0
DEF    2018-03-14  0
DEF    2018-03-13  0
DEF    2018-03-12  0
DEF    2018-03-11  0
DEF    2018-03-10  0
DEF    2018-03-09  0       
DEF    2018-03-08  1       
DEF    2018-03-07  0
DEF    2018-03-06  0
DEF    2018-03-05  1
")

基准输出:

# Unit: relative
#  expr       min       lq     mean   median       uq       max neval
#   ry0 1.0000000 1.000000 1.000000 1.000000 1.000000 1.0000000   100
#   ry1 0.9039601 1.005675 1.107913 1.007259 1.013925 0.9834608   100
#   ry2 4.1922470 4.119451 3.833156 4.054261 4.064153 2.1996109   100
#   mkr 2.7526006 2.860652 2.734473 2.851795 2.780521 1.4623569   100
#   www 5.8029974 5.601037 5.293515 5.588397 5.372007 1.5343666   100
#   leb 6.8563589 6.548586 6.687608 6.461585 6.991874 2.2607231   100
#   mm1 1.8219038 1.782887 1.464588 1.791532 1.669813 0.2896809   100
#   mm2 6.0007823 5.806987 5.393869 5.679563 5.672251 1.7103423   100
#   mm3 2.1094639 2.372948 2.899198 2.437456 2.270863 1.8811060   100

基准代码:

df <- read.table(text="ID     date        Flag
ABC    2018-03-21  NA
ABC    2018-03-17  0
ABC    2018-03-12  0 
ABC    2018-03-10  0 
ABC    2018-03-09  1
ABC    2018-03-08  0
ABC    2018-03-07  1
DEF    2018-03-24  NA
DEF    2018-03-21  0
DEF    2018-03-20  0
DEF    2018-03-14  0
DEF    2018-03-13  0
DEF    2018-03-12  0
DEF    2018-03-11  0
DEF    2018-03-10  0
DEF    2018-03-09  0       
DEF    2018-03-08  1       
DEF    2018-03-07  0
DEF    2018-03-06  0
DEF    2018-03-05  1
FOO    1983-01-01  NA
FOO    1983-01-02  NA
FOO    1983-01-02  0
FOO    1983-01-02  0", header=TRUE, stringsAsFactors=FALSE)


df <- setDF(rbindlist(replicate(1e4, df, simplify = F)))


dt <- as.data.table(df)
microbenchmark::microbenchmark(
  ry0 = dt[, if(1 %in% Flag) head(.SD, which.max(Flag == 1) - 1) , by = ID],
  ry1 = dt[, if(1 %in% Flag) .SD[1:(which.max(Flag == 1) - 1)] , by = ID],
  ry2 = df %>% 
          group_by(ID) %>% 
          filter(1 %in% Flag) %>% 
          slice(1:(which.max(Flag == 1) - 1)),
mkr = df %>% group_by(ID) %>%
  filter(cumsum(!is.na(Flag) & Flag == 1) == 0),
www = df %>%
  mutate(Flag2 = ifelse(is.na(Flag), 0, Flag)) %>%
  group_by(ID) %>%
  filter(cumsum(Flag2) < 1) %>%
  ungroup() %>%
  select(-Flag2),
leb = do.call(rbind,lapply(
  split(df, df["ID"]),
  function(.)
    if(!1 %in% .$Flag) NULL
    else .[1:(which.max(.$Flag %in% 1)-1),])),
mm1 = df %>%
  group_by(ID) %>%
  slice(seq_len(match(1,Flag,nomatch=1)-1)),
mm2 = do.call(rbind, by(df, df$ID, function(x) head(x,match(1,x$Flag,nomatch=1)-1))),
mm3 = df[ave(as.logical(df$Flag),df$ID,FUN=function(x){
  y <- match(TRUE,x)-1
  z <- logical(length(x))
  if (is.na(y)) z
  else {z[seq_len(y)] <- TRUE;z}
}),],
unit="relative",
times = 100
)