return values between two strings in list of data frames [R]

user_11677431 0
Viewed 32

If I have the following list:

mylist <- list(
  data.frame(x = c("One", "Two", "Three", "Four"), y = c(1,2,3,4)), # two strings between one and four
  data.frame(x = c("Three", "One", "Six", "Four"), y = c(4,5,6,7)), # one string between one and four
  data.frame(x = c("Six", "Seven", "Eight"), y = c(7,8,9)), # no strings between one and four
  data.frame(x = c("Six", "One", "Eight"), y = c(10,11,12)), # no four
  data.frame(x = c("Six", "Four", "Eight"), y = c(13,14,15)) # no one
)

How would I use purrr [I've tried using keep but couldn't figure it out] to return each list's x values between One and Four -- I also may have cases where there is One without Four and Four without One.

Desired Output

[[1]]
One Two Three Four

[[2]]
One Six Four

[[3]]
NULL

[[4]]
One

[[5]]
Four

Is this possible?

Another example:

mylist <- list(
  data.frame(x = c("Bob", "Sarah", "Sally", "Mark")), # two strings between Bob and Mark
  data.frame(x = c("Teegan", "Bob", "Rachel", "Mark")), # one string between Bob and Mark
  data.frame(x = c("Tara", "Gus", "Melissa")), # neither Bob nor Mark
  data.frame(x = c("Sam", "Matt", "Bob")), # no mark
  data.frame(x = c("Mark", "Jordan", "Maya")),
  data.frame(x = c("Mark", "Bob", "Rachel")) #dont return names after Mark
)

Returns:

[[1]] Bob Sarah Sally Mark
[[2]] Bob Rachel Mark
[[3]] NULL
[[4]] Bob
[[5]] Mark
[[6]] Bob Mark
purrr lapply r
2 Answers
out <- 
  lapply(mylist, function(df){
      inds <- 
        sapply(c('One', 'Four'), function(w){
          if(!w %in% df$x) NA_integer_
          else which(w == df$x)
        })
      if(all(is.na(inds))) NULL
      else if(all(!is.na(inds))) df$x[inds[1]:inds[2]]
      else df$x[inds[!is.na(inds)]]
    })


lapply(out, as.character)
# [[1]]
# [1] "One"   "Two"   "Three" "Four" 
# 
# [[2]]
# [1] "One"  "Six"  "Four"
# 
# [[3]]
# character(0)
# 
# [[4]]
# [1] "One"
# 
# [[5]]
# [1] "Four"
user_67627550

We loop over the list, create a 'flag' for the values that are needed, then filter after filling the NA elements with previous non-NA on selected cases and pull the 'x' column

library(purrr)
library(dplyr)
library(zoo)
map(mylist, 
       ~ .x %>% 
              mutate(flag = case_when(x == 'One' ~ 1, x == 'Four' ~ 2),
                 flag2 = if(all(c("One", "Four") %in% x)) 
                  na.locf0(flag) else flag) %>% 
               filter(!is.na(flag2)) %>% 
               pull(x) %>%
               as.character)
#[[1]]
#[1] "One"   "Two"   "Three" "Four" 

#[[2]]
#[1] "One"  "Six"  "Four"

#[[3]]
#character(0)

#[[4]]
#[1] "One"

#[[5]]
#[1] "Four"

It can be made more compact

map(mylist, ~ .x %>%
         filter(all(c('One', 'Four') %in% x) & 
               cumsum(x %in% c('One', 'Four')) > 0| x %in% c('One', 'Four')) %>%
         pull(x) %>% 
         as.character)

Using the second example

library(zoo)
map(mylist, 
      ~ .x %>% 
             mutate(flag = case_when(x == 'Bob' ~ 1, x == 'Mark' ~ 2),
                flag2 = if(all(c("Bob", "Mark") %in% x)) 
                 na.locf0(flag) else flag) %>% 
             filter(!is.na(flag2)) %>% 
             pull(x) %>%
             as.character)
#[[1]]
#[1] "Bob"   "Sarah" "Sally" "Mark" 

#[[2]]
#[1] "Bob"    "Rachel" "Mark"  

#[[3]]
#character(0)

#[[4]]
#[1] "Bob"

#[[5]]
#[1] "Mark"

Update

Based on the updated dataset and with additional rules

map(mylist, ~ 
      .x  %>% 
         mutate(i1 = match(x, c('Bob', 'Mark'))) %>%
         fill(i1) %>%
         slice(if(any(!is.na(i1))) seq_len(which.max(i1)) else 0) %>%
         filter(!is.na(i1)) %>%
         pull(x) %>% 
         as.character)
#[[1]]
#[1] "Bob"   "Sarah" "Sally" "Mark" 

#[[2]]
#[1] "Bob"    "Rachel" "Mark"  

#[[3]]
#character(0)

#[[4]]
#[1] "Bob"

#[[5]]
#[1] "Mark"

#[[6]]
#[1] "Mark"
user_37322710
Related