【问题标题】:How to bind observations from a function with multiple arguments into rows?如何将具有多个参数的函数的观察结果绑定到行中?
【发布时间】:2018-07-14 13:01:52
【问题描述】:

我想做一个模拟来证明一些事情。因此,我创建了一个生成一个观察结果的函数,与下面的非常相似。

set.seed(458007)

fun1 <- function(M, x, y){
  M <- matrix(NA, nrow = 1, ncol = 4)
  M[, 1] <- x
  M[, 2] <- y
  M[, 3] <- mean(rnorm(x, 0, y))
  M[, 4] <- mean(rnorm(x, 1, y))
  return(M)
}

fun1(x=1e3, y=.5)
#      [,1] [,2]        [,3]      [,4]
# [1,] 1000  0.5 0.001414806 0.9875602

对于现在的模拟,我想将具有不同参数的重复观察绑定到行中,并选择lapply() 方法。尽管我使用了以下代码,但具有讽刺意味的是,它是最慢的。请注意,在related question 中,我略微过度最小化了我的问题示例,该示例实际上有点嵌套。也许有人可以帮助我找到更快的解决方案?

#  lapply
do.call(rbind, lapply(c(.5, 1, 1.5), function(y)
  do.call(rbind, lapply(c(1e3, 1e4, 1e5), 
         function(x) do.call(rbind, lapply(1:5, fun1, x, y))))))
#        [,1] [,2]          [,3]      [,4]
#  [1,] 1e+03  0.5  0.0156969547 0.9878933
#  [2,] 1e+03  0.5  0.0187202908 1.0011313
#  [3,] 1e+03  0.5 -0.0351017539 0.9953701
#  [4,] 1e+03  0.5 -0.0129749736 1.0112514
#  [5,] 1e+03  0.5 -0.0154776052 0.9793552
#  [6,] 1e+04  0.5 -0.0070121049 1.0022838
#  [7,] 1e+04  0.5 -0.0064961931 0.9967966
#  [8,] 1e+04  0.5 -0.0054208002 0.9955582
#  [9,] 1e+04  0.5 -0.0027074479 1.0019217
# [10,] 1e+04  0.5  0.0047017946 1.0069838
# [11,] 1e+05  0.5 -0.0018550320 0.9981459
# [12,] 1e+05  0.5 -0.0019201731 0.9973762
# [13,] 1e+05  0.5 -0.0031555017 1.0016808
# [14,] 1e+05  0.5 -0.0005508661 1.0001200
# [15,] 1e+05  0.5  0.0002928878 0.9991147
# [16,] 1e+03  1.0  0.0043441072 0.9579204
# [17,] 1e+03  1.0 -0.0059409534 1.0068553
# [18,] 1e+03  1.0  0.0850053171 1.0316056
# [19,] 1e+03  1.0 -0.0145192268 1.0193467
# [20,] 1e+03  1.0  0.0104437603 0.9959815
# [21,] 1e+04  1.0  0.0252303898 0.9968866
# [22,] 1e+04  1.0  0.0039449755 0.9818866
# [23,] 1e+04  1.0  0.0145974970 0.9814802
# [24,] 1e+04  1.0 -0.0016105680 0.9968357
# [25,] 1e+04  1.0  0.0058877101 1.0049794
# [26,] 1e+05  1.0  0.0015416062 1.0008094
# [27,] 1e+05  1.0  0.0004725605 1.0001917
# [28,] 1e+05  1.0 -0.0007963141 1.0019771
# [29,] 1e+05  1.0 -0.0007302225 0.9969158
# [30,] 1e+05  1.0  0.0023877190 1.0060436
# [31,] 1e+03  1.5  0.0165765473 0.9391917
# [32,] 1e+03  1.5 -0.0990828503 1.0256720
# [33,] 1e+03  1.5  0.0526152728 0.9981981
# [34,] 1e+03  1.5  0.1472273215 0.9442844
# [35,] 1e+03  1.5  0.0346540383 1.0316669
# [36,] 1e+04  1.5 -0.0007479431 0.9800219
# [37,] 1e+04  1.5  0.0189053160 1.0284075
# [38,] 1e+04  1.5  0.0062155928 0.9821324
# [39,] 1e+04  1.5 -0.0065533501 1.0085699
# [40,] 1e+04  1.5 -0.0161694486 1.0126392
# [41,] 1e+05  1.5 -0.0090145992 0.9952551
# [42,] 1e+05  1.5 -0.0024756213 1.0054282
# [43,] 1e+05  1.5  0.0061985946 0.9966108
# [44,] 1e+05  1.5  0.0023640342 0.9988624
# [45,] 1e+05  1.5  0.0014610948 0.9956877

使用@lefft 和@Parfait 的解决方案进行基准测试(来自示例)

# Unit: milliseconds
#       expr      min       lq     mean   median       uq      max neval
#       mine 325.8589 347.1616 405.6944 398.6682 434.9392 906.7906   100
#      lefft 327.6870 348.3504 393.7511 393.2127 421.4536 694.1610   100
#    Parfait 323.5595 343.5806 396.9973 390.9864 423.0759 736.2887   100

【问题讨论】:

    标签: r function lapply rbind


    【解决方案1】:

    这是一个很好的紧凑方法:

    # create the input data *before* applying the func to it 
    dat <- expand.grid(Ms=1:5, xs=c(1e3, 1e4, 1e5), ys=c(.5, 1, 1.5))
    
    # apply the function to each row of the data frame (`MARGIN=1` is row-wise) 
    # (the outermost function `t()` transposes the result so it looks like yours)
    t(apply(dat, MARGIN=1, FUN=function(row) fun1(M=row[1], x=row[2], y=row[3])))
    

    它比原始解决方案快约 10%,但随着数据量的增加,差异可能会有所不同。需要注意的一点是,如果您首先创建参数网格(如此处所做),则可以更轻松地隔离使用 fun1() 进行计算所花费的时间(即,您可以知道什么需要很长时间 - 计算或输入数据框的创建)。

    希望这会有所帮助!

    【讨论】:

    • 谢谢!事实上,它更紧凑,速度也稍好一些。请参阅添加到我的问题的基准。
    • @jaySf,尝试将 lefft 的解决方案转换为 mapply,以便在 dat 列中以元素方式向下走:t(mapply(fun1, dat$M, dat$x, dat$y))
    猜你喜欢
    • 2017-09-05
    • 2020-08-22
    • 2015-03-05
    • 1970-01-01
    • 1970-01-01
    • 2020-06-26
    • 1970-01-01
    • 1970-01-01
    • 2013-03-06
    相关资源
    最近更新 更多