從R代碼塊捕獲生成的圖表和對象

Question

請注意，我知道this one。我只想知道是否有辦法「檢測」不僅是圖形，還有生成的對象。例如，如果我們有這樣的代碼塊：

x <- rnorm(100) 
plot(x) 
y <- round(runif(100)) 
crl <- cor.test(x, y) 
boxplot(x ~ y) 

存在三個對象（兩個數值載體：x和y，一個htest -class對象），和兩個曲線（可變x的索引圖，和盒形圖x超過y的「水平」）。是否有可能附加一些在矢量/圖上以不同方式操作的鉤子？

這裏甚至會出現難看的情況 - 如果您不將東西分配給對象？如果你只是評估他們呢？

x <- rnorm(10) 
plot(x) 
runif(10) 

有沒有什麼辦法，例如，前和評估後，評估該代碼在一個單獨的環境，而環境中的內容記錄的快照，然後比較這兩個快照的狀態，和存儲產生的東西，說一個列表，在後一種情況下是這樣的：

list(
    x = c(0.0571094065969082, -0.644536546605725, 0.342691062512616, 0.348529238626249, 2.19101790784795, 1.43065640761249, -0.230245257207684, 0.0768174872901325, 0.965715513349098, -0.607450090812782), 
    `plot(x)` = "<path/to/plot>", 
    `runif(10)` = c(0.11007297760807, 0.843735514208674, 0.620932232355699, 0.622749823378399, 0.852932719048113, 0.435453998856246, 0.231673048110679, 0.820609186775982, 0.0562138997483999, 0.823565979953855) 
    ) 

---

此咆哮與 knitr包中的 issue #50類似，但不完全相同。

Answer 1

這個問題是很難理解（對我來說），但基於@哈德利的包我試圖實施一個蹩腳的功能：

parser <- function(txt) { 
    tmp <- new.env() 
    lapply(txt, function(src) { 
     #produces.graph <- function(x) any(sapply(x, function(x) any(class(x) == "recordedplot"))) 
     clear.devs <- function() while (!is.null(dev.list())) dev.off(as.numeric(dev.list())) 

     clear.devs() 
     file <- tempfile() 
     png(file) 

     eval <- evaluate(src, envir = tmp) 
     #graph <- produces.graph(eval) 
     graph <- ifelse(is.na(file.info(file)$size), FALSE, file) 
     returns <- ifelse(length(eval) > 1, TRUE, FALSE) 
     if (returns & is.logical(graph)) returns <- eval(parse(text=src), envir = tmp) 
     if (is.character(graph)) returns <- graph 
     clear.devs() 
     return(list(src=src, returns=returns)) 
     } 
    ) 
} 

此功能只有一個參數：文本行檢查和解析。它將返回這些行的src和評估的src的輸出。如果返回一個圖形，它會顯示：「graph！」。基於這個跛腳的解決方案可以擴展。

演示運行：

library(evaluate) 
library(ggplot2) 

txt <- readLines(textConnection('x <- rnorm(100) 
runif(10) 
plot(1:10) 
qplot(rating, data=movies, geom="histogram") 
y <- round(runif(100)) 
cor.test(x, y) 
crl <- cor.test(runif(10), runif(10)) 
table(mtcars$am, mtcars$cyl)')) 

輸出：

> parser(txt) 
[[1]] 
[[1]]$src 
[1] "x <- rnorm(100)" 

[[1]]$returns 
[1] FALSE 


[[2]] 
[[2]]$src 
[1] "runif(10)" 

[[2]]$returns 
[1] 0.095131 0.458321 0.866366 0.494758 0.429026 0.417446 0.465919 0.980345 0.376258 0.143056 


[[3]] 
[[3]]$src 
[1] "plot(1:10)" 

[[3]]$returns 
[1] "/tmp/RtmpWUJnzu/file6e9d997f" 


[[4]] 
[[4]]$src 
[1] "qplot(rating, data=movies, geom=\"histogram\")" 

[[4]]$returns 
[1] "/tmp/RtmpWUJnzu/file6116e1ee" 


[[5]] 
[[5]]$src 
[1] "y <- round(runif(100))" 

[[5]]$returns 
[1] FALSE 


[[6]] 
[[6]]$src 
[1] "cor.test(x, y)" 

[[6]]$returns 

    Pearson's product-moment correlation 

data: x and y 
t = 0.3742, df = 98, p-value = 0.7091 
alternative hypothesis: true correlation is not equal to 0 
95 percent confidence interval: 
-0.15984 0.23246 
sample estimates: 
    cor 
0.037768 



[[7]] 
[[7]]$src 
[1] "crl <- cor.test(runif(10), runif(10))" 

[[7]]$returns 
[1] FALSE 


[[8]] 
[[8]]$src 
[1] "table(mtcars$am, mtcars$cyl)" 

[[8]]$returns 

    4 6 8 
    0 3 4 12 
    1 8 3 2 

我知道的事實，這是一個醜陋的，unoptimal而不是全面的答案，但有很大的時間，而試圖找到解決方案:)

更新：添加單獨的環境&將生成的圖保存到文件。

---

更新[2013年5月23日]：我知道這是一個很老的問題，但因爲我的工作類似的問題，在過去的兩年中它可能是值得一提的 - 即evals功能pander package可以幫助解決這個問題。演示：

> str(evals(txt)) 
stat_bin: binwidth defaulted to range/30. Use 'binwidth = x' to adjust this. 
List of 8 
$ :List of 6 
    ..$ src : chr "x <- rnorm(100)" 
    ..$ result: NULL 
    ..$ output: NULL 
    ..$ type : chr "NULL" 
    ..$ msg :List of 3 
    .. ..$ messages: NULL 
    .. ..$ warnings: NULL 
    .. ..$ errors : NULL 
    ..$ stdout: NULL 
    ..- attr(*, "class")= chr "evals" 
$ :List of 6 
    ..$ src : chr "runif(10)" 
    ..$ result: num [1:10] 0.095 0.261 0.349 0.765 0.529 ... 
    ..$ output: chr [1:2] " [1] 0.09499242 0.26139848 0.34917008 0.76512684 0.52886251 0.98015282 0.76929669 0.65701019" " [9] 0.06849910 0.71962828" 
    ..$ type : chr "numeric" 
    ..$ msg :List of 3 
    .. ..$ messages: NULL 
    .. ..$ warnings: NULL 
    .. ..$ errors : NULL 
    ..$ stdout: NULL 
    ..- attr(*, "class")= chr "evals" 
$ :List of 6 
    ..$ src : chr "plot(1:10)" 
    ..$ result:Class 'image' chr "plots/d8572a18a8a.png" 
    ..$ output: NULL 
    ..$ type : chr "image" 
    ..$ msg :List of 3 
    .. ..$ messages: NULL 
    .. ..$ warnings: NULL 
    .. ..$ errors : NULL 
    ..$ stdout: NULL 
    ..- attr(*, "class")= chr "evals" 
$ :List of 6 
    ..$ src : chr "qplot(rating, data = movies, geom = \"histogram\")" 
    ..$ result:Class 'image' chr "plots/d85673ce008.png" 
    ..$ output: chr(0) 
    ..$ type : chr "image" 
    ..$ msg :List of 3 
    .. ..$ messages: NULL 
    .. ..$ warnings: NULL 
    .. ..$ errors : NULL 
    ..$ stdout: NULL 
    ..- attr(*, "class")= chr "evals" 
$ :List of 6 
    ..$ src : chr "y <- round(runif(100))" 
    ..$ result: NULL 
    ..$ output: NULL 
    ..$ type : chr "NULL" 
    ..$ msg :List of 3 
    .. ..$ messages: NULL 
    .. ..$ warnings: NULL 
    .. ..$ errors : NULL 
    ..$ stdout: NULL 
    ..- attr(*, "class")= chr "evals" 
$ :List of 6 
    ..$ src : chr "cor.test(x, y)" 
    ..$ result:List of 9 
    .. ..$ statistic : Named num -0.202 
    .. .. ..- attr(*, "names")= chr "t" 
    .. ..$ parameter : Named int 98 
    .. .. ..- attr(*, "names")= chr "df" 
    .. ..$ p.value : num 0.84 
    .. ..$ estimate : Named num -0.0204 
    .. .. ..- attr(*, "names")= chr "cor" 
    .. ..$ null.value : Named num 0 
    .. .. ..- attr(*, "names")= chr "correlation" 
    .. ..$ alternative: chr "two.sided" 
    .. ..$ method  : chr "Pearson's product-moment correlation" 
    .. ..$ data.name : chr "x and y" 
    .. ..$ conf.int : atomic [1:2] -0.216 0.177 
    .. .. ..- attr(*, "conf.level")= num 0.95 
    .. ..- attr(*, "class")= chr "htest" 
    ..$ output: chr [1:12] "" "\tPearson's product-moment correlation" "" "data: x and y" ... 
    ..$ type : chr "htest" 
    ..$ msg :List of 3 
    .. ..$ messages: NULL 
    .. ..$ warnings: NULL 
    .. ..$ errors : NULL 
    ..$ stdout: NULL 
    ..- attr(*, "class")= chr "evals" 
$ :List of 6 
    ..$ src : chr "crl <- cor.test(runif(10), runif(10))" 
    ..$ result: NULL 
    ..$ output: NULL 
    ..$ type : chr "NULL" 
    ..$ msg :List of 3 
    .. ..$ messages: NULL 
    .. ..$ warnings: NULL 
    .. ..$ errors : NULL 
    ..$ stdout: NULL 
    ..- attr(*, "class")= chr "evals" 
$ :List of 6 
    ..$ src : chr "table(mtcars$am, mtcars$cyl)" 
    ..$ result: 'table' int [1:2, 1:3] 3 8 4 3 12 2 
    .. ..- attr(*, "dimnames")=List of 2 
    .. .. ..$ : chr [1:2] "0" "1" 
    .. .. ..$ : chr [1:3] "4" "6" "8" 
    ..$ output: chr [1:4] " " "  4 6 8" " 0 3 4 12" " 1 8 3 2" 
    ..$ type : chr "table" 
    ..$ msg :List of 3 
    .. ..$ messages: NULL 
    .. ..$ warnings: NULL 
    .. ..$ errors : NULL 
    ..$ stdout: NULL 
    ..- attr(*, "class")= chr "evals"