如何在闪亮的应用程序中使用knitr:html2html之类的rmarkdown :: render? [英] How to use rmarkdown::render like knitr:html2html in a shiny app?
问题描述
我有一个使用 knitr :: knit2html 的应用程序，该应用程序运行良好(除了一些小故障，单击该代码后，稍后会执行该代码).
I have an app that uses knitr::knit2html which works well (except for some glitches where upon clicking, the code is executed later).
我想使用 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 表的缺点.
I would like to use rmarkdown::render to overcome the drawback of unstyled knitr::kable tables.
推荐答案
这是使用晶须模板的解决方案.
Here's a solution using whisker templates.
在 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 ::渲染.渲染在该临时目录中，然后将文件路径返回到最终的html渲染输出.
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 }}}
```
然后在 app.R 中，您只需调用以前调用过的 rmd_file<-output_rmd(code)和 includeHTML(rmd_file) HTML 和 knit2html
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)
最后，我在观察器中添加了 shinyjs :: disable/enable ，以解决您在单击时遇到的错误问题.
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:
这篇关于如何在闪亮的应用程序中使用knitr:html2html之类的rmarkdown :: render?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
