Unnesting beberapa tibble di dalam tibble untuk membagi pertanyaan survei Mutli-Select

Aug 21 2020

Saya mencoba membuat solusi terprogram untuk memperluas pertanyaan 'Respon Ganda' dari survei ke dalam kolom terpisah. Pengaturan melibatkan data survei (df1) dan file pembantu yang menghubungkan variabel dengan informasi tentang variabel. Dengan contoh data di bawah ini, tujuannya adalah untuk memperluas respons dalam DVar dan EVar menjadi kolom terpisah, misalnya DVar.A, DVar.b, dll ..., dengan biner 1,0 apakah ID tersebut mencentang kotak yang sesuai.

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

Fungsi kerja saat ini mengambil ID dan kolom untuk menyebar. Untuk tujuan saya saat ini, fungsi ini berfungsi dengan baik. Kecuali jika kolom tidak memiliki NAs (yang tidak biasa), yang memunculkan kesalahan tentang 'Tidak Ada' yang tidak ada dalam kumpulan data pada pernyataan pemilihan akhir.


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)
  
}

Menggunakan mutate (seberang) saya bisa mendapatkan kembali data yang diperlukan, yang kemudian digabungkan kembali ke kumpulan data lengkap (atau bisa dalam contoh).

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,.))) 

Ketika saya Melihat data, rstudio memberi saya apa yang saya inginkan kembali!

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
⋮

Namun, saat menulis data, saya menerima pesan kesalahan tentang dimensi yang tidak cocok. Hal ini dikarenakan struktur data yang dihasilkan berupa tibble 8x3 dengan kolom-kolom yaitu (Int, Tibble, Tibble). Dan Tibbles internal tampaknya dialihkan.

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

Menggunakan fungsi tidak terestimasi menghasilkan kesalahan yang sama seperti fungsi write_ tentang dimensi yang tidak cocok.

Saya juga mencoba menggunakan unfest_wider , tetapi saya mengalami masalah dengan beberapa kolom tibble karena fungsi unest_wider hanya membutuhkan satu kolom sebagai argumen.

Saya sudah mencoba menggunakan pivot_wider tetapi tidak tahu cara mengirimkannya ke nama kolom dengan benar dari getCols $ VariableName.

Saya memiliki beberapa upaya gagal yang dapat saya tambahkan, tetapi saya agak merasa ini adalah solusi sederhana dengan peta, dan saya tidak berhasil melakukannya.

Apakah ada solusi sederhana untuk beberapa tibble yang tidak terkendali dari dalam sebuah tibble. Senang mendengar umpan balik lainnya untuk menciptakan solusi yang lebih rapi dan elegan untuk masalah yang lebih besar juga.

Jawaban

1 akrun Aug 21 2020 at 02:27

Kita bisa menggunakan 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=",")

Atau jika kita ingin menggunakan untuk banyak kolom, salah satu opsinya adalah 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, .)

Dengan menggunakan fungsi OP, ini dapat dengan mudah diratakan 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

Atau bisa digunakan invoke

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