在数据框的行中，找到第一个出现和最长的值序列

Question

考虑这个数据框，它提供了对 10 个人的 15 项测试的评分响应：

library(tidyverse)
input <- tribble(
  ~ID, ~i1, ~i2, ~i3, ~i4, ~i5, ~i6, ~i7, ~i8, ~i9, ~i10, ~i11, ~i12, ~i13, ~i14, ~i15,
  "A", 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0,
  "B", 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
  "C", 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0,
  "D", 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0,
  "E", 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0,
  "F", 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  "G", 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0,
  "H", 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0,
  "I", 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  "J", 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1
)

我希望 R 逐行扫描，从左到右扫描每行中的单元格，以创建这些新列：

first_0_name：返回包含值0的第一次出现的单元格的列name

first_0_loc：返回包含值0的第一次出现的单元格的列location

streak_1：从0的第一个出现开始，找到1的下一个出现，然后计算1在下一个0出现之前连续出现的次数。

新列应如下所示

new_cols <- tribble(
  ~first_0_name, ~first_0_loc, ~streak_1,
  "i9", 10, 5,
  "i4", 5, 4,
  "i6", 7, 8,
  "i8", 9, 4,
  "i9", 10, 5,
  NA, NA, NA,
  "i1", 2, 5,
  "i3", 4, 8,
  "i2", 3, NA,
  "i1", 2, 1
)

提前感谢您的帮助！

Answer 1

如果您想更直接地使用 base R 并避免转换整个数据框的成本。此解决方案还保留了行的顺序，而无需创建额外的排序列（与 tidyverse 解决方案不同）。

results <- apply(input, 1, function(x) {

  # get indices of all zeros
  zeros <- which(x == 0)

  # exit early if no zeros are found
  if (length(zeros) == 0) {
    return(data.frame(first_0_name = NA, first_0_loc = NA, streak_1 = NA))
  }

  first.name <- names(zeros[1])         # name of first 0 column
  first.idx <- zeros[1]                 # location of first zero
  longest.streak <- diff(zeros)[1] - 1  # length of first 0-0 streak

  return(data.frame(first_0_name = first.name, 
                    first_0_loc = first.idx, 
                    streak_1 = ifelse(longest.streak == 0, NA, longest.streak))
         )

})

output <- do.call(rbind, results)

    first_0_name first_0_loc streak_1
i9            i9          10        5
i4            i4           5        4
i6            i6           7        8
i8            i8           9       NA
i91           i9          10        5
1           <NA>          NA       NA
i1            i1           2        5
i3            i3           4        8
i2            i2           3       NA
i31           i3           4        2

Answer 2

编辑#2：重写为两个摘要的组合。

input_tidy <- input %>%
  gather(col, val, -ID) %>%
  group_by(ID) %>%
  arrange(ID) %>%
  mutate(col_num = row_number() + 1) 

input[,1] %>% 
  # Combine with summary of each ID's first zero
  left_join(input_tidy %>% filter(val == 0) %>%
              summarize(first_0_name = first(col),
                        first_0_loc = first(col_num))) %>%
  # Combine with length of each ID's first post-0 streak of 1's
  left_join(input_tidy %>%
              filter(val == 1 & cumsum(val == 1 & lag(val, default = 1) == 0) == 1) %>% 
              summarize(streak_1 = n()))


# A tibble: 10 x 4
   ID    first_0_name first_0_loc streak_1
   <chr> <chr>              <dbl>    <int>
 1 A     i9                    10        5
 2 B     i4                     5        4
 3 C     i6                     7        8
 4 D     i8                     9        4
 5 E     i9                    10        5
 6 F     NA                    NA       NA
 7 G     i1                     2        5
 8 H     i3                     4        8
 9 I     i2                     3       NA
10 J     i3                     4        2

Answer 3

使用来自data.table 的melt 的选项

library(data.table)
melt(setDT(input), id.var = 'ID')[, .(first_o_name = first(variable[value == 0]), 
    first_o_loc = which(value == 0)[1] +1,
    streak_1 = sum(cumsum(c(TRUE, diff(value == 0) < 0)) == 2) - 1 ),  ID
     ][streak_1 < 0, streak_1 := NA_real_][]

---

base R 选项也可以与 apply 和 rle 一起使用

do.call(rbind, apply(input[-1], 1, function(x) {
       first_o_loc <- unname(which(x == 0)[1] + 1)
       first_o_name <- names(x)[first_o_loc-1]
       rl <- rle(x)
       rl1 <- within.list(rl,  {
             i1 <- cumsum(values == 0) == 1
             values <- values[i1]
             lengths <- lengths[i1]})
        streak_1 <- unname(rl1$lengths[2])
      data.frame(first_o_name, first_o_loc, streak_1)}))
#   first_o_name first_o_loc streak_1
#1            i9          10        5
#2            i4           5        4
#3            i6           7        8
#4            i8           9        4
#5            i9          10        5
#6          <NA>          NA       NA
#7            i1           2        5
#8            i3           4        8
#9            i2           3       NA
#10           i3           4        2