使用 aprof 包分析 Monty Hall 代码

Question

我为蒙蒂霍尔问题编写了R 代码。据我所知，该代码有效。但是，我也使用aprof 包来尝试降低代码的速度和内存需求。我能够将速度降低 50%，但我无法让 aprof 包的内存分析功能工作。感谢您为解决此错误提供任何建议或帮助。

首先我描述蒙蒂霍尔问题：

向参赛者展示了三扇门。一扇门隐藏着一个不错的奖品。两扇门隐藏了一个坏奖品。参赛者不知道每扇门后面是什么。参赛者选择一扇门。主持人打开参赛者未选择的两扇门之一。主人不开门隐藏了好价格。接下来，主持人询问参赛者是否希望保持最初选择的门或切换到参赛者最初未选择的剩余关闭的门。参赛者应该怎么做？答：参赛者应始终开关门。这是因为参赛者最初有 33% 的获胜机会和 67% 的失败机会。换门将获胜概率提高到 67%。

这是R 代码，我相信它有效。

library(aprof)
set.seed(1234)
foo <- function(N) {

     game.interations  <- 10000
     contestant.action <- rep(NA, game.interations)
     game.result       <- rep('lose', game.interations)

     for(i in 1:game.interations) {

          door <- c(0,0,0)
          door[sample(3, 1)] = 1            # assign nice prize to a door
                                            # door  with '1' has  nice prize
                                            # doors with '0' have bad  prize
          initial.pick <- sample(3, 1)      # initial contestant action
          not.picked   <- c(1:3)[-initial.pick]
          door.opened.by.host <- not.picked[1]
          if(door[initial.pick   ]==1) door.opened.by.host = not.picked[sample(2,1)]
          if(door[  not.picked[1]]==1) door.opened.by.host = not.picked[2]
          contestant.action[i] <- sample(c('k', 's'), 1)
          second.pick <- ifelse(contestant.action[i] == 'k', initial.pick, 
                         not.picked[which(not.picked!=door.opened.by.host)])
          if(door[second.pick]==1) game.result[i] = 'win'
     }

x <- table(contestant.action , game.result)         # examine probability of 
                                                    # winning by action 
prop.table(x)

}

foo(N)

#                      game.result
# contestant.action   lose    win
#          k (keep)   0.3293 0.1613
#          s (switch) 0.1705 0.3389

aprof 代码从这里开始。从这一点开始，代码取自包文档。本节中的代码似乎也可以正常工作，并确定函数 foo 的每一行所需的时间。

## save function to a source file and reload
dump("foo",file="foo.R")
source("foo.R")

## create file to save profiler output
tmp<-tempfile()

## Profile the function
Rprof(tmp,line.profiling=TRUE)
foo(1e4)
Rprof(append=FALSE)

## Create a aprof object
fooaprof<-aprof("foo.R",tmp)

## display basic information, summarize and plot the object
fooaprof
summary(fooaprof)
plot(fooaprof)

# another plot
profileplot(fooaprof)

这里是内存分析代码的开始。返回错误的行如下所示。

## To continue with memory profiling:
## enable memory.profiling=TRUE
Rprof(tmp,line.profiling=TRUE,memory.profiling=TRUE)
foo(1e4)
Rprof(append=FALSE)

#
# This line returns the error message below
#
## Create a aprof object
fooaprof<-aprof("foo.R",tmp)
#
# Error in `colnames<-`(`*tmp*`, value = c("sm_v_heap", "lrg_v_heap", "mem_in_node" : 
# 'names' attribute [3] must be the same length as the vector [0]
#

## display basic information, and plot memory usage
fooaprof
plot(fooaprof)

这是我认为aprof 包在返回错误时尝试读取的文件内容，但我不确定。请注意，这是一个隐藏文件：

memory profiling: line profiling: sample.interval=20000
#File 1: foo.R
:153316:554084:15881544:162:1#22 "foo" 
:150595:494927:15084104:869:1#26 "foo" 
:149818:473956:14839440:908:1#12 "sample" 1#12 "foo" 
:147827:430136:14250768:879:"sample" 1#16 "foo" 
:154551:576315:16254896:864:1#24 "foo" 
:151678:512463:15404032:896:"is.numeric" "sample" 1#12 "foo" 
:150598:488049:15083040:929:"length" "sample" 1#12 "foo" 
:146904:403852:13989752:857:"sample.int" "sample" 1#12 "foo" 
:146035:384446:13729968:919:"sample" 1#24 "foo" 
:156862:629525:16944760:955:"sample.int" "sample" 1#24 "foo" 
:154543:577567:16250584:905:1#24 "foo" 
:150690:595793:15020264:942:

Answer 1

这是由于一个错误（不完整的正则表达式语法）。感谢您报告此事。该错误已在 0.3.2 版本中修复。可从github 获得。很快就会上传到 CRAN。