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
)

Answer 2

使用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

数据：

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)

Answer 3

先使用dplyr::slice，然后再使用by使用等效基数R。最后是一个仅用于性能的基准测试。对于群组中没有Flag==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

基础

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

基准

我对@Lebatsnok修改后的输入进行了基准测试，我对它进行了修改，因为无法正确识别NA。 MKR和WWW的解决方案在这种情况下并不可靠，但无论如何我还是把它们留在了基准测试中。

# 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"
)

Answer 4

使用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

数据

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)

Answer 5

例如，使用基数R可以做到这一点。

首先，我们需要一个完整的测试用例，其中“标记”列中的组不包含“ 1”：

df <- read.table(text="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
FOO    1983-01-01  N/A
FOO    1983-01-02  N/A
FOO    1983-01-02  0
FOO    1983-01-02  0", header=TRUE, as.is=TRUE)

现在，让我们定义一个函数，该函数将接收数据帧，如果NULL中没有1，则返回$Flag，否则返回前N行（其中{{ 1}}是N第一次出现的行号。可以使用带有布尔值的1（如果which.max为1，TRUE为布尔值，则使用$Flag）：

FALSE

现在，我们需要将数据帧除以findit <- function(.) if(!1 %in% .$Flag) NULL else .[1:(which.max(.$Flag %in% 1)-1),]，应用函数，然后再次ID部分：

rbind

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

5 个答案: