数据表|组内更快的逐行递归更新

2024-02-15

我必须执行以下递归逐行操作才能获得z:

myfun = function (xb, a, b) {

z = NULL

for (t in 1:length(xb)) {

    if (t >= 2) { a[t] = b[t-1] + xb[t] }
    z[t] = rnorm(1, mean = a[t])
    b[t] = a[t] + z[t]

}

return(z)

}

set.seed(1)

n_smpl = 1e6 
ni = 5

id = rep(1:n_smpl, each = ni)

smpl = data.table(id)
smpl[, time := 1:.N, by = id]

a_init = 1; b_init = 1
smpl[, ':=' (a = a_init, b = b_init)]
smpl[, xb := (1:.N)*id, by = id]

smpl[, z := myfun(xb, a, b), by = id]

我想获得这样的结果:

      id time a b  xb            z
  1:   1    1 1 1   1    0.3735462
  2:   1    2 1 1   2    2.7470924
  3:   1    3 1 1   3    8.4941848
  4:   1    4 1 1   4   20.9883695
  5:   1    5 1 1   5   46.9767390
 ---                              
496: 100    1 1 1 100    0.3735462
497: 100    2 1 1 200  200.7470924
498: 100    3 1 1 300  701.4941848
499: 100    4 1 1 400 1802.9883695
500: 100    5 1 1 500 4105.9767390

这确实有效,但需要时间:

system.time(smpl[, z := myfun(xb, a, b), by = id])
   user  system elapsed 
 33.646   0.994  34.473

考虑到实际数据的大小(超过 200 万个观察值),我需要加快速度。我猜do.call(myfun, .SD), .SDcols = c('xb', 'a', 'b') with by = .(id, time)会快得多,避免内部的 for 循环myfun。但是,我不确定如何更新b及其滞后(可能使用shift)当我运行这个逐行操作时data.table。有什么建议么?


好问题!

从新的 R 会话开始,显示包含 500 万行的演示数据,这是问题中的函数和我笔记本电脑上的计时。内嵌一些评论。

require(data.table)   # v1.10.0
n_smpl = 1e6
ni = 5
id = rep(1:n_smpl, each = ni)
smpl = data.table(id)
smpl[, time := 1:.N, by = id]
a_init = 1; b_init = 1
smpl[, ':=' (a = a_init, b = b_init)]
smpl[, xb := (1:.N)*id, by = id]

myfun = function (xb, a, b) {

  z = NULL
  # initializes a new length-0 variable

  for (t in 1:length(xb)) {

      if (t >= 2) { a[t] = b[t-1] + xb[t] }
      # if() on every iteration. t==1 could be done before loop

      z[t] = rnorm(1, mean = a[t])
      # z vector is grown by 1 item, each time

      b[t] = a[t] + z[t]
      # assigns to all of b vector when only really b[t-1] is
      # needed on the next iteration 
  }
  return(z)
}

set.seed(1); system.time(smpl[, z := myfun(xb, a, b), by = id][])
   user  system elapsed 
 19.216   0.004  19.212

smpl
              id time a b      xb            z
      1:       1    1 1 1       1 3.735462e-01
      2:       1    2 1 1       2 3.557190e+00
      3:       1    3 1 1       3 9.095107e+00
      4:       1    4 1 1       4 2.462112e+01
      5:       1    5 1 1       5 5.297647e+01
     ---                                      
4999996: 1000000    1 1 1 1000000 1.618913e+00
4999997: 1000000    2 1 1 2000000 2.000000e+06
4999998: 1000000    3 1 1 3000000 7.000003e+06
4999999: 1000000    4 1 1 4000000 1.800001e+07
5000000: 1000000    5 1 1 5000000 4.100001e+07

So 19.2s是时候打败了。在所有这些计时中,我在本地运行了该命令 3 次,以确保其计时稳定。在此任务中,时间差异微不足道,因此我将仅报告一个时间,以使答案能够更快地阅读。

解决上面的内联评论myfun() :

myfun2 = function (xb, a, b) {

  z = numeric(length(xb))
  # allocate size up front rather than growing

  z[1] = rnorm(1, mean=a[1])
  prevb = a[1]+z[1]
  t = 2L
  while(t<=length(xb)) {
    at = prevb + xb[t]
    z[t] = rnorm(1, mean=at)
    prevb = at + z[t]
    t = t+1L
  }
  return(z)
}
set.seed(1); system.time(smpl[, z2 := myfun2(xb, a, b), by = id][])
   user  system elapsed 
 13.212   0.036  13.245 
smpl[,identical(z,z2)]
[1] TRUE

这相当不错(19.2 秒降至 13.2 秒),但它仍然是一个for在 R 级别循环。乍一看它不能矢量化,因为rnorm()调用取决于之前的值。事实上,它可能可以通过使用以下属性进行矢量化:m+sd*rnorm(mean=0,sd=1) == rnorm(mean=m, sd=sd)并调用矢量化rnorm(n=5e6)一次而不是 5e6 次。但可能会有一个cumsum()参与与团体打交道。因此,我们不要去那里,因为这可能会使代码更难阅读,并且会针对这个精确的问题。

那么让我们尝试一下 Rcpp,它看起来与您编写的风格非常相似,并且适用范围更广:

require(Rcpp)   # v0.12.8
cppFunction(
'NumericVector myfun3(IntegerVector xb, NumericVector a, NumericVector b) {
  NumericVector z = NumericVector(xb.length());
  z[0] = R::rnorm(/*mean=*/ a[0], /*sd=*/ 1);
  double prevb = a[0]+z[0];
  int t = 1;
  while (t<xb.length()) {
    double at = prevb + xb[t];
    z[t] = R::rnorm(at, 1);
    prevb = at + z[t];
    t++;
  }
  return z;
}')

set.seed(1); system.time(smpl[, z3 := myfun3(xb, a, b), by = id][])
   user  system elapsed 
  1.800   0.020   1.819 
smpl[,identical(z,z3)]
[1] TRUE

好多了:19.2秒降至1.8秒。但是每次调用该函数都会调用第一行(NumericVector()),它会分配一个与组中的行数一样长的新向量。然后填写并返回,并将其复制到该组正确位置的最后一列(通过:=),仅待发布。所有这 100 万个小型临时向量(每组一个)的分配和管理都有点复杂。

我们为什么不一次性完成整个专栏呢?您已经以 for 循环风格编写了它,这没有任何问题。让我们调整 C 函数以接受id列也并添加if当它到达一个新组时。

cppFunction(
'NumericVector myfun4(IntegerVector id, IntegerVector xb, NumericVector a, NumericVector b) {

  // ** id must be pre-grouped, such as via setkey(DT,id) **

  NumericVector z = NumericVector(id.length());
  int previd = id[0]-1;  // initialize to anything different than id[0]
  for (int i=0; i<id.length(); i++) {
    double prevb;
    if (id[i]!=previd) {
      // first row of new group
      z[i] = R::rnorm(a[i], 1);
      prevb = a[i]+z[i];
      previd = id[i];
    } else {
      // 2nd row of group onwards
      double at = prevb + xb[i];
      z[i] = R::rnorm(at, 1);
      prevb = at + z[i];
    }
  }
  return z;
}')

system.time(setkey(smpl,id))  # ensure grouped by id
   user  system elapsed
  0.028   0.004   0.033
set.seed(1); system.time(smpl[, z4 := myfun4(id, xb, a, b)][])
   user  system elapsed 
  0.232   0.004   0.237 
smpl[,identical(z,z4)]
[1] TRUE

这样更好:19.2秒降至0.27秒.

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

数据表|组内更快的逐行递归更新 的相关文章

  • 正则表达式字符串中第一个和最后一个非点的位置

    我希望找到字符串的第一个和最后一个非点元素的位置 理想情况下我想这样做regex在基地R 我已经写过R解决问题的代码 不过 我对一个感兴趣regex解决方案 感谢您的任何建议 这是一个示例数据集和R代码以获得所需的结果 此代码拆分字符串并使
  • C语言中的递归是如何工作的?

    我试图了解 C 中递归的工作原理 任何人都可以给我解释控制流吗 include
  • 纵向序列数据的三次样条方法?

    我有一个串行数据 格式如下 time milk Animal ID 30 25 6 1 31 27 2 1 32 24 4 1 33 17 4 1 34 33 6 1 35 25 4 1 33 29 4 2 34 25 4 2 35 24
  • 使用 pracma::findpeaks 识别持续峰值

    我的语法有问题peakpat内的选项findpeaks内的函数pramcaR 包 v 2 1 1 我使用的是 R 3 4 3 x64 Windows 我希望该函数能够识别可能有两个重复值的峰值 并且我相信该选项peakpat这就是我能做到的
  • 如何使用 usmap 标记数字而不是名称?

    我知道 usmap 有一个选项label in plot usmap 我想标记一些数字 而不是状态名称 我想 usmap 中应该有与州质心坐标相关的数据 但我不知道如何找到它 如果我能得到 坐标然后我可以用它来标记数字geom text 这
  • 将绘图调用拆分为多个块

    我正在编写一个图的解释 其中我基本上将在第一个块中创建图 然后描述该输出 并在第二个块中添加一个轴 然而 似乎每个块都会强制一个新的绘图环境 因此当我们尝试使用以下命令运行块时会出现错误axis独自的 观察 output html docu
  • 尝试读取 CSV 文件时出现“无法识别的字符串转义”

    我正在尝试导入一个 csv文件 以便我可以观看此视频 R ggplot2 图形直方图 http www youtube com watch v 47kWynt3b6M 我安装了所有正确的软件包 包括ggplot以及相关的包 视频中的第一个说
  • 在 R 格子包中微调点图

    我正在尝试为不同的数据集和不同的算法绘制一堆 ROC 区域 我有三个变量 方案 指定所使用的算法 数据集 是正在测试算法的数据集 以及 Area under ROC 我正在 R 中使用lattice库 命令如下 点图 方案 Area und
  • 将每列的值乘以 R 中另一个 data.frame 中的权重

    我有两个data frames df and weights 代码如下 df看起来像这样 id a b d EE f 1 this 0 23421153 0 02324956 0 5457353 0 73068586 0 5642554 2
  • 相当于 min() 的 rowMeans()

    我在 R 邮件列表上多次看到这个问题 但仍然找不到满意的答案 假设我有一个矩阵m m lt matrix rnorm 10000000 ncol 10 我可以通过以下方式获得每行的平均值 system time rowMeans m use
  • 如何仅删除单括号并保留配对的括号

    你好 我亲爱的老师 R 用户朋友们 我最近开始认真学习正则表达式 最近我遇到了一种情况 我们只想保留配对括号 并省略未配对的 这是我的样本数据 structure list t1 c Book Pg 1 Website Online Jou
  • 如何在 R 中匹配多个 ggplot2 图中的调色板?

    自从被问到这个问题以来已经有一段时间了 但我知道一个事实 我很快就会提取新数据 我想弄清楚如何用这种技术来绘制它 看起来评论和答案中的人知道如何做到这一点 但我无法完全弄清楚所给我的内容 还有人想尝试一下吗 我正在尝试使用具有多个级别的因子
  • 使用 ggmap 截断密度多边形

    我在使用 R ggmap 绘制密度图时遇到问题 我的数据如下所示 gt head W date lat lon dist 1 2010 01 01 31 942 86 659 292 415 2 2010 01 10 32 970 84 1
  • 纵向比较 R 中的值...并进行扭转

    我有许多人在多达四个时间段进行的测试结果 这是一个示例 dat lt structure list Participant ID c A A A A B B B B C C C C phase structure c 1L 2L 3L 4L
  • R:如何获取该月的周数

    我是 R 新手 我想要该日期所属月份的周数 通过使用以下代码 gt CurrentDate lt Sys Date gt Week Number lt format CurrentDate format U gt Week Number 3
  • python 相当于 R 中的 get() (= 使用字符串检索符号的值)

    在 R 中 get s 函数检索名称存储在字符变量 向量 中的符号的值s e g X lt 10 r lt XVI s lt substr r 1 1 X get s 10 取罗马数字的第一个符号r并将其转换为其等效整数 尽管花了一些时间翻
  • 任意列中包含字符串的子集行

    我有一个如下所示的数据集 Col1 Col2 Col3 abckel NA 7 jdmelw njabc NA 8 jdken jdne 如何对数据集进行子集化 使其仅保留包含字符串 abc 的行 最终预期输出 Col1 Col2 Col3
  • 如何绘制具有显着性水平的箱线图?

    前段时间问了一个关于绘制箱线图的问题Link1 https stackoverflow com questions 14604439 plot multiple boxplot in one graph 我有一些包含 3 个不同组 或标签
  • 麦当劳 omega:R 中的警告

    我正在计算几种不同尺度的欧米茄 并在 R 中使用不同的 omega 函数获取不同比例的不同警告消息 我的问题是如何解释这些警告以及报告检索到的 omega 统计数据是否安全 当我使用 从 alpha 到 omega 内部一致性估计普遍问题的
  • 如何将plot中的单变量列表图表转换为ggplot2格式?

    我正在搜索 但仍然找不到一个非常简单的问题的答案 我们如何使用 R 中的 ggplot2 生成一个变量的简单线图 我正在分析时间序列数据 并且想要对图表进行更复杂的操作 我认为如果我使用 ggplot2 代替会更好plot It works

随机推荐