如何避免循环或sapply加速计算

时间:2018-03-16 22:38:35

标签: r for-loop sapply

我有一个非常大的数据集,可以通过以下R代码来描述:

set.seed(1)
data <- data.frame(id = rep(c(rep(1,5), rep(2,5)),2), h = rep(1:2,10), 
                   d = c(rep(1,10), rep(2,10)), t = rep(c(sample(c(1,2,3), 5, replace = T),
                   sample(c(1,2,3), 5, replace = T)),2), q = runif(20), p = runif(20),
                   b = runif(20), w = rep(c(rep(.1,2), rep(.2,2)),5))

其中id是主题ID,hd是小时和天。每个id都有多个t。对于t的每种类型(可以是1,2或3),按t_i索引,在每个hd中,我需要计算总和t = t_i的{​​{1}}。理想情况下,输出应该是q_i * pnorm((p_i - b_i)/ w_i) data.frame的附加列。

计算此问题的最快方法是什么?我的数据集非常大,我担心datafor loop会永远占用。我在考虑使用sapply函数,但我不确定它是否适用于aggregatemean以外的表达式。

----在DGP中固定一个TYPO ----

示例:给定数据(sum)最后一列给出输出,而set.seed(1)给出乘法Sum。第1行和第4行具有相同的条件变量,因此在q_i * pnorm((p_i - b_i)/ w_i)列中具有相同的值,因为这将等于result q_5 * pnorm((p_5 - b_5)/ w_5)``。如果我不清楚的话,我很抱歉。

q_1 * pnorm((p_1 - b_1)/ w_1) +

3 个答案:

答案 0 :(得分:2)

我们group_by(t, id, h, d)然后为每行计算Sum,然后最终计算具有相同result

的行的总和t, id, h, d
library(tidyverse)

set.seed(1)
options(scipen = 999)

dat <- data.frame(id = rep(c(rep(1,5), rep(2,5)),2), h = rep(1:2,5), 
                   d = c(rep(1,10), rep(2,10)), 
                   t = rep(c(sample(c(1,2,3), 5, replace = T),
                   sample(c(1,2,3), 5, replace = T)),2), q = runif(20), p = runif(20),
                   b = runif(20), w = rep(c(rep(.1,2), rep(.2,2)),5))
dat

#>    id h d t          q         p          b   w
#> 1   1 1 1 1 0.20597457 0.4820801 0.47761962 0.1
#> 2   1 2 1 2 0.17655675 0.5995658 0.86120948 0.1
#> 3   1 1 1 2 0.68702285 0.4935413 0.43809711 0.2
#> 4   1 2 1 3 0.38410372 0.1862176 0.24479728 0.2
#> 5   1 1 1 1 0.76984142 0.8273733 0.07067905 0.1
#> 6   2 2 1 3 0.49769924 0.6684667 0.09946616 0.1
#> 7   2 1 1 3 0.71761851 0.7942399 0.31627171 0.2
#> 8   2 2 1 2 0.99190609 0.1079436 0.51863426 0.2
#> 9   2 1 1 2 0.38003518 0.7237109 0.66200508 0.1
#> 10  2 2 1 1 0.77744522 0.4112744 0.40683019 0.1
#> 11  1 1 2 1 0.93470523 0.8209463 0.91287592 0.2
#> 12  1 2 2 2 0.21214252 0.6470602 0.29360337 0.2
#> 13  1 1 2 2 0.65167377 0.7829328 0.45906573 0.1
#> 14  1 2 2 3 0.12555510 0.5530363 0.33239467 0.1
#> 15  1 1 2 1 0.26722067 0.5297196 0.65087047 0.2
#> 16  2 2 2 3 0.38611409 0.7893562 0.25801678 0.2
#> 17  2 1 2 3 0.01339033 0.0233312 0.47854525 0.1
#> 18  2 2 2 2 0.38238796 0.4772301 0.76631067 0.1
#> 19  2 1 2 2 0.86969085 0.7323137 0.08424691 0.2
#> 20  2 2 2 1 0.34034900 0.6927316 0.87532133 0.2

dat %>% 
  group_by(t, id, h, d) %>% 
  mutate(Sum = q * pnorm((p - b)/w)) %>% 
  mutate(result = sum(Sum))

#> # A tibble: 20 x 10
#> # Groups:   t, id, h, d [18]
#>       id     h     d     t      q      p      b     w          Sum  result
#>    <dbl> <int> <dbl> <dbl>  <dbl>  <dbl>  <dbl> <dbl>        <dbl>   <dbl>
#>  1    1.     1    1.    1. 0.206  0.482  0.478  0.100 0.107        8.76e-1
#>  2    1.     2    1.    2. 0.177  0.600  0.861  0.100 0.000784     7.84e-4
#>  3    1.     1    1.    2. 0.687  0.494  0.438  0.200 0.419        4.19e-1
#>  4    1.     2    1.    3. 0.384  0.186  0.245  0.200 0.148        1.48e-1
#>  5    1.     1    1.    1. 0.770  0.827  0.0707 0.100 0.770        8.76e-1
#>  6    2.     2    1.    3. 0.498  0.668  0.0995 0.100 0.498        4.98e-1
#>  7    2.     1    1.    3. 0.718  0.794  0.316  0.200 0.712        7.12e-1
#>  8    2.     2    1.    2. 0.992  0.108  0.519  0.200 0.0199       1.99e-2
#>  9    2.     1    1.    2. 0.380  0.724  0.662  0.100 0.278        2.78e-1
#> 10    2.     2    1.    1. 0.777  0.411  0.407  0.100 0.403        4.03e-1
#> 11    1.     1    2.    1. 0.935  0.821  0.913  0.200 0.302        3.75e-1
#> 12    1.     2    2.    2. 0.212  0.647  0.294  0.200 0.204        2.04e-1
#> 13    1.     1    2.    2. 0.652  0.783  0.459  0.100 0.651        6.51e-1
#> 14    1.     2    2.    3. 0.126  0.553  0.332  0.100 0.124        1.24e-1
#> 15    1.     1    2.    1. 0.267  0.530  0.651  0.200 0.0728       3.75e-1
#> 16    2.     2    2.    3. 0.386  0.789  0.258  0.200 0.385        3.85e-1
#> 17    2.     1    2.    3. 0.0134 0.0233 0.479  0.100 0.0000000356 3.56e-8
#> 18    2.     2    2.    2. 0.382  0.477  0.766  0.100 0.000735     7.35e-4
#> 19    2.     1    2.    2. 0.870  0.732  0.0842 0.200 0.869        8.69e-1
#> 20    2.     2    2.    1. 0.340  0.693  0.875  0.200 0.0615       6.15e-2

reprex package(v0.2.0)创建于2018-03-16。

答案 1 :(得分:1)

这是使用ave的R基本方法。我不确定这是否可以解决您的问题,但是这里有一个尝试让您弄清楚如何编写表达式:

data$Aggregated.Sum <- ave(data[, c("q", "p", "b", "w")], 
                            data[,c("id", "h", "d", "t")], 
                            FUN=function(x){
                              sum(x$q * pnorm((x$p - x$b)/ x$w))
                            })[, 1]

提供以下输出:

   id h d t          q         p          b   w   Aggregated.Sum
1   1 1 1 1 0.20597457 0.4820801 0.47761962 0.1 0.87649276750008
2   1 2 1 2 0.17655675 0.5995658 0.86120948 0.1 0.00078437884830
3   1 1 1 2 0.68702285 0.4935413 0.43809711 0.2 0.41853074006211
4   1 2 1 3 0.38410372 0.1862176 0.24479728 0.2 0.14780307785185
5   1 1 1 1 0.76984142 0.8273733 0.07067905 0.1 0.87649276750008
6   2 2 1 3 0.49769924 0.6684667 0.09946616 0.1 0.49769923892396
7   2 1 1 3 0.71761851 0.7942399 0.31627171 0.2 0.71157053468214
8   2 2 1 2 0.99190609 0.1079436 0.51863426 0.2 0.01985232872822
9   2 1 1 2 0.38003518 0.7237109 0.66200508 0.1 0.27795848822967
10  2 2 1 1 0.77744522 0.4112744 0.40683019 0.1 0.40250214883360
11  1 1 2 1 0.93470523 0.8209463 0.91287592 0.2 0.37457632092225
12  1 2 2 2 0.21214252 0.6470602 0.29360337 0.2 0.20395587133630
13  1 1 2 2 0.65167377 0.7829328 0.45906573 0.1 0.65128247418102
14  1 2 2 3 0.12555510 0.5530363 0.33239467 0.1 0.12383782495223
15  1 1 2 1 0.26722067 0.5297196 0.65087047 0.2 0.37457632092225
16  2 2 2 3 0.38611409 0.7893562 0.25801678 0.2 0.38459067414776
17  2 1 2 3 0.01339033 0.0233312 0.47854525 0.1 0.00000003555325
18  2 2 2 2 0.38238796 0.4772301 0.76631067 0.1 0.00073467275547
19  2 1 2 2 0.86969085 0.7323137 0.08424691 0.2 0.86917168501551
20  2 2 2 1 0.34034900 0.6927316 0.87532133 0.2 0.06147884477362

答案 2 :(得分:1)

我不确定这是否符合预期

data <- split(data, data$id)
data <- lapply(data, function(i) {split(i,i$t)})
data <- unlist(data,recursive=FALSE)

data1 <- lapply(data, function(j)
  {
  res <- j[,c("q","p","b","w")]
  j$result <- apply(res,1,function(i) i["q"] *pnorm( (i["p"] - i["b"]))/ i["w"] )
  j
  })

data1 <- do.call(rbind, data1)