Fatal编程技术网
  • r/
  • R：如何按组查找数据帧中的第一个非零元素

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

r dataframe

R：如何按组查找数据帧中的第一个非零元素,r,dataframe,R,Dataframe,我有以下数据帧 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 DE

我有以下数据帧

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
我在网上看到了一些答案 但它是非缺失的，我有非缺失值和0值

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
中（相同结果）

使用的数据：

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
")
基准代码：

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
)

df%
切片（1：（which.max（Flag==1）-1）），
mkr=df%>%分组依据（ID）%>%
过滤器（总和（！is.na（标志）&标志==1）==0），
www=df%>%
突变（Flag2=ifelse（is.na（Flag），0，Flag））%>%
分组依据（ID）%>%
过滤器（总和（标志2）<1）%>%
解组（）%>%
选择（-Flag2），
leb=do.call（rbind，lapply(
拆分（df，df[“ID”]），
函数（.）
如果（！1%in%.$Flag）为空
else.[1:[which.max（%1中的.$Flag%）-1），]，
mm1=df%>%
分组依据（ID）%>%
切片（seq_len（匹配（1，标志，nomatch=1）-1）），
mm2=do.call（rbind，by（df，df$ID，函数（x）头（x，匹配（1，x$Flag，nomatch=1）-1）），
mm3=df[ave（as.logical（df$Flag）），df$ID，FUN=function（x）{

y使用
dplyr
和
cumsum
的解决方案


library(dplyr)

dat2 <- dat %>%
  mutate(Flag2 = ifelse(is.na(Flag), 0, Flag)) %>%
  group_by(ID) %>%
  filter(cumsum(Flag2) < 1) %>%
  ungroup() %>%
  select(-Flag2)
dat2
# # A tibble: 13 x 3
#    ID    date        Flag
#    <chr> <chr>      <int>
#  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）
dat2%
突变（Flag2=ifelse（is.na（Flag），0，Flag））%>%
分组依据（ID）%>%
过滤器（总和（标志2）<1）%>%
解组（）%>%
选择（-Flag2）
dat2
##A tibble:13 x 3
#ID日期标志
#           
#1 ABC 2018-03-21北美
#2 ABC 2018-03-17 0
#3 ABC 2018-03-12 0
#4 ABC 2018-03-10 0
#5 DEF 2018-03-24北美
#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


数据


dat <- 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",
                  header = TRUE, stringsAsFactors = FALSE)



datA
cumsum
基于
dplyr
的解决方案可以是：


library(dplyr)

df %>% group_by(ID) %>%
  filter(cumsum(!is.na(Flag) & Flag == 1) == 0 & any(Flag == 1))

# # A tibble: 13 x 3
# # Groups: ID [2]
#    ID    date        Flag
#    <chr> <chr>      <int>
#  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）
df%%>%分组依据（ID）%%>%
过滤器（总和（！is.na（标志）&Flag==1）==0&any（标志==1））
##A tibble:13 x 3
##组：ID[2]
#ID日期标志
#           
#1 ABC 2018-03-21北美
#2 ABC 2018-03-17 0
#3 ABC 2018-03-12 0
#4 ABC 2018-03-10 0
#5 DEF 2018-03-24北美
#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


数据：


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",
header = TRUE, stringsAsFactors = FALSE)



df例如，对于基数R，可以这样做

首先，我们需要一个完整的测试用例，其中一个组在“Flag”列中没有“1”：

现在我们需要按
ID
拆分数据帧，应用函数，然后再次
rbind
部分：


do.call(rbind,lapply(split(df, df["ID"]), findit))



使用
dplyr:：slice
，然后使用
by
的等效基数R，最后使用一个仅用于性能的基准。对于组中没有
标志==1的情况，所有这些都是稳健的

dplyr


df %>%
  group_by(ID) %>%
  slice(seq_len(match(1,Flag,nomatch=1)-1))

# # A tibble: 13 x 3
# # Groups:   ID [2]
#    ID    date        Flag
#    <chr> <chr>      <int>
#  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


基本快速


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}
}),]

#     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
# 8  DEF 2018-03-24   NA
# 9  DEF 2018-03-21    0
# 10 DEF 2018-03-20    0
# 11 DEF 2018-03-14    0
# 12 DEF 2018-03-13    0
# 13 DEF 2018-03-12    0
# 14 DEF 2018-03-11    0
# 15 DEF 2018-03-10    0
# 16 DEF 2018-03-09    0


数据


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%
过滤器（1%在%标志中）%%>%
切片（1：（which.max（Flag==1）-1）），
mkr=df%>%分组依据（ID）%>%
过滤器（总和（！is.na（标志）&标志==1）==0），
www=df%>%
突变（Flag2=ifelse（is.na（Flag），0，Flag））%>%
分组依据（ID）%>%
过滤器（总和（标志2）<1）%>%
解组（）%>%
选择（-Flag2），
leb=do.call（rbind，lapply(
拆分（df，df[“ID”]），
函数（.）
如果（！1%in%.$Flag）为空
else.[1:[which.max（%1中的.$Flag%）-1），]，
mm1=df%>%
分组依据（ID）%>%
切片（seq_len（匹配（1，标志，nomatch=1）-1）），
mm2=do.call（rbind，by（df，df$ID，函数（x）头（x，匹配（1，x$Flag，nomatch=1）-1）），
mm3=df[ave（as.logical（df$Flag）），df$ID，FUN=function（x）{

很好的解决方案。令人惊讶的是，我能问一下在dplyr方面哪里可以做得更好吗？你的解决方案太棒了elegant@Morpheus这本书是一个很好的资源。它有“数据科学”在标题中，但在关于数据处理的21章之后才讨论建模。这将包括
标志中没有
1
的组column@lebatsnok我不确定OP是否有兴趣得到它，但如果需要，那么
过滤器（cumsum（！is.na（Flag）&Flag==1）==0&any（Flag==1））
会成功的。OP说“如果没有1，那一组就根本不应该出现。”@Moody\u Mudskipper啊好的。很抱歉我错过了那一点。让我修改我的答案。总是很高兴看到比较，尤其是与base的比较。这个答案激励我做一个小的性能改进（
head
，而不是
[
）。如果您使用较大的
df，基准看起来会有很大不同，例如
df谢谢，我在您的编辑历史记录中看到了基准，似乎您的解决方案最终获胜；）。我不确定
head
是否比
[
性能更好，也许您使用
[seq_len（which.max.
比
更快[1:which.max
，我可能完全错了。
头的性能通常不比
[
好，但比
[.data.table
快。我之所以知道这一点，是因为我问了这个问题：

do.call(rbind,lapply(split(df, df["ID"]), findit))



df %>%
  group_by(ID) %>%
  slice(seq_len(match(1,Flag,nomatch=1)-1))

# # A tibble: 13 x 3
# # Groups:   ID [2]
#    ID    date        Flag
#    <chr> <chr>      <int>
#  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



do.call(rbind, by(df, df$ID, function(x) 
  head(x,match(1,x$Flag,nomatch=1)-1)))

# ID       date Flag
# ABC.1  ABC 2018-03-21   NA
# ABC.2  ABC 2018-03-17    0
# ABC.3  ABC 2018-03-12    0
# ABC.4  ABC 2018-03-10    0
# DEF.8  DEF 2018-03-24   NA
# DEF.9  DEF 2018-03-21    0
# DEF.10 DEF 2018-03-20    0
# DEF.11 DEF 2018-03-14    0
# DEF.12 DEF 2018-03-13    0
# DEF.13 DEF 2018-03-12    0
# DEF.14 DEF 2018-03-11    0
# DEF.15 DEF 2018-03-10    0
# DEF.16 DEF 2018-03-09    0



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}
}),]

#     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
# 8  DEF 2018-03-24   NA
# 9  DEF 2018-03-21    0
# 10 DEF 2018-03-20    0
# 11 DEF 2018-03-14    0
# 12 DEF 2018-03-13    0
# 13 DEF 2018-03-12    0
# 14 DEF 2018-03-11    0
# 15 DEF 2018-03-10    0
# 16 DEF 2018-03-09    0



# Unit: relative
# expr       min        lq      mean    median        uq       max neval
# ry1  7.843459  5.885757  4.465808  5.515120  4.972157 0.4357556   100
# ry2 10.750648  8.840738  7.170055  8.922515  8.044793 0.7575101   100
# mkr  7.842997  5.892338  4.903737  5.872316  5.295717 0.6153142   100
# www 19.043776 16.816860 12.987223 16.270110 14.358256 2.3291645   100
# leb  2.882267  2.180278  2.132873  2.454936  2.328484 1.0160795   100
# mm1  7.974575  6.519906  5.417112  6.664007  5.958628 0.6423475   100
# mm2  3.677730  3.196962  2.861106  3.347310  3.093514 0.7054546   100
# mm3  1.000000  1.000000  1.000000  1.000000  1.000000 1.0000000   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)



dt <- as.data.table(df)
microbenchmark::microbenchmark(
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"
)