问题
I have an app that uses knitr::knit2html which works well (except for some glitches where upon clicking, the code is executed later).
I would like to use the rmarkdown::render function instead of knitr::knit2html
Code
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)
I would like to use rmarkdown::render to overcome the drawback of unstyled knitr::kable tables.
回答1:
Here's a solution using whisker templates.
in 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)
}
This function reads in input.template, appends the code you want to run to the template, saves out the finished .Rmd file to a temp directory, renders it using rmarkdown::render in that temp directory, and then returns the file path to the final html rendered output.
input.template
---
title: "Shiny Run Code"
output: html_document
---
```{r echo = TRUE, comment = NA}
{{{ code_chunk }}}
```
Then in app.R you just call rmd_file <- output_rmd(code) and includeHTML(rmd_file) where you were previously calling HTML and the 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)
Lastly, I added the shinyjs::disable/enable in the observer to fix that bug issue you had with the glitches on clicking.
Your file structure should look like:
- myapp
- app.R
- globals.R
- input.template
And here's what your above code would look like under this implementation:
回答2:
See this example 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)
In ui portion include:
downloadButton('downloadReport')radioButtons('format', 'Document format', c('PDF', 'HTML', 'Word'), inline = TRUE)
In server portion include:
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)
}
)
Also you'll need a Report.Rmd file in the same directory as the app.
来源：https://stackoverflow.com/questions/65347401/how-to-use-rmarkdownrender-like-knitrhtml2html-in-a-shiny-app