Соответствие среде документа Knitr в пользовательском движке - PullRequest
Новая
       182

Соответствие среде документа Knitr в пользовательском движке

2 голосов
/ 16 июня 2020

Меня интересовало создание движка для knitr, который будет предварительно обрабатывать фрагменты кода перед отправкой их на оценку со следующими шагами:

  1. предварительная обработка options$code
  2. оценить код с помощью evaluate::evaluate() с родительской средой
  3. форматировать вывод с помощью knitr::engine_output()

Я обнаружил, что любые переменные, созданные в этих настраиваемых фрагментах, не будут доступны в остальная часть документа. После некоторой работы я обнаружил, что если бы я прошел по стеку вызовов и нашел последнее место, откуда был вызван knitr, я мог бы взять значение аргумента envir и использовать его как среду для evaluate::evaluate(). Хотя это кажется хакерским. Есть ли лучший способ сопоставить среду документа в пользовательском механизме фрагментов?

Пример

Механизм, который добавляет флиппи ко всем комментариям 

knitr::knit_engines$set(flip =
  function(options) {
    # pre-process code
    code <- gsub("(#+?)", "\\1 (╯°□°）╯︵", options$code)

    # Find environment <--------------- IS THERE A BETTER WAY?
    #
    # grabbing the call stack
    cstack <- vapply(sys.calls(), function(i) paste(as.character(deparse(i)), collapse = "\n"), character(1))
    fstack <- sys.frames()
    # Finding the last instance of the knit function and grabbing the envir variable
    knitting <- rev(grep("knit(", cstack, fixed = TRUE))[1]
    e <- get("envir", fstack[[knitting]])

    OUT <- evaluate::evaluate(code, envir = e)
    knitr::engine_output(options, out = OUT)
  }
)

tmp <- tempfile(fileext = ".Rmd")
tmpout <- tempfile(fileext = ".md")
txt <- "---\noutput: md_document\n---\n\n```{r}\na <- 'A'\na\n```\n\n```{flip}\nb <- paste(a, 'and B') # FLIPPIN\nb\n```\n\nSponsored by the letters `r try(b)`\n"
cat(txt, file = tmp)

rmarkdown::render(tmp, output_file = tmpout, envir = new.env())
#> processing file: file3230dc4500b.Rmd
#> output file: file3230dc4500b.knit.md
#> /usr/bin/pandoc +RTS -K512m -RTS file3230dc4500b.utf8.md --to markdown_strict --from markdown+autolink_bare_uris+tex_math_single_backslash --output /tmp/Rtmpzc5qWO/file32306aeaf291.md --standalone
#> 
#> Output created: /tmp/Rtmpzc5qWO/file32306aeaf291.md
cat(readLines(tmp), sep = "\n")
#> ---
#> output: md_document
#> ---
#> 
#> ```{r}
#> a <- 'A'
#> a
#> ```
#> 
#> ```{flip}
#> b <- paste(a, 'and B') # FLIPPIN
#> b
#> ```
#> 
#> Sponsored by the letters `r try(b)`
cat(readLines(tmpout), sep = "\n")
#>     a <- 'A'
#>     a
#>     #> [1] "A"
#> 
#>     b <- paste(a, 'and B') # (╯°□°）╯︵ FLIPPIN
#>     b
#>     #> [1] "A and B"
#> 
#> Sponsored by the letters A and B

Создано 16.06.2020 пакетом REPEX (v0.3.0)

1 Ответ

3 голосов
/ 16 июня 2020

Оказывается, что в {knitr} есть функция как раз для этой ситуации: knitr::knit_global(), которая оказывается средой при вычислении встроенного кода: https://github.com/yihui/knitr/blob/0daf31be36eed8d8ec0ba51eedee909283afc45d/R/hooks.R#L13 

knitr::knit_engines$set(flip = 
  function(options) {
    # pre-process code
    code <- gsub("(#+?)", "\\1 (╯°□°）╯︵", options$code)

    e <- knitr::knit_global() # <----- SOLUTION ᕕ( ᐛ )ᕗ

    OUT <- evaluate::evaluate(code, envir = e)
    knitr::engine_output(options, out = OUT)
  }
)

tmp <- tempfile(fileext = ".Rmd")
tmpout <- tempfile(fileext = ".md")
txt <- "---\noutput: md_document\n---\n\n```{r}\na <- 'A'\na\n```\n\n```{flip}\nb <- paste(a, 'and B') # FLIPPIN\nb\n```\n\nSponsored by the letters `r try(b)`\n"
cat(txt, file = tmp)

rmarkdown::render(tmp, output_file = tmpout, envir = new.env())
#> processing file: file3b0117b9cb1f.Rmd
#> output file: file3b0117b9cb1f.knit.md
#> /usr/bin/pandoc +RTS -K512m -RTS file3b0117b9cb1f.utf8.md --to markdown_strict --from markdown+autolink_bare_uris+tex_math_single_backslash --output /tmp/Rtmp1KgoUj/file3b01702d22f0.md --standalone
#> 
#> Output created: /tmp/Rtmp1KgoUj/file3b01702d22f0.md
cat(readLines(tmp), sep = "\n")
#> ---
#> output: md_document
#> ---
#> 
#> ```{r}
#> a <- 'A'
#> a
#> ```
#> 
#> ```{flip}
#> b <- paste(a, 'and B') # FLIPPIN
#> b
#> ```
#> 
#> Sponsored by the letters `r try(b)`
cat(readLines(tmpout), sep = "\n")
#>     a <- 'A'
#>     a
#>     #> [1] "A"
#> 
#>     b <- paste(a, 'and B') # (╯°□°）╯︵ FLIPPIN
#>     b
#>     #> [1] "A and B"
#> 
#> Sponsored by the letters A and B

Создано 16.06.2020 с помощью пакета . (v0.3.0)

...