concatenate iteratively first/last n words from strings

Question

Assume that I have following data.frame:

df <- data.frame(string=c("word1 word2 word3 word4", "word1 word2", "word1"), stringsAsFactors = FALSE)

I want to derive in a list (or per row) concatenations of first/last n words (n from 1 to number of words). Expected outcome:

list(
string1=c('left1'="word1", 'left2'= "word1 word2", 'left3'="word1 word2 word3",
          'left4'="word1 word2 word3 word4",
        'right1'="word4", 'right2'="word3 word4", 'right3'="word2 word3 word4"),
string2= c('left1'="word1", 'left2'="word1 word2", 'right1'="word2"),
string3="word1")

(names of elements not desired at all but facilitate understanding).

Not wanted: paste of middle elements such as "word2 word3".

I currently use strsplit(df$string) to prepare first step of the desired list and then can achieve what I want with a double loop but this is far from being efficient.

Approach preferred in base R / data.table but tidyverse efficient solution would be quite OK.

Answer 1

A base R version :

We can write a function which incrementally pastes the value adding each word at a time.

paste_words <- function(x) {
   sapply(seq_along(x), function(y) paste0(x[1:y], collapse = " "))
}

lapply(strsplit(df$string, " "), function(x) c(paste_words(x), paste_words(rev(x))))


#[[1]]
#[1] "word1"    "word1 word2"    "word1 word2 word3"   "word1 word2 word3 word4"
#[5] "word4"    "word4 word3"     "word4 word3 word2"  "word4 word3 word2 word1"

#[[2]]
#[1] "word1"    "word1 word2" "word2"    "word2 word1"

#[[3]]
#[1] "word1" "word1"

You might want to wrap unique to avoid duplication of similar words like in last element.

Answer 2

One dplyr , tidyr and purrr option could be:

df %>%
 rowid_to_column() %>%
 separate_rows(string, sep = " ") %>%
 group_by(rowid) %>%
 transmute(concatenated = accumulate(string, ~ paste(.x, .y)),
           concatenated_rev = accumulate(rev(string), ~ paste(.x, .y)))

  rowid concatenated            concatenated_rev       
  <int> <chr>                   <chr>                  
1     1 word1                   word4                  
2     1 word1 word2             word4 word3            
3     1 word1 word2 word3       word4 word3 word2      
4     1 word1 word2 word3 word4 word4 word3 word2 word1
5     2 word1                   word2                  
6     2 word1 word2             word2 word1            
7     3 word1                   word1   

Or with further left/right info:

df %>%
 rowid_to_column() %>%
 separate_rows(string, sep = " ") %>%
 group_by(rowid) %>%
 transmute(left = paste0("left", 1:n()),
           concatenated = accumulate(string, ~ paste(.x, .y)),
           right = paste0("right", 1:n()),
           concatenated_rev = accumulate(rev(string), ~ paste(.x, .y)))

  rowid left  concatenated            right  concatenated_rev       
  <int> <chr> <chr>                   <chr>  <chr>                  
1     1 left1 word1                   right1 word4                  
2     1 left2 word1 word2             right2 word4 word3            
3     1 left3 word1 word2 word3       right3 word4 word3 word2      
4     1 left4 word1 word2 word3 word4 right4 word4 word3 word2 word1
5     2 left1 word1                   right1 word2                  
6     2 left2 word1 word2             right2 word2 word1            
7     3 left1 word1                   right1 word1 

Answer 3

Thanks to Ronak approach (thanks), I end up with following code. Much more elegant and performant that my loop.

paste_words_left <- function(x) {
 sapply(seq_along(x), function(y) paste0(x[1:y], collapse = " "))
}

paste_words_right <- function(x) {
 sapply(seq_along(x)[-1], function(y) paste0(x[y:length(x)], collapse = " "))
}

## lapply(strsplit(df$string, " "), function(x) c(paste_words_left(x), paste_words_right(x)))

lapply(strsplit(df$string, " "), function(x){
  if (length(x)==1) x else  c(paste_words_left(x), paste_words_right(x))})