时间戳

首页 > 解决方案 > 将函数应用于矩阵的每一行而不使用 R 中的 lapply 函数

r - 将函数应用于矩阵的每一行而不使用 R 中的 lapply 函数

问题描述

我有一个包含多行的输入数据框。对于每一行，我想应用一个函数。输入数据框有 1,000,000+ 行。如何加快零件使用速度lapply ？我想避免以有效的方式将函数应用到每一行数据帧并返回数据帧列表中的应用函数系列，因为这些方法在我的情况下似乎很慢。

这是一个具有简单功能的可重现示例：

library(tictoc)   # enable use of tic() and toc() to record time taken for test to compute

func <- function(coord, a, b, c){

  X1 <- as.vector(coord[1])
  Y1 <- as.vector(coord[2])
  X2 <- as.vector(coord[3])
  Y2 <- as.vector(coord[4])

  if(c == 0) {

    res1 <- mean(c((X1 - a) : (X1 - 1), (Y1 + 1) : (Y1 + 40)))
    res2 <- mean(c((X2 - a) : (X2 - 1), (Y2 + 1) : (Y2 + 40)))
    res <- matrix(c(res1, res2), ncol=2, nrow=1)

  } else {

    res1 <- mean(c((X1 - a) : (X1 - 1), (Y1 + 1) : (Y1 + 40)))*b
    res2 <- mean(c((X2 - a) : (X2 - 1), (Y2 + 1) : (Y2 + 40)))*b
    res <- matrix(c(res1, res2), ncol=2, nrow=1)

  }

  return(res)
}

## Apply the function
set.seed(1)
n = 10000000
tab <- as.matrix(data.frame(x1 = sample(1:100, n, replace = T), y1 = sample(1:100, n, replace = T), x2 = sample(1:100, n, replace = T), y2 = sample(1:100, n, replace = T)))


tic("test 1")
test <- do.call("rbind", lapply(split(tab, 1:nrow(tab)),
                                function(x) func(coord = x,
                                                 a = 40,
                                                 b = 5,
                                                 c = 1)))
toc()



 ## test 1: 453.76 sec elapsed

标签： rlapply

解决方案

这似乎是一个重构向量化计算的好机会，R 可以更快地解决这个问题。（TL；DR：这使它快了大约 1000 倍。）

看起来这里的任务是对两个整数范围进行加权平均，其中范围的书挡因行而异（基于 X1、X2、Y1 和 Y2），但每行中的序列长度相同. 这很有帮助，因为这意味着我们可以使用代数来简化计算。

对于 a = 40 的简单情况，第一个序列将从 x1-40 到 x-1，从 y+1 到 y1+40。平均值将是这两项的总和除以 80。总和将是 40*X1 + 40*Y1 + (-40:-1) 的总和 + (1:40) 的总和，最后两项抵消. 因此，您可以简单地输出每对列的平均值，乘以 b。

library(dplyr)
b = 5
quick_test <- tab_tbl %>%
  as_data_frame() %>%
  mutate(V1 = (x1+y1)/2 * b,
         V2 = (x2+y2)/2 * b)

使用 n = 1E6（OP 的 10%），OP 函数需要 73 秒。上面的函数需要 0.08 秒并且具有相同的输出。

对于 的情况a != 40，它需要更多的代数。V1这里以加权平均值结束，我们将序列(x1-a):(x1-1)和序列相加(y1+1):(y1+40)，全部除以a+40(因为序列中有a项，x1序列中有 40 个项y1。我们实际上不需要把这个序列相加；我们可以使用代数将其转换为更短的计算：https ://en.wikipedia.org/wiki/Arithmetic_progression

sum of (x1-a):(x1-1)= x1*a + sum of (-a:-1)= x1*a + a*(-a + -1)/2=x1*a - (a*a + a)/2

这一切意味着我们可以使用以下方法完全复制任何正面的代码a：

a = 50
b = 5

tictoc::tic("test 2b")
quick_test2 <- quick_test <- tab %>%
  as_data_frame() %>%
  mutate(V1 = (a*x1 - (a*a + a)/2  + 40*y1 + 820)/(a+40)*b,
         V2 = (a*x2 - (a*a + a)/2  + 40*y2 + 820)/(a+40)*b)
tictoc::toc()

这大约快 1000 倍。在 n = 1E6、a = 41、b = 5、c = 1 的情况下，OP 解决方案在我的 2012 笔记本电脑上花费了 154 秒，而quick_test2上面的解决方案花费了 0.23 秒并得到了相同的结果。

（小附录，如果 c == 0，您可以添加一个测试来设置 b = 1，然后您已经处理了 if-else 条件。）

推荐阅读