使用 dplyr 获取每组或每行具有特定值的第一列的索引答案

【问题标题】：Use dplyr to get index of first column with certain value per group or row使用 dplyr 获取每组或每行具有特定值的第一列的索引
【发布时间】：2019-07-26 08:03:40
【问题描述】：

我有以下脚本。选项 1 使用长格式和group_by 来识别许多状态等于 0 的第一步。

另一种选择（2）是使用apply为每一行计算这个值，然后将数据转换为长格式。

第一个选项不能很好地扩展。第二个是，但我无法将它放入dplyr 管道。我试图用purrr 解决这个问题，但没有成功。

问题：

为什么第一个选项不能很好地扩展？
如何转换dplyr 管道中的第二个选项？


require(dplyr)
require(tidyr)
require(ggplot2)

set.seed(314)

# example data

dat <- as.data.frame(matrix(sample(c(0,1),
                                   size = 9000000, 
                                   replace = TRUE, 
                                   prob = c(5,95)), 
                            ncol = 9))

names(dat) <- paste("step",1:9, sep="_")

steps <- dat %>% select(starts_with("step_")) %>% names()

# option 1 is slow

dat.cum <- dat %>%
  mutate(id = row_number()) %>%
  gather(step, status,-id) %>%
  group_by(id) %>%
  mutate(drop = min(if_else(status==0,match(step, steps),99L))) %>%
  mutate(status = if_else(match(step, steps)>=drop,0,1))

ggplot(dat.cum, aes(x = step, fill = factor(status))) +
  geom_bar()

# option 2 is faster

dat$drop <- apply(dat,1,function(x) min(which(x==0),99))

dat.cum <- dat %>%
  gather(step,status,-drop) %>%
  mutate(status = if_else(match(step,steps)>=drop,0,1))

ggplot(dat.cum, aes(x = step, fill = factor(status))) +
  geom_bar()

【问题讨论】：

管道序列中的第二个选项可以是dat %>% mutate(drop = apply(., 1, function(x) min(which(x == 0), 99))) %>% gather(....

标签： r dplyr purrr

【解决方案1】：

如果您想沿行进行映射，您可以这样做：

dat %>%
  mutate(drop2 = map_int(seq_len(nrow(dat)), ~ min(which(dat[.x, ] == 0L), 99L)))

可能是“收集和分组”比循环更快：

dat %>%
  as_tibble() %>%
  select(starts_with("step_")) %>%
  mutate(row_nr = row_number()) %>%    
  gather(key = "col", value = "value", -row_nr) %>%
  arrange(row_nr, col) %>%
  group_by(row_nr) %>%
  mutate(col_index = row_number()) %>%
  filter(value == 0) %>%
  summarise(drop3 = min(col_index)) %>%
  ungroup() %>%
  right_join(dat %>%
               mutate(row_nr = row_number()), 
             by = "row_nr") %>%
  mutate(drop3 = if_else(is.na(drop3), 99, drop3))

【讨论】：