возвращаемые значения между двумя строками в списке фреймов данных [R] - PullRequest
Новая
       26

возвращаемые значения между двумя строками в списке фреймов данных [R]

2 голосов
/ 05 апреля 2020

Если бы у меня был следующий список: 

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
)

Как бы я использовал purrr [Я пытался использовать keep, но не смог разобраться], чтобы возвращать значения x каждого списка между One и Four - у меня также могут быть случаи, когда есть One без Four и Four без One.

Требуемый выход 

[[1]]
One Two Three Four

[[2]]
One Six Four

[[3]]
NULL

[[4]]
One

[[5]]
Four

Возможно ли это?

Другой пример: 

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
)

Возвращает: 

[[1]] Bob Sarah Sally Mark
[[2]] Bob Rachel Mark
[[3]] NULL
[[4]] Bob
[[5]] Mark
[[6]] Bob Mark

Ответы [ 2 ]

2 голосов
/ 06 апреля 2020 
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"
1 голос
/ 05 апреля 2020

Мы l oop над list, создаем 'флаг' для необходимых значений, затем filter после заполнения элементов NA предыдущим не-NA в выбранных случаях и вытягиваем столбец 'x' 

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"

Можно сделать более компактным 

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)

Используя второй пример 

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"

Обновление

На основе обновленный набор данных и с дополнительными правилами 

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"
...