在R中生成新矩阵,该矩阵是旧矩阵,每行的所有值除以该行的中值

Question

这是一个有效的示例代码,但它不是最有效的.有人能用更少的步骤做到这一点吗？也许使用'lapply'？

set.seed(1)
A <- matrix(rexp(30, rate=.5), nrow = 6, ncol=5)
B <- rowMedians(A)
rownames(A) <- c('a', 'b', 'c', 'd', 'e', 'f')

res <- NULL
for (i in 1:NROW(A)){
one <- A[i,] / B[i]
res <- rbind(res, one)
}
rownames(res) <- rownames(A)

Answer 1

我们可以使用row函数和除法来复制'B' .

res1 <- A/B[row(A)]

要不就

res2 <- A/B
res2
#   [,1]      [,2]      [,3]      [,4]      [,5]
#a 1.0000000 1.6281669 1.6388153 0.4461621 0.1404597
#b 2.0079584 0.9170798 7.5175644 1.0000000 0.1010046
#c 0.1523225 1.0000000 1.1024242 2.4718750 0.6049886
#d 0.2177861 0.2290819 1.6127993 1.0000000 6.1675940
#e 0.3716561 1.1853071 1.5989225 0.2506753 1.0000000
#f 3.7990225 1.0000000 0.8592139 0.7425766 1.3081022

因为价值观的循环利用.

identical(res, res1)
#[1] TRUE
identical(res, res2)
#[1] TRUE

注意:rowMedians函数from matrixStats非常有效,使用它可以使输出A/B紧凑而高效.

基准

set.seed(124)
A1 <- matrix(rexp(1000*1000, rate = .5), ncol=500)

library(matrixStats)

akrun <- function(){A1/rowMedians(A1)}
lmo <- function() {sweep(A1, 1, apply(A1, 1, median), FUN="/")}
jason <- function() {t(apply(A1, 1, function(x) x/median(x)))}

microbenchmark(akrun(), lmo(), jason(), unit='relative', times = 20L)
#Unit: relative
#    expr      min       lq     mean   median       uq      max neval
# akrun() 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    20
#   lmo() 3.792782 3.984378 4.346874 4.304909 5.175328 2.821356    20
# jason() 4.192198 5.776239 5.689415 5.993730 6.300461 3.568759    20