如何以与我的订单矩阵中相同的顺序每行更改列答案

【问题标题】：How do I change columns in the same order as in my order matrix, per row如何以与我的订单矩阵中相同的顺序每行更改列
【发布时间】：2020-06-04 20:35:56
【问题描述】：

我有一个矩阵，用于存储问卷项目的顺序，其中第一列包含第一次显示的项目的名称，第二列包含第二个显示的项目，等等。这个矩阵中的每一行代表一份新问卷，项目相同，但随机顺序不同。

> order.matrix
     [,1]    [,2]    [,3]   
[1,] "Anger" "Happy" "Sad"  
[2,] "Happy" "Sad"   "Anger"
[3,] "Sad"   "Anger" "Happy"

我已将项目的响应存储在数据框中：

> df.responses
  Anger Happy Sad
1     1     2   3
2     3     2   0
3     9     2   1

现在，我想更改df.responses 中响应的顺序，使其类似于order.matrix 中每个行的项目顺序。（因此，df.responses 的列名不应再出现在结果 df 中。）此示例中的结果应如下所示：

> df.result
  V1 V2 V3
1  1  2  3
2  2  0  3
3  1  9  2

我可以/应该怎么做？

编辑，由于评论：我想用 df.responses 中的相应值替换 order.matrix 中的项目名称

【问题讨论】：

让我看看我是否正确：在 order.matrix 中，您想用 df.responses 中的相应值替换每一行的名称？
没错！

标签： r

【解决方案1】：

使用基础 R，您可以遍历矩阵行并通过按矩阵行值选择列顺序来分配 df.responses 中的值：

# copy df.responses so we won't grow an object in the loop
df.result <- df.responses
# Rename the columns as they won't be correct after
colnames(df.result) <- c("V1","V2","V3")

for (x in 1:nrow(order.matrix)) {
  # replace the line with the value ordered by the matrix line names
  df.result[x,] <- df.responses[x,order.matrix[x,]]  
}

【讨论】：

【解决方案2】：

1.创建可重现的示例

order.matrix <- matrix(c("Anger", "Happy", "Sad", "Happy", "Sad","Anger", "Sad", "Anger", "Happy"),
                       ncol=3,
                       byrow=TRUE)

df.responses <-matrix(c(1, 2, 3, 3, 2, 0, 9, 2, 1),
                        ncol=3,
                        byrow=TRUE)
colnames(df.responses) <- c("Anger", "Happy", "Sad")

2.使用基础R的解决方案：

result <- NULL
for (i in seq_along(order.matrix[, 1])) {
  result <- rbind(result, df.responses[i, order.matrix[i, ]])
}
colnames(result) <- c("V1", "V2", "V3")

        V1    V2  V3
[1,]     1     2   3
[2,]     2     0   3
[3,]     1     9   2

【讨论】：

【解决方案3】：

基本 R 选项是使用mapply，即，

df.result <- t(mapply(function(v,k) v[k], 
                      data.frame(t(df.responses)),
                      data.frame(t(order.matrix)),
                      USE.NAMES = F
                      )
               )

这样

> df.responses
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    2    0    3
[3,]    1    9    2

【讨论】：

【解决方案4】：

purrr 的解决方案可能如下

df.result <- map2(.x = lapply(seq_len(nrow(responses)), function(i) responses[i,]),
                  .y = lapply(seq_len(nrow(order)), function(i) order[i,]),
                  .f = ~ .x[.y])
do.call("rbind", df.result)

在此代码中，.x 和 .y 是向量列表，即行列表（在此帖子之后 https://stackoverflow.com/a/6821395/11086911）。然后将map2 的输出聚合到具有do.call 和rbind 的矩阵中。

如果有人对这与其他解决方案的比较感到好奇，这里有一个比较。

library(microbenchmark)
library(purrr)
set.seed(42) # For reproducibility purposes

# Comparison with given data
order.matrix <- matrix(c("Anger", "Happy", "Sad", "Happy", "Sad","Anger", "Sad", "Anger", "Happy"),
                       ncol=3,
                       byrow=TRUE)

df.responses <- matrix(c(1, 2, 3, 3, 2, 0, 9, 2, 1),
                       ncol=3,
                       byrow=TRUE)
colnames(df.responses) <- c("Anger", "Happy", "Sad")

solForLoop <- function(order, responses) {
  df.result <- responses
  colnames(df.result) <- paste0("V", 1:ncol(responses))
  for (i in 1:nrow(order)) {
    df.result[i,] <- responses[i,order[i,]]  
  }
  df.result
}

solmApply <- function(order, responses) {
  t(mapply(FUN = function(x, y) x[y], 
           as.data.frame(t(responses)),
           as.data.frame(t(order)),
           USE.NAMES = F
  ))
 }

solPurrr <- function(order, responses) {
  df.result <- map2(.x = lapply(seq_len(nrow(responses)), function(i) responses[i,]),
                    .y = lapply(seq_len(nrow(order)), function(i) order[i,]),
                    .f = ~ .x[.y])
  do.call("rbind", df.result)
}

microbenchmark::microbenchmark(
  solForLoop(order.matrix, df.responses),
  solmApply(order.matrix, df.responses),
  solPurrr(order.matrix, df.responses),
  times = 1000L,
  check = "equivalent"
)

# Unit: microseconds
#                                   expr     min      lq      mean   median       uq       max neval
# solForLoop(order.matrix, df.responses)   8.601  11.101  15.03331  15.9010  17.3020    62.002  1000
#  solmApply(order.matrix, df.responses) 313.801 346.701 380.32261 357.7510 374.2010 14322.900  1000
#   solPurrr(order.matrix, df.responses)  49.900  61.301  70.68950  70.7015  75.8015   190.700  1000

鉴于数据来自问卷调查，我假设order.matrix 行中的每个值只能出现一次。对于具有相同 3 列但 100 000 行的矩阵，我们发现

# Comparison for big data
order.matrix.big <- as.matrix(sample_n(as.data.frame(order.matrix), 100000, replace = TRUE))
df.responses.big <- as.matrix(sample_n(as.data.frame(df.responses), 100000, replace = TRUE))

microbenchmark::microbenchmark(
    solForLoop(order.matrix.big, df.responses.big),
    solmApply(order.matrix.big, df.responses.big),
    solPurrr(order.matrix.big, df.responses.big),
    times = 100L,
    check = "equivalent"
)

# Unit: milliseconds
#                                           expr       min        lq      mean    median        uq       max neval
# solForLoop(order.matrix.big, df.responses.big)  110.2585  130.0916  163.3382  142.4249  167.7584  514.7262   100
#  solmApply(order.matrix.big, df.responses.big) 4669.8815 4866.6152 5232.1814 5160.2967 5385.5000 6568.1718   100
#   solPurrr(order.matrix.big, df.responses.big)  441.6195  502.0853  697.7207  669.4963  871.9122 1218.6721   100

因此，虽然map2 提供了一种有趣的方式来“循环”行，但在这种情况下，它不如简单的 for 循环那么快。

【讨论】：