将数据框转换为列表的嵌套列表，其中一些元素被命名，一些元素未命名

Question

我正在尝试将我的数据框转换为可能很复杂的列表列表，但我正在努力寻找正确的命令，因为某些列表部分必须命名，有些必须未命名，有些应该通过管道传输作为字符向量，一些作为列表。这是将数据输入 API 所必需的。

这是我的输入数据：

df <- data.frame(id = c("xyz", "abc"),
                 country = c("DE", "UK"),
                 info = c("QC4_combined test", "QC4_combined test"),
                 QC4A_DE = c("test 1", NA),
                 QC4A_UK = c(NA, "test4"))

# which gives
#    id country              info QC4A_DE QC4A_UK
# 1 xyz      DE QC4_combined_test  test 1    <NA>
# 2 abc      UK QC4_combined_test    <NA>   test4

现在，我需要重塑数据，以便它为我提供以下信息：

rows = list(list(answers           = list(list(text     = c("test 1"),
                                               question = c("QC4A_DE")),
                                          list(text     = c(""),
                                               question = c("QC4A_UK"))),
                 auxiliary_columns = c("xyz", "DE", "QC4_combined test")),
            list(answers           = list(list(text     = c(""),
                                               question = c("QC4A_DE")),
                                          list(text     = c("test4"),
                                               question = c("QC4A_UK"))),
                 auxiliary_columns = c("abc", "UK", "QC4_combined test")))

# which gives
[[1]]
[[1]]$answers
[[1]]$answers[[1]]
[[1]]$answers[[1]]$text
[1] "test 1"

[[1]]$answers[[1]]$question
[1] "QC4A_DE"


[[1]]$answers[[2]]
[[1]]$answers[[2]]$text
[1] ""

[[1]]$answers[[2]]$question
[1] "QC4A_UK"



[[1]]$auxiliary_columns
[1] "xyz"               "DE"                "QC4_combined test"


[[2]]
[[2]]$answers
[[2]]$answers[[1]]
[[2]]$answers[[1]]$text
[1] ""

[[2]]$answers[[1]]$question
[1] "QC4A_DE"


[[2]]$answers[[2]]
[[2]]$answers[[2]]$text
[1] "test4"

[[2]]$answers[[2]]$question
[1] "QC4A_UK"



[[2]]$auxiliary_columns
[1] "abc"               "UK"                "QC4_combined test"

我尝试了不同的方法，其中包括以下内容。它似乎给了我一些列表，但同样，它的结构不正确

df %>%
  mutate(across(all_of(input_names_1), function(x) if_else(is.na(x), "", x))) %>%
  pivot_longer(cols      = all_of(input_names_1),
               names_to  = "question",
               values_to = "text") %>%
  mutate(answers_raw = apply(across(c(question, text)), 1, as.list)) %>%
  select(-text) %>%
  pivot_wider(names_from  = question,
              values_from = answers_raw) %>%
  mutate(answers           = apply(across(input_names_1), 1, function(x) c(x)),
         auxiliary_columns = apply(across(all_of(input_names_2)), 1, function(x) list(x)),
         rows = apply(across(c(answers, auxiliary_columns)), 1, list))

我的主要问题是我不知道何时需要使用 list 以及何时使用 c 以及如何设置或删除列表名称（动态）。

这个例子当然只是一个简化。在我的真实案例中，我的数据框中有数千行，所以我不能像上面使用 rows 对象那样手动构建它

Answer 1

可能有一种整洁的方式来做到这一点（我没有尝试过），但是一些好的老式 R 呢？

df <- data.frame(id = c("xyz", "abc"),
                 country = c("DE", "UK"),
                 info = c("QC4_combined_test", "QC4_combined_test"),
                 QC4A_DE = c("test 1", NA),
                 QC4A_UK = c(NA, "test4"))
df
#>    id country              info QC4A_DE QC4A_UK
#> 1 xyz      DE QC4_combined_test  test 1    <NA>
#> 2 abc      UK QC4_combined_test    <NA>   test4


process_row <- function(aux_cols, data, row) {
  
  process_col <- function(col) list(text = ifelse(is.na(col[[1]]), "", col[[1]]),
                                    question = colnames(col))
  
  d <- data[row, -c(aux_cols), drop = FALSE]
  
  output <- list()
  for (j in seq_len(ncol(d))) {
    output[[j]] <- process_col(d[, j, drop = FALSE])
  }
  list(answers = output,
       auxiliary_columns = unname(as.character(data[row, aux_cols])))
}

process_all <- function(aux_cols, data) {
  lapply(seq_len(nrow(data)), function(row) process_row(aux_cols = aux_cols, data = df, row))
}

process_all(1:3, df)
#> [[1]]
#> [[1]]$answers
#> [[1]]$answers[[1]]
#> [[1]]$answers[[1]]$text
#> [1] "test 1"
#> 
#> [[1]]$answers[[1]]$question
#> [1] "QC4A_DE"
#> 
#> 
#> [[1]]$answers[[2]]
#> [[1]]$answers[[2]]$text
#> [1] ""
#> 
#> [[1]]$answers[[2]]$question
#> [1] "QC4A_UK"
#> 
#> 
#> 
#> [[1]]$auxiliary_columns
#> [1] "xyz"               "DE"                "QC4_combined_test"
#> 
#> 
#> [[2]]
#> [[2]]$answers
#> [[2]]$answers[[1]]
#> [[2]]$answers[[1]]$text
#> [1] ""
#> 
#> [[2]]$answers[[1]]$question
#> [1] "QC4A_DE"
#> 
#> 
#> [[2]]$answers[[2]]
#> [[2]]$answers[[2]]$text
#> [1] "test4"
#> 
#> [[2]]$answers[[2]]$question
#> [1] "QC4A_UK"
#> 
#> 
#> 
#> [[2]]$auxiliary_columns
#> [1] "abc"               "UK"                "QC4_combined_test"

^{由reprex package (v1.0.0) 于 2021-04-13 创建}

Answer 2

感谢您的回复。工作正常，但是用几个自定义函数查看你的代码我至少没有错，假设它是一个更复杂的重塑。

在上面的一些启发下，我终于也设法用一种 tidyverse 方法来做不同的事情。

input_names_1 = c("QC4A_DE", "QC4A_UK")
input_names_2 = c("id", "country", "info")

df2 <- df %>%
  mutate(across(all_of(input_names_1), function(x) if_else(is.na(x), "", x))) %>%
  pivot_longer(cols      = all_of(input_names_1),
               names_to  = "question",
               values_to = "text") %>%
  mutate(answers_raw = apply(across(c(text, question)), 1, as.list)) %>%
  select(-text) %>%
  pivot_wider(names_from  = question,
              values_from = answers_raw) %>%
  mutate(answers = apply(across(all_of(input_names_1)), 1, function(x) list(unname(x))),
         answers = unlist(answers, recursive = FALSE)) %>%
  rowwise() %>%
  mutate(auxiliary_columns = list(c_across(all_of(input_names_2)))) %>%
  ungroup() %>%
  mutate(rows = apply(across(c(answers, auxiliary_columns)), 1, list),
         rows = unlist(rows, recursive = FALSE))

rows_new <- df2$rows

identical(rows, rows_new)
# [1] TRUE