從多個變量到寬格式到長格式

Question

這個問題與我之前提出的一個問題有關，它將R從寬格式轉換爲長格式並帶來額外的複雜性。

前面的問題就在這裏：Wide to long data conversion

寬的數據我開始看起來如下：

d2 <- data.frame('id' = c(1,2), 
      'Q1' = c(2,3), 
      'Q2' = c(1,3), 
      'Q3' = c(3,1), 
      'Q1_X_Opt_1' = c(0,0), 
      'Q1_X_Opt_2' = c(75,200), 
      'Q1_X_Opt_3' = c(150,300), 
      'Q2_X_Opt_1' = c(0,0), 
      'Q2_X_Opt_2' = c(150,200), 
      'Q2_X_Opt_3' = c(75,300), 
      'Q3_X_Opt_1' = c(0,0), 
      'Q3_X_Opt_2' = c(100,500), 
      'Q3_X_Opt_3' = c(150,300)) 

在這個例子中，還有誰已經回答了三個問題，兩個人。每個問題的答案在Q1，Q2和Q3中使用以下值{1,2,3}進行編碼。因此，在這個例子中，個人1在Q1中選擇了選項2，在Q2中選擇了選項1，並在Q3中選擇了選項3。

對於每個選項，還有一個變量X與每個選項關聯，我也需要將其轉換爲寬格式。我正在尋找類似以下的輸出：

id question option choice cost 
1 1  1  1  0 0 
2 1  1  2  1 75 
3 1  1  3  0 150 
4 1  2  1  1 0 
5 1  2  2  0 150 
6 1  2  3  0 75 
7 1  3  1  0 0 
8 1  3  2  0 100 
9 1  3  3  1 150 
10 2  1  1  0 0 
11 2  1  2  0 200 
12 2  1  3  1 300 
13 2  2  1  0 0 
14 2  2  2  0 200 
15 2  2  3  1 300 
16 2  3  1  1 0 
17 2  3  2  0 500 
18 2  3  3  0 300 

我試圖從答案的問題之前調整的代碼，但沒有成功迄今。感謝您的任何建議或意見。

Answer 1

這不完全優雅，但這裏有一個tidyverse版本：

library(tidyverse) 

d3 <- d2 %>% 
    gather(option, cost, -id:-Q3) %>% 
    gather(question, choice, Q1:Q3) %>% 
    separate(option, c('question2', 'option'), extra = 'merge') %>% 
    filter(question == question2) %>% 
    mutate_at(vars(question, option), parse_number) %>% 
    mutate(choice = as.integer(option == choice)) %>% 
    select(1, 5, 3, 6, 4) %>% 
    arrange(id) 

d3 
#> id question option choice cost 
#> 1 1  1  1  0 0 
#> 2 1  1  2  1 75 
#> 3 1  1  3  0 150 
#> 4 1  2  1  1 0 
#> 5 1  2  2  0 150 
#> 6 1  2  3  0 75 
#> 7 1  3  1  0 0 
#> 8 1  3  2  0 100 
#> 9 1  3  3  1 150 
#> 10 2  1  1  0 0 
#> 11 2  1  2  0 200 
#> 12 2  1  3  1 300 
#> 13 2  2  1  0 0 
#> 14 2  2  2  0 200 
#> 15 2  2  3  1 300 
#> 16 2  3  1  1 0 
#> 17 2  3  2  0 500 
#> 18 2  3  3  0 300 

Answer 2

1）首先melt輸入它transformihg長期形式。然後使用read.table分隔variable下劃線的列，分別給出名爲V1，V2，V3，V4的列，分別表示問題爲因素，垃圾，垃圾和選項部分。追加回m並將問題設置爲V1的因子水平，並將選項設置爲V4。按id排序以給出與問題中相同的順序。 （如果訂單無關緊要，則可以刪除此行）

現在將各部分放在一起，注意如果Q1/Q2/Q3列中的相應列等於選項，則選擇爲1，否則爲0。

library(reshape2) 

m <- melt(d2, id = 1:4) 
m <- cbind(m, read.table(text = as.character(m$variable), sep = "_")) 
m <- transform(m, question = as.numeric(V1), option = V4) 
m <- m[order(m$id), ] 
n <- nrow(m) 
with(m, data.frame(id, 
    question, 
    option, 
    choice = (m[cbind(1:n, question + 1)] == option) + 0, 
    value)) 

結果是：

id question option choice value 
1 1  1  1  0  0 
2 1  1  2  1 75 
3 1  1  3  0 150 
4 1  2  1  1  0 
5 1  2  2  0 150 
6 1  2  3  0 75 
7 1  3  1  0  0 
8 1  3  2  0 100 
9 1  3  3  1 150 
10 2  1  1  0  0 
11 2  1  2  0 200 
12 2  1  3  1 300 
13 2  2  1  0  0 
14 2  2  2  0 200 
15 2  2  3  1 300 
16 2  3  1  1  0 
17 2  3  2  0 500 
18 2  3  3  0 300 

2）這也可以使用magirttr給出了相同的答案表示。需要注意的是最後兩個管道使用博覽會操作%$%周圍提供後續表達的隱含with(., ...)：

library(magrittr) 
library(reshape2) 

d2 %>% 
    melt(id = 1:4) %>% 
    cbind(read.table(text = as.character(.$variable), sep = "_")) %>% 
    transform(question = as.numeric(V1), option = V4) %$% 
    .[order(id), ] %$% 
    data.frame(id, 
       question, 
       option, 
       choice = (.[cbind(1:nrow(.), question + 1)] == option) + 0, 
       value) 

3）這可以被翻譯成reshape2/dplyr/tidyr：

library(reshape2) 
library(dplyr) 
library(tidyr) 

d2 %>% 
    melt(id = 1:4) %>% 
    separate(variable, c("question", "X", "Opt", "option")) %>% 
    arrange(id) %>% 
    mutate(question = as.numeric(factor(question)), 
      choice = (.[cbind(1:n(), question + 1)] == option) + 0) %>% 
    select(id, question, option, choice, value)