В строках фрейма данных найдите первое вхождение и самую длинную последовательность значений

Question

Рассмотрим этот фрейм данных, который предоставляет оцененные ответы по 15-элементному тесту для 10 человек:

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

first_0_loc: возвращает столбец местоположение ячейки, содержащей первое вхождение значения 0

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

Если вы хотите использовать базу 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

Опция, использующая melt из data.table

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_][]

---

A 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

Answer 3

Редактировать # 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