Question

这个问题与我之前提出的关于在R中从宽格式转换为长格式的问题有关，并带来了额外的复杂性。

我开始的广泛数据如下所示：

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

它并不完全优雅，但这是一个整齐的版本：

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输入将其转换为长格式。然后使用variable拆分下划线上的read.table列，将名为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)

具有多个变量的宽到长格式

2 个答案: