Захват сгенерированных графиков и объектов из фрагмента кода R - PullRequest
Новая
       1

Захват сгенерированных графиков и объектов из фрагмента кода R

1 голос
/ 12 декабря 2011

Обратите внимание, что я знаю этот . Я просто хотел бы знать, есть ли способ «обнаружить» не только графики, но и сгенерированные объекты. Например, если у нас есть этот кусок кода: 

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

есть три объекта (два числовых вектора: x и y, один объект htest -класса) и два графика (индексный график переменной x и блок-график x over " уровни "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)
    )

<ч /> Эта напыщенная речь похожа, но не идентична выпуску # 50 пакета knitr.

1 Ответ

2 голосов
/ 12 декабря 2011

Этот вопрос было трудно понять (для меня), но на основе пакета @ hadley я попытался реализовать для этого функцию lame: 

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.Если график возвращается, он говорит: «график!».Исходя из этого, это слабое решение может быть расширено.

Демонстрационный прогон: 

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

Мне известно, что это уродливо, неоптимальный и не тотальный ответ, но он отлично провел время, пытаясь найти решение:)

Обновление: добавлено отдельное окружение и сохранение созданных графиков в файлы.

Обновление [2013/05/23] : я знаю, что это довольно старый вопрос, но, поскольку я работал над аналогичными проблемами в последние два года, стоит упомянуть - чтоevals функция в pander пакете может помочь с этой проблемой.Демо: 

> 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"
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...