Сохранение каждой итерации в a для l oop как кадра данных

Question

Во-первых, да, я исследовал это, и да, я видел несколько ответов, которые должны решить мою проблему, НО я не могу применить их к моей ситуации, поэтому я иду прямо к своему источнику и надеюсь, что кто-то сможет получить концепцию через мою толстый череп с моими данными. Это, очевидно, гораздо меньший пример. Я пытаюсь отфильтровать наши строки, которые содержат значение из вектора в любом из столбцов Code_, и сохранить их как фрейм данных для каждой итерации. Прямо сейчас этот код объявляет измененный столбец на каждом проходе, чтобы показать, какое значение из вектора кода было использовано для этого фильтра. Это, конечно, приводит к большому дублированию, и мне все равно приходится разделять вывод, чтобы каждая итерация помещалась в отдельный df.

transaction <- c(1,2,3,4,5)
Code_1 <- c("QD","QK","QI","QE","QH")
Code_2 <- c("QE","QB","SA","QG","QC")
Code_3 <- c("QG","QH","DI","QK","QI")
Code_4 <- c("QK","QC","QD","QB","SA")

df <- data.frame(transaction, Code_1, Code_2, Code_3, Code_4)

codes <- c("QD","QH","SA")

test <- data.frame(NULL)

for(i in codes){
  tmp <- df %>% filter(Code_1 == i | Code_2 == i | Code_3 == i| Code_4 == i) %>% mutate(interation = 
i)
  test <- rbind(test, tmp)

}  

Я получаю вывод, который захватывает все строки, которые я хочу, но все же необходимо преобразовать их в отдельные dfs на основе "итерации" измененного столбца. Есть ли способ потерять измененный столбец и сохранить каждую итерацию как df по мере выполнения цикла. Я пробовал несколько примеров и пробовал поиграть с парой сценариев применения ios, но это единственное, что мне удалось заставить работать.

Извините за путаницу с выводом

В идеальном мире я хочу, чтобы каждая итерация выводила уникальный тиббл / df. Я хочу получить результат, как если бы я только что запустил что-то вроде этого, но тысячу раз с сотнями кодов. Мне не нужен список. Мне нужны уникальные индивидуальные выходы.

QD <- df %>% filter(Code_1 == "QD" | Code_2 == "QD" | Code_3 == "QD"| 
Code_4 == "QD")
QH <- df %>% filter(Code_1 == "QH" | Code_2 == "QH" | Code_3 == "QH"| 
Code_4 == "QH")
SA <- df %>% filter(Code_1 == "SA" | Code_2 == "SA" | Code_3 == "SA"| 
Code_4 == "SA")

Answer 1

Вот решение lapply, без tmp data.frame.

codes <- c("QD","QH","SA")

test <- lapply(codes, function(i){
  df %>% 
    filter(Code_1 == i | Code_2 == i | Code_3 == i| Code_4 == i) %>% 
    mutate(interation = i)
})
test

test <- do.call(rbind, test)
test
#  transaction Code_1 Code_2 Code_3 Code_4 interation
#1           1     QD     QE     QG     QK         QD
#2           3     QI     SA     DI     QD         QD
#3           2     QK     QB     QH     QC         QH
#4           5     QH     QC     QI     SA         QH
#5           3     QI     SA     DI     QD         SA
#6           5     QH     QC     QI     SA         SA

Answer 2

Построчное увеличение кадров логично, но масштабируется ужасно : с каждой добавленной строкой весь кадр копируется в память. Это означает, что когда у вас есть 100 строк, чтобы добавить 1 строку, у вас есть первые 100 строк в памяти дважды .

Обычно это делается для сохранения строк в list, а затем объединить их вручную за один шаг .

out <- list()
for(i in codes){
  tmp <- df %>% filter(Code_1 == i | Code_2 == i | Code_3 == i| Code_4 == i) %>% mutate(interation = i)
  out <- c(out, list(tmp))
}

out
# [[1]]
#   transaction Code_1 Code_2 Code_3 Code_4 interation
# 1           1     QD     QE     QG     QK         QD
# 2           3     QI     SA     DI     QD         QD
# [[2]]
#   transaction Code_1 Code_2 Code_3 Code_4 interation
# 1           2     QK     QB     QH     QC         QH
# 2           5     QH     QC     QI     SA         QH
# [[3]]
#   transaction Code_1 Code_2 Code_3 Code_4 interation
# 1           3     QI     SA     DI     QD         SA
# 2           5     QH     QC     QI     SA         SA
do.call(rbind, out)
#   transaction Code_1 Code_2 Code_3 Code_4 interation
# 1           1     QD     QE     QG     QK         QD
# 2           3     QI     SA     DI     QD         QD
# 3           2     QK     QB     QH     QC         QH
# 4           5     QH     QC     QI     SA         QH
# 5           3     QI     SA     DI     QD         SA
# 6           5     QH     QC     QI     SA         SA

Я должен добавить, что я сохранил for l oop, чтобы он был похож на ваш начальный код; Предложение Руи использовать lapply - это шаг в "лучшем" направлении.

Answer 3

Мы могли бы создать логическое выражение с помощью rowSums

library(dplyr)
library(purrr)
map(codes, ~ 
       df %>% 
         filter(rowSums(select(., 
                starts_with('Code')) == .x) > 0) %>%
             mutate(interaction = .x)
       )
#[[1]]
#  transaction Code_1 Code_2 Code_3 Code_4 interaction
#1           1     QD     QE     QG     QK          QD
#2           3     QI     SA     DI     QD          QD

#[[2]]
#  transaction Code_1 Code_2 Code_3 Code_4 interaction
#1           2     QK     QB     QH     QC          QH
#2           5     QH     QC     QI     SA          QH

#[[3]]
#  transaction Code_1 Code_2 Code_3 Code_4 interaction
#1           3     QI     SA     DI     QD          SA
#2           5     QH     QC     QI     SA          SA

Answer 4

Раствор tidyverse. Мы назовем входной вектор, чтобы прояснить, что выходной test на самом деле представляет собой именованный список таблиц, как и нужно

codes <- c("QD","QH","SA")
names(codes) <- codes

library(dplyr)
library(purrr)

test <- purrr::map(codes, function(i){
  df %>% 
    rowwise() %>%
    filter(i %in% c_across(Code_1:Code_4)) %>% 
    mutate(interation = i) %>%
    ungroup
  
})

# test has everything but they are all named so ...

test$QD
#> # A tibble: 2 x 6
#>   transaction Code_1 Code_2 Code_3 Code_4 interation
#>         <dbl> <chr>  <chr>  <chr>  <chr>  <chr>     
#> 1           1 QD     QE     QG     QK     QD        
#> 2           3 QI     SA     DI     QD     QD