如何在闪亮的应用程序中像 knitr:html2html 一样使用 rmarkdown::render？

Question

我有一个使用 knitr::knit2html 的应用程序，运行良好（除了一些故障，点击后代码会稍后执行）。

我想使用 rmarkdown::render 函数而不是 knitr::knit2html

代码

library(shinyAce)
library(shinyjs)
library(shiny)

codeUI <- function(id) {
  ns <- NS(id)
  tagList(htmlOutput(ns("output")))
}

codeSE <- function(id, active_id, code, env) {
  moduleServer(id,
               function(input, output, session) {
                 
                 output$output <- renderUI({
                   req(id == active_id(), cancelOutput = TRUE)
                   eval_code <- paste0("\n```{r echo = TRUE, comment = NA}\n", code, "\n```\n")
                   HTML(knitr::knit2html(text = eval_code, fragment.only = TRUE, quiet = TRUE, envir = env))
                 })
               })
}

ui <- fluidPage(
  useShinyjs(),
  
  tags$style(type = "text/css", "
      .foot{
      position:fixed;
      bottom:0;
      right:0;
      left:0;
   /*   background:#00adfc; */
        padding:10px;
      box-sizing:border-box;
    }
    "),
  div(id = "add_here"),
  div(id = "end", " "),
  div(style = "height: 80vh;"),
  
  div(class = "foot", 
      aceEditor("code", mode = "r", height = "50px",
                highlightActiveLine = FALSE,
                fontSize = 16,
                showLineNumbers = FALSE),
      actionButton("eval", "Run"))
  
)


env <- environment()
server <- function(input, output, session) {
  
  counter <- 1
  active_id <- reactiveVal()
  observeEvent(input$eval, {
    req(code)
    current_id <- paste0("out_", counter)
    active_id(current_id)
    codeSE(id = current_id, active_id = active_id, code = input$code, env = env)
    insertUI(selector = "#add_here",ui = codeUI(current_id))
    counter <<- counter + 1
    runjs('
      document.getElementById("end").scrollIntoView();
    ')
  })   } 
shinyApp(ui, server)

我想使用 rmarkdown::render 来克服无样式 knitr::kable 表格的缺点。

Answer 1

看这个例子https://shiny.rstudio.com/gallery/download-knitr-reports.html from the Shiny RStudio Gallery. (Code repo: https://github.com/rstudio/shiny-examples/tree/master/016-knitr-pdf)

在ui部分包括：

downloadButton('downloadReport')
radioButtons('format', 'Document format', c('PDF', 'HTML', 'Word'), inline = TRUE)

在server部分包括：

  output$downloadReport <- downloadHandler(
    filename = function() {
      paste('my-report', sep = '.', switch(
        input$format, PDF = 'pdf', HTML = 'html', Word = 'docx'
      ))
    },

    content = function(file) {
      src <- normalizePath('report.Rmd')

      # temporarily switch to the temp dir, in case you do not have write
      # permission to the current working directory
      owd <- setwd(tempdir())
      on.exit(setwd(owd))
      file.copy(src, 'report.Rmd', overwrite = TRUE)

      library(rmarkdown)
      out <- render('report.Rmd', switch(
        input$format,
        PDF = pdf_document(), HTML = html_document(), Word = word_document()
      ))
      file.rename(out, file)
    }
  )

此外，您还需要一个 Report.Rmd 文件，该文件位于与应用程序相同的目录中。

Answer 2

这是使用晶须模板的解决方案。

在globals.R

output_rmd <-  function(code_chunk) {
  render_dir <- fs::path_temp(round(runif(1, 100000, 1000000), 0))
  rmd_path <- file.path(render_dir, "input.Rmd")
  final_path <- file.path(render_dir, "body_snippet.html")
  fs::dir_create(render_dir, recurse = TRUE)
  
  # read in template for rmarkdown
  whisker_template <- readr::read_lines("input.template")
  
  # render template with input code chunk
  rendered_temp <- whisker::whisker.render(whisker_template,
                                           data = list(code_chunk = code_chunk))
  
  # save out rendered template as .Rmd to temp dir
  readr::write_lines(rendered_temp, path = rmd_path)
  
  # render the temp .Rmd file as html
  out_path <- rmarkdown::render(rmd_path)
  
  # read in the html, select the body portion only, save that out to temp
  xml2::write_html(rvest::html_node(xml2::read_html(out_path), "body"), file = final_path)
  
  # read in the html body portion
  lines <- readr::read_lines(final_path)
  
  # add table table-condensed class to all tables so they render in snippet like they would in full html
  lines <- gsub("<table>", '<table class="table table-condensed">', lines, fixed = TRUE)
  
  # save out the final html snippet
  readr::write_lines(lines, final_path)
  return(final_path)
}

此函数读取 input.template，将您想要的代码附加到运行模板，将完成的 .Rmd 文件保存到临时目录，使用 rmarkdown::render 渲染它该临时目录，然后 returns 最终 html 渲染输出的文件路径。

input.template

---
title: "Shiny Run Code"
output: html_document
---

```{r echo = TRUE, comment = NA}
{{{ code_chunk }}}
```

然后在 app.R 中你只需调用 rmd_file <- output_rmd(code) 和 includeHTML(rmd_file) 你之前调用 HTML 和 knit2html

library(shinyAce)
library(shinyjs)
library(shiny)
source('globals.R')  #changed typo 

codeUI <- function(id) {
  ns <- NS(id)
  tagList(htmlOutput(ns("output")))
}

codeSE <- function(id, active_id, code, env) {
  moduleServer(id,
               function(input, output, session) {
                 
                 output$output <- renderUI({
                   req(id == active_id(), cancelOutput = TRUE)
                   rmd_file <- output_rmd(code)
                   includeHTML(rmd_file)
                 })
               })
}

ui <- fluidPage(
  useShinyjs(),
  
  tags$style(type = "text/css", "
      .foot{
      position:fixed;
      bottom:0;
      right:0;
      left:0;
   /*   background:#00adfc; */
        padding:10px;
      box-sizing:border-box;
    }
    "),
  div(id = "add_here"),
  div(id = "end", " "),
  div(style = "height: 80vh;"),
  
  div(class = "foot", 
      aceEditor("code", mode = "r", height = "50px",
                highlightActiveLine = FALSE,
                fontSize = 16,
                showLineNumbers = FALSE),
      actionButton("eval", "Run"))
  
)


env <- environment()
server <- function(input, output, session) {
  
  observeEvent(input$code, {
    if(input$code == ''){
      shinyjs::disable("eval")
    } else {
      shinyjs::enable("eval")
    }
  })
  
  counter <- 1
  active_id <- reactiveVal()
  observeEvent(input$eval, {
    req(code)
    current_id <- paste0("out_", counter)
    active_id(current_id)
    codeSE(id = current_id, active_id = active_id, code = input$code, env = env)
    insertUI(selector = "#add_here",ui = codeUI(current_id))
    counter <<- counter + 1
    runjs('
      document.getElementById("end").scrollIntoView();
    ')
  })   } 
shinyApp(ui, server)

最后，我在观察器中添加了 shinyjs::disable/enable 以修复您在点击时遇到的错误问题。

您的文件结构应如下所示：

- myapp
 - app.R
 - globals.R
 - input.template

下面是您的上述代码在此实现下的样子：

如何在闪亮的应用程序中像 knitr:html2html 一样使用 rmarkdown::render？

How to use rmarkdown::render like knitr:html2html in a shiny app?

r

knitr

shiny