複数の変数を持つワイドからロングの形式

Question

この質問は以前の質問と関連しています。

前の質問はここにある：私は以下のようなルックスで始まる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)) 

、3つの質問に答えてきた二人の個人があります。各質問に対する答えは、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となります。これはまた、同じ回答を与えるmagirttrを用いて表現することができる

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）：

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

結果です。これはreshape2/dplyr/tidyrに変換することができ

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）：

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)