计算阈值以下随机数比例的更有效方法

Question

在进行一些概率练习时，我需要绘制硬币出现正面次数的比例（例如p = 0.3的不公平硬币）-掷硬币的次数。

这是我的受python启发的R代码（它可以编译并运行），运行速度非常慢。有什么方法可以使它成为更惯用的R代码？

非常感谢

flip_experiment <- function(prob_heads, n_flips) {
  proportion_heads <- c()
  for (i in 1:n_flips) {
    count = 0
    for (j in 1:i){
      if(runif(1, 0, 1) <= prob_heads){
        # We flipped a head!
        count <- count + 1
      }
    }
    prop_heads = count / i
    proportion_heads <- append(proportion_heads, prop_heads)

  }
  plot(1:n_flips, proportion_heads)
  return 
}

flip_experiment(0.3, 1000);
flip_experiment(0.03, 1000);

以下是其中一张图表：

Answer 1

这是我使用rbinom函数提出的函数。

flip_experiment2 <- function(prob_heads, n_flips){
  proportion_heads <- rbinom(n_flips, 1:n_flips, prob_heads)/(1:n_flips)
  return(plot(x = 1:n_flips, y = proportion_heads))
}

在这里，我进行了基准分析。使用rbinom的速度要快得多。

library(microbenchmark)

microbenchmark(m1 = flip_experiment(0.3, 1000), 
               m2 = flip_experiment2(0.3, 1000))

Unit: milliseconds
 expr       min        lq      mean    median        uq       max neval cld
   m1 765.22263 859.28831 923.04026 900.44548 970.77151 1259.4624   100   b
   m2  27.88089  29.93146  33.50223  31.55485  33.50544  146.7657   100  a 

Answer 2

至少可以对j循环进行矢量化处理（使用runif(i, 0, 1)而不是runif(1, 0, 1)进行i次）。另外，请勿增长所得的proportion_heads向量。它的大小已知，因此您可以预先分配它并填写。

flip_experiment <- function(prob_heads, n_flips) {
  proportion_heads <- numeric(n_flips)
  for (i in 1:n_flips) {
    count <- sum(runif(i, 0, 1) <= prob_heads)
    proportion_heads[i] <- count / i  
    }
  plot(1:n_flips, proportion_heads)
  }

flip_experiment(0.3, 1000);
flip_experiment(0.03, 1000);

第二个想法：

flip_experiment <- function(prob_heads, n_flips) {
  proportion_heads <- cumsum(runif(n_flips, 0, 1) <= prob_heads) / seq_len(n_flips)
  plot(1:n_flips, proportion_heads)
  }

Answer 3

R很漂亮，因为在大多数情况下不需要循环：

set.seed(1)
x <- 1:1000
y <- sapply(x, function(j) sum(rbinom(j, size = 1, prob = .3))/j)
plot(x, y)

说明

抛硬币遵循二项式分布。在R中，您可以获得许多分布的随机结果（请参见?distribution），其中之一是带有rbinom的二项式分布（r在这里是随机的）。 sapply位用于简化应用，即向量化。 sum和除法，您可以肯定地遵循;）

Answer 4

基于tidyverse的解决方案也非常有效：

library(tidyverse)
flip.experiment <- function(prob.heads, n.flips){
  dat = tibble(exp.no = 1:n.flips, flip.no = 1:n.flips)
  dat = dat %>% 
    group_by(exp.no) %>% 
    expand(flip.no = 1:exp.no) %>%
    mutate(head = if_else(runif(exp.no, 0, 1) <= prob.heads, TRUE, FALSE)) %>%
    summarise(proportion.heads = sum(head)/n())
  plot <- plot(dat$exp.no, dat$proportion.heads)
  return(plot)
}
flip.experiment(0.3, 1000)