Мутировать на основе условного лага

Question

У меня есть данные из чата, где каждая строка является нажатием клавиши. Я хотел бы автоматически добавить столбец most_recent_enter (добавленный вручную для пояснения), где он отслеживает самую последнюю строку, где keystroke == ENTER.

В этом примере есть перекрывающиеся сообщения, поэтому последний пользователь, который нажал ENTER, не обязательно был самым последним пользователем. Я включаю сюда другие столбцы, чтобы показать, какая информация у меня есть.

x <- data.frame(overall_idx = 1:14,
                sender=c("a","a","a","b","b","b","a",
                         "a","a","a","b","b","a","a"),
                keystroke=c("H","I","ENTER","K","I","ENTER",
                            "W","H","I","C","W","H","H","T"),
                ks_idx=c(0,1,2,0,1,2,0,1,2,3,0,1,3,3),
                most_recent_enter=c(NA,NA,NA,"a","a","a","b","b",
                                    "b","b","b","b","b","b")
                )

Есть ли способ найти самую последнюю строку, которая удовлетворяет условию?

EDIT В моих реальных данных каждый разговор помечен номером эксперимента. Как бы сбросить это для каждого эксперимента?

x <- data.frame(exp_num=c(rep(1,14),rep(2,14)),
                overall_idx = c(1:14,1:14),
                sender=c("a","a","a","b","b","b","a",
                         "a","a","a","b","b","a","a",
                         "a","a","a","b","b","b","a",
                         "a","a","a","b","b","a","a"),
                keystroke=c("H","I","ENTER","K","I","ENTER",
                            "W","H","I","C","W","H","H","T",
                            "H","I","ENTER","K","I","ENTER",
                            "W","H","I","C","W","H","H","T"),
                ks_idx=c(0,1,2,0,1,2,0,1,2,3,0,1,3,3,0,1,2,0,1,2,0,1,2,3,0,1,3,3),
                most_recent_enter=c(NA,NA,NA,"a","a","a","b","b",
                                    "b","b","b","b","b","b",
                                    NA,NA,NA,"a","a","a","b","b",
                                    "b","b","b","b","b","b")
                )

РЕДАКТИРОВАТЬ 2: Выбранный ответ действительно не удается, когда во втором exp_num есть два разных отправителя. Например:

x <- data.frame(exp_num=c(rep(1,14),rep(2,14)),
                overall_idx = c(1:14,1:14),
                sender=c("a","a","a","b","b","b","a",
                         "a","a","a","b","b","a","a",
                         "c","c","c","d","d","d","c",
                         "c","c","c","d","d","c","c"),
                keystroke=c("H","I","ENTER","K","I","ENTER",
                            "W","H","I","C","W","H","H","T",
                            "H","I","ENTER","K","I","ENTER",
                            "W","H","I","C","W","H","H","T"),
                ks_idx=c(0,1,2,0,1,2,0,1,2,3,0,1,3,3,0,1,2,0,1,2,0,1,2,3,0,1,3,3),
                most_recent_enter=c(NA,NA,NA,"a","a","a","b","b",
                                    "b","b","b","b","b","b",
                                    NA,NA,NA,"c","c","c","d","d",
                                    "d","d","d","d","d","d")

производит одинаковые a с и b с для most_recent_new_enter как в Exp 1, так и в Exp 2, а не c s и d s

Answer 1

Вы также можете сделать:

x %>%
  group_by(exp_num) %>% 
  mutate(most_recent_enter = sender[
    sapply(1:n(),
           function(x) max(which(keystroke == 'ENTER')[which(keystroke == 'ENTER') < x])
           )] 
    )

Вывод (первые несколько строк):

# A tibble: 28 x 6
# Groups:   exp_num [2]
   exp_num overall_idx sender keystroke ks_idx most_recent_enter
     <dbl>       <int> <fct>  <fct>      <dbl> <fct>            
 1       1           1 a      H              0 NA               
 2       1           2 a      I              1 NA               
 3       1           3 a      ENTER          2 NA               
 4       1           4 b      K              0 a                
 5       1           5 b      I              1 a                
 6       1           6 b      ENTER          2 a                
 7       1           7 a      W              0 b                
 8       1           8 a      H              1 b                
 9       1           9 a      I              2 b                
10       1          10 a      C              3 b                
# ... with 18 more rows

В основном, вы проверяете для каждого номера строки, который является максимальным индексом, соответствующим ENTER он по-прежнему ниже текущего номера строки и используется для подмножества sender с ним.

Answer 2

Мы можем создать столбец группировки на основе значения 'ENTER', чтобы создать элемент first для 'sender' в качестве most_recent, а затем lag столбец после ungroup

library(dplyr)
x %>%
   group_by(grp = cumsum(keystroke == 'ENTER')) %>% 
   mutate(most_recent_new_enter = case_when(grp > 0 ~ first(sender))) %>% 
   ungroup %>% 
   mutate(most_recent_new_enter = lag(most_recent_new_enter)) %>%
   select(-grp)
# A tibble: 14 x 6
#   overall_idx sender keystroke ks_idx most_recent_enter most_recent_new_enter
#         <int> <fct>  <fct>      <dbl> <fct>             <fct>                
# 1           1 a      H              0 <NA>              <NA>                 
# 2           2 a      I              1 <NA>              <NA>                 
# 3           3 a      ENTER          2 <NA>              <NA>                 
# 4           4 b      K              0 a                 a                    
# 5           5 b      I              1 a                 a                    
# 6           6 b      ENTER          2 a                 a                    
# 7           7 a      W              0 b                 b                    
# 8           8 a      H              1 b                 b                    
# 9           9 a      I              2 b                 b                    
#10          10 a      C              3 b                 b                    
#11          11 b      W              0 b                 b                    
#12          12 b      H              1 b                 b                    
#13          13 a      H              3 b                 b                    
#14          14 a      T              3 b                 b   

---

Для обновленного поста мы можем добавить group_by

x %>%
    group_by(exp_num) %>%  
    group_by(grp = cumsum(keystroke == 'ENTER'), .add = TRUE) %>%
    mutate(most_recent_new_enter = case_when(grp > 0 ~ first(sender))) %>% 
    group_by(exp_num) %>% 
    mutate(most_recent_new_enter = lag(most_recent_new_enter)) %>%
    select(-grp) %>%
    as.data.frame
#exp_num overall_idx sender keystroke ks_idx most_recent_enter most_recent_new_enter
#1        1           1      a         H      0              <NA>                  <NA>
#2        1           2      a         I      1              <NA>                  <NA>
#3        1           3      a     ENTER      2              <NA>                  <NA>
#4        1           4      b         K      0                 a                     a
#5        1           5      b         I      1                 a                     a
#6        1           6      b     ENTER      2                 a                     a
#7        1           7      a         W      0                 b                     b
#8        1           8      a         H      1                 b                     b
#9        1           9      a         I      2                 b                     b
#10       1          10      a         C      3                 b                     b
#11       1          11      b         W      0                 b                     b
#12       1          12      b         H      1                 b                     b
#13       1          13      a         H      3                 b                     b
#14       1          14      a         T      3                 b                     b
#15       2           1      c         H      0              <NA>                  <NA>
#16       2           2      c         I      1              <NA>                  <NA>
#17       2           3      c     ENTER      2              <NA>                  <NA>
#18       2           4      d         K      0                 c                     c
#19       2           5      d         I      1                 c                     c
#20       2           6      d     ENTER      2                 c                     c
#21       2           7      c         W      0                 d                     d
#22       2           8      c         H      1                 d                     d
#23       2           9      c         I      2                 d                     d
#24       2          10      c         C      3                 d                     d
#25       2          11      d         W      0                 d                     d
#26       2          12      d         H      1                 d                     d
#27       2          13      c         H      3                 d                     d
#28       2          14      c         T      3                 d                     d

---

Или использовать fill из tidyr

library(tidyr)
x %>% 
  mutate(most_recent_new_enter =  lag(case_when(keystroke == 'ENTER' ~ sender))) %>%
  fill(most_recent_new_enter)

---

Или используя data.table

library(data.table)
setDT(x)[keystroke == 'ENTER', most_recent_new_enter := sender][, 
      most_recent_new_enter :=  shift(zoo::na.locf0(most_recent_new_enter))]