在 tibble 中取消嵌套多个 tibble 以拆分 Mutli-Select 调查问题

Question

我正在尝试生成一个程序化解决方案，以将 'Multiple Response' 调查中的问题扩展到单独的列中。该设置涉及调查数据 (df1) 和将变量与有关变量的信息相关联的帮助文件。使用下面的示例数据，目标是将 DVar 和 EVar 中的响应扩展到单独的列中，例如DVar.A、DVar.b 等...，二进制 1,0 表示该 ID 是否选中了相应的框。

df1 <- tibble(ID = rep(1:8), AVar = sample(1:10, 8), BVar = rnorm(8), 
              CVar = c("Got", "Some", "Stuff", "In", "Here", "Got", "Others", "Too"),
              DVar = c("A,B", NA , "C", "A,C", "B,D", "C", "D", "B,D"), 
              EVar = c("Banana,Apple", "Orange,Raspberry", "Apple", NA, "Orange", "Banana", "Banana", "Raspberry"))

Helper <- tibble(VariableName = c("ID", "AVar", "BVar", "CVar", "DVar", "EVar"), 
                 QuestionType = c("ID", "Numeric", "Numeric", "Single Response", "Multiple Response", "Multiple Response"))

当前工作函数接受一个ID和要传播的列。就我目前的目的而言，此功能效果很好。除非列没有 NA（这是不常见的），这会在最终 select 语句的数据集中抛出关于 'None' 不在数据集中的错误。


MultiToCol <- function(ID, toSpread) {
  X <- tibble(ID, toSpread)
  
  X %>% mutate(varLong = strsplit(as.character(replace_na(toSpread, "None")),split=",")) %>% 
    unnest(varLong) %>% mutate(tmpValue = 1) %>% spread(varLong, tmpValue, fill = 0) %>% select(-None, -ID, -toSpread, None)
  
}

使用 mutate(across) 我能够取回必要的数据，然后将其连接回完整的数据集（或者可能在示例中）。

getCols <- Helper %>% filter(QuestionType == "Multiple Response") %>% select(VariableName)

spreadCols <- df1 %>% select_if(names(.) %in% c('ID', getCols$VariableName)) %>% 
  mutate(across(.cols = !ID, .fns = ~MultiToCol1(ID,.)))

当我查看数据时，rstudio 给了我我想要的东西！

ID  DVar.A  DVar.B  DVar.C  DVar.D  DVar.None   EVar.Apple  EVar.Banana EVar.Orange EVar.Raspberry  Evar.None
1   1   1   0   0   0   1   1   0   0   0
2   0   0   0   0   1   0   0   1   1   0
3   0   0   1   0   0   1   0   0   0   0
⋮

但是，在写入数据时，我收到有关尺寸不匹配的错误消息。这是因为生成的数据结构是一个 8x3 tibble，其列为 (Int, Tibble, Tibble)。并且内部的Tibbles似乎被转置了。

tibble [8 x 3] (S3: tbl_df/tbl/data.frame)
 $ ID  : int [1:8] 1 2 3 4 5 6 7 8
 $ DVar: tibble [8 x 5] (S3: tbl_df/tbl/data.frame)
  ..$ A   : num [1:8] 1 0 0 1 0 0 0 0
  ..$ B   : num [1:8] 1 0 0 0 1 0 0 1
  ..$ C   : num [1:8] 0 0 1 1 0 1 0 0
  ..$ D   : num [1:8] 0 0 0 0 1 0 1 1
  ..$ None: num [1:8] 0 1 0 0 0 0 0 0
 $ EVar: tibble [8 x 5] (S3: tbl_df/tbl/data.frame)
  ..$ Apple    : num [1:8] 1 0 1 0 0 0 0 0
  ..$ Banana   : num [1:8] 1 0 0 0 0 1 1 0
  ..$ Orange   : num [1:8] 0 1 0 0 1 0 0 0
  ..$ Raspberry: num [1:8] 0 1 0 0 0 0 0 1
  ..$ None     : num [1:8] 0 0 0 1 0 0 0 0

使用 unnest 函数会产生与 write_ 函数相同的关于不匹配维度的错误。

我也尝试过使用 unnest_wider，但是运行遇到了多个 tibble-columns 的问题，因为 unnest_wider 函数只接受一个列作为参数。

我试过使用 pivot_wider 但不知道如何从 getCols$VariableName 正确地传递列名。

我有一些失败的尝试可以添加，但我觉得这是一个简单的地图解决方案，我只是没有成功。

是否有任何简单的解决方案可以从 tibble 中取消嵌套多个 tibble。很高兴听到任何其他反馈，也可以为更大的问题创建更简洁、更优雅的解决方案。

Answer 1

我们可以使用 cSplit_e

library(splitstackshape)
library(dplyr)
df1 %>% 
    select_if(names(.) %in% c('ID', getCols$VariableName)) %>%
    cSplit_e("DVar", type = "character", fill = 0, sep=",") %>% 
    cSplit_e("EVar", type = "character", fill = 0, sep=",")

或者如果我们想用于多列，一个选项是 map

library(purrr)
tmp <- df1 %>%  
           select_if(names(.) %in% c('ID', getCols$VariableName))
map_dfc(setdiff(names(tmp), "ID"), ~
     tmp %>%
      select(.x) %>% 
      cSplit_e( .x, type = "character", fill = 0, sep=",") %>% 
      select(-.x)) %>% 
 bind_cols(tmp, .)

使用OP的函数，可以很容易的用as.data.frame

压扁

out <- df1 %>%
    select_if(names(.) %in% c('ID', getCols$VariableName)) %>% 
    mutate(across(.cols = !ID, .fns = ~MultiToCol(ID,.))) %>% 
    do.call(data.frame, .)
out
  ID DVar.A DVar.B DVar.C DVar.D DVar.None EVar.Apple EVar.Banana EVar.Orange EVar.Raspberry EVar.None
1  1      1      1      0      0         0          1           1           0              0         0
2  2      0      0      0      0         1          0           0           1              1         0
3  3      0      0      1      0         0          1           0           0              0         0
4  4      1      0      1      0         0          0           0           0              0         1
5  5      0      1      0      1         0          0           0           1              0         0
6  6      0      0      1      0         0          0           1           0              0         0
7  7      0      0      0      1         0          0           1           0              0         0
8  8      0      1      0      1         0          0           0           0              1         0



str(out)
#'data.frame':  8 obs. of  11 variables:
# $ ID            : int  1 2 3 4 5 6 7 8
# $ DVar.A        : num  1 0 0 1 0 0 0 0
# $ DVar.B        : num  1 0 0 0 1 0 0 1
# $ DVar.C        : num  0 0 1 1 0 1 0 0
# $ DVar.D        : num  0 0 0 0 1 0 1 1
# $ DVar.None     : num  0 1 0 0 0 0 0 0
# $ EVar.Apple    : num  1 0 1 0 0 0 0 0
# $ EVar.Banana   : num  1 0 0 0 0 1 1 0
# $ EVar.Orange   : num  0 1 0 0 1 0 0 0
# $ EVar.Raspberry: num  0 1 0 0 0 0 0 1
# $ EVar.None     : num  0 0 0 1 0 0 0 0

或者可以使用invoke

 ....
   %>% invoke(data.frame, .)

在 tibble 中取消嵌套多个 tibble 以拆分 Mutli-Select 调查问题

Unnesting multiple tibbles inside a tibble to split Mutli-Select survey questions

r

survey

dplyr

purrr

tidyverse