функция опережения или запаздывания для получения нескольких значений, а не только n

Question

У меня есть тиббл со списком слов для каждой строки. Я хочу создать новую переменную из функции, которая ищет ключевое слово и, если она находит ключевое слово, создает строку, состоящую из ключевого слова плюс-минус 3 слова.

Код ниже close , но вместо того, чтобы набирать все три слова до и после моего ключевого слова, он захватывает одно слово 3 вперед / назад.

df <- tibble(words = c("it", "was", "the", "best", "of", "times", 
                       "it", "was", "the", "worst", "of", "times"))
df <- df %>% mutate(chunks = ifelse(words=="times", 
                                    paste(lag(words, 3), 
                                          words, 
                                          lead(words, 3), sep = " "),
                                    NA))

Наиболее интуитивным решением было бы, если бы функция lag могла сделать что-то вроде этого: lead(words, 1:3), но это не работает.

Очевидно, что я мог бы довольно быстро сделать это вручную (paste(lead(words,3), lead(words,2), lead(words,1),...lag(words,3)), но в конечном итоге я действительно захочу уловить ключевое слово плюс-и-минус 50 слов - слишком много, чтобы ручной код.

Было бы идеально, если бы решение существовало в тививерсе, но любое решение было бы полезно. Любая помощь будет оценена.

Answer 1

Один из вариантов будет sapply:

library(dplyr)

df %>%
  mutate(
    chunks = ifelse(words == "times",
                    sapply(1:nrow(.), 
                       function(x) paste(words[pmax(1, x - 3):pmin(x + 3, nrow(.))], collapse = " ")),
                    NA)
  )

Вывод:

# A tibble: 12 x 2
   words chunks                      
   <chr> <chr>                       
 1 it    NA                          
 2 was   NA                          
 3 the   NA                          
 4 best  NA                          
 5 of    NA                          
 6 times the best of times it was the
 7 it    NA                          
 8 was   NA                          
 9 the   NA                          
10 worst NA                          
11 of    NA                          
12 times the worst of times   

Хотя это и не явная функция lead или lag, она часто может служить целиа также.

Answer 2

Вот еще одно решение tidyverse, использующее lag и lead

laglead_f <- function(what, range)
    setNames(paste(what, "(., ", range, ", default = '')"), paste(what, range))

df %>%
    mutate_at(vars(words), funs_(c(laglead_f("lag", 3:0), laglead_f("lead", 1:3)))) %>%
    unite(chunks, -words, sep = " ") %>%
    mutate(chunks = ifelse(words == "times", trimws(chunks), NA))
## A tibble: 12 x 2
#   words chunks
#   <chr> <chr>
# 1 it    NA
# 2 was   NA
# 3 the   NA
# 4 best  NA
# 5 of    NA
# 6 times the best of times it was the
# 7 it    NA
# 8 was   NA
# 9 the   NA
#10 worst NA
#11 of    NA
#12 times the worst of times

Идея состоит в том, чтобы хранить значения из трех векторов lag ged и lead ing в новых столбцахс mutate_at и именованной функцией, unite эти столбцы, а затем фильтровать записи на основе вашего состояния, где words == "times".

Answer 3

data.table::shift принимает вектор для аргумента n (отставание) и выводит список, поэтому вы можете использовать его и do.call(paste элементы списка вместе. Однако, если вы не используете версию data.table> = 1.12, я не думаю, что она позволит вам смешивать отрицательные и положительные значения n (как показано ниже).

С таблицей данных:

library(data.table)
setDT(df)

df[, chunks := trimws(ifelse(words != "times", NA, do.call(paste, shift(words, 3:-3, ''))))]

#     words                       chunks
#  1:    it                         <NA>
#  2:   was                         <NA>
#  3:   the                         <NA>
#  4:  best                         <NA>
#  5:    of                         <NA>
#  6: times the best of times it was the
#  7:    it                         <NA>
#  8:   was                         <NA>
#  9:   the                         <NA>
# 10: worst                         <NA>
# 11:    of                         <NA>
# 12: times           the worst of times

С dplyr и только с использованием data.table для функции shift:

library(dplyr)

df %>% 
  mutate(chunks = do.call(paste, data.table::shift(words, 3:-3, fill = '')),
         chunks = trimws(ifelse(words != "times", NA, chunks)))

# # A tibble: 12 x 2
#    words chunks                      
#    <chr> <chr>                       
#  1 it    NA                          
#  2 was   NA                          
#  3 the   NA                          
#  4 best  NA                          
#  5 of    NA                          
#  6 times the best of times it was the
#  7 it    NA                          
#  8 was   NA                          
#  9 the   NA                          
# 10 worst NA                          
# 11 of    NA                          
# 12 times the worst of times         

Answer 4

Аналогично @ arg0naut, но без dplyr:

r  = 1:nrow(df)
w  = which(df$words == "times")
wm = lapply(w, function(wi) intersect(r, seq(wi-3L, wi+3L)))

df$chunks <- NA_character_
df$chunks[w] <- tapply(df$words[unlist(wm)], rep(w, lengths(wm)), FUN = paste, collapse=" ")

# A tibble: 12 x 2
   words chunks                      
   <chr> <chr>                       
 1 it    <NA>                        
 2 was   <NA>                        
 3 the   <NA>                        
 4 best  <NA>                        
 5 of    <NA>                        
 6 times the best of times it was the
 7 it    <NA>                        
 8 was   <NA>                        
 9 the   <NA>                        
10 worst <NA>                        
11 of    <NA>                        
12 times the worst of times      

Перевод data.table:

library(data.table)
DT = data.table(df)

w = DT["times", on="words", which=TRUE]
wm = lapply(w, function(wi) intersect(r, seq(wi-3L, wi+3L)))

DT[w, chunks := DT[unlist(wm), paste(words, collapse=" "), by=rep(w, lengths(wm))]$V1]