【问题标题】:translate this loop into purr?把这个循环翻译成咕噜声?
【发布时间】:2020-02-24 23:55:25
【问题描述】:

我正在尝试制作一个关于采样的教学示例供学生运行,但是当迭代次数达到数千时结果太慢(真实数据框df 有几百万行)。

我可以使用purr 加快速度吗?

library(tidyverse)
set.seed(1432)
df <- data.frame(v1 = sample(1:10, 100, replace=TRUE),
                 v2 = c(rep("A", 50), rep("B", 50))
)

output <- NULL

for (i in 1:10) {
  set.seed(i)
  d <- df %>%
    filter(v2=="A") %>%
    sample_n(20, replace=FALSE)

  mean = mean(d$v1)
  output <- c(output, mean)
}

output

【问题讨论】:

  • 次要评论:filter() 步骤在整个循环迭代中是固定的,不依赖于随机数生成。它可以作为预处理步骤移出循环/purrr::map()
  • 看看我更新后的基准测试

标签: r tidyverse purrr


【解决方案1】:

您可以使用purrr,如下所示。

map_dbl(1:10, function(x){
  set.seed(x)
  d <- df %>%
    filter(v2=="A") %>%
    sample_n(20, replace=FALSE)

  return(mean(d$v1))
})
# [1] 5.15 5.90 5.70 5.55 5.60 4.95 5.40 5.40 5.65 5.40

【讨论】:

    【解决方案2】:

    purrr 不一定更快,但比 R 中的基本控制结构更具可读性。在替换循环时,您可以在基本 R 中执行以下操作:

    sapply(1:10, function(x){
      set.seed(x)
      d <- df %>%
        filter(v2=="A") %>%
        sample_n(20, replace=FALSE)
      mean(d$v1)
    })
    

    更新 您使用dplyrpurrr 并不能保证您的代码会很快。 IMO,这些软件包的开发首先是为了提高代码的可读性,而不是为了加速昂贵的计算。如果您仔细使用基本的 R 数据结构,您可以实现显着的加速。 d是原始循环,ab是函数式编程方案,f是优化方案:

    a <- function(y){sapply(1:y, function(x){
      set.seed(x)
      d <- df %>%
        filter(v2=="A") %>%
        sample_n(20, replace=FALSE)
        mean(d$v1)
    })}
    
    b <- function(y) {map_dbl(1:y, function(x){
      set.seed(x)
      d <- df %>%
        filter(v2=="A") %>%
        sample_n(20, replace=FALSE)
    
      return(mean(d$v1))
    })}
    
    d <- function(y){
      output <- NULL
      for (i in 1:y) {
        set.seed(i)
        d <- df %>%
          filter(v2=="A") %>%
          sample_n(20, replace=FALSE)
        output <- c(output, mean(d$v1))
      }
    
      output
    }
    
    f <- function(y){
      output <- vector("list", y)
      for (i in 1:y) {
        set.seed(i)
        d <- df[df$v2 == "A", ]
        d <- d[sample(1:nrow(d), 20, replace = FALSE), ]
    
        output[[i]] <- mean(d$v1)
      }
    
      output
    }
    
    microbenchmark::microbenchmark(a(100),b(100),d(100), f(100))
    
    Unit: milliseconds
       expr       min        lq      mean    median        uq       max neval
     a(100) 172.06305 187.95053 205.19531 199.84411 210.55501 306.41906   100
     b(100) 171.86030 186.18869 206.50518 196.07746 213.79044 397.87859   100
     d(100) 174.45273 191.01706 208.07125 199.12653 216.54543 365.55107   100
     f(100)  14.62159  15.80092  20.96736  19.14848  24.16181  37.54095   100
    

    观察到f 的速度几乎是d 的 10 倍,而abd 的速度几乎相同。

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2020-03-11
      • 1970-01-01
      • 2014-02-26
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多