如何在闪亮的应用程序中嵌入 Markdown 块中突出显示 R 或 Python 代码

Question

我正在尝试将 R 中的动态代码块作为闪亮应用程序的一部分返回。我正在尝试做的一个简单示例是，

library(shiny)
runApp(list(
  ui = bootstrapPage(
    sliderInput("mu", "Mean", min=-30, max=30, value=0, step=0.2),
    uiOutput('chunk')
  ),
  server = function(input, output) {
    output$chunk <- renderUI({ 
       HTML(markdown::markdownToHTML(text=paste0("```{r}",
                                     "\n dnorm(0, ", input$mu,", 2)"), 
                                     options=c("highlight_code"))) })
    }
))

这会产生一个未格式化的代码块。我希望能够使用 pygments/another-solution 来突出显示此代码，以及将构成 Web 应用程序一部分的 python/其他语言代码。

有什么想法吗？

Answer 1

其他语言

这是一种适用于突出显示多种不同语言的解决方案。它基于this 答案，它使用Prism。我们加载 Prism 依赖项，然后为要突出显示的每种语言加载依赖项。

## from: https://stackoverflow.com/a/47445785/8099834
## get prism dependencies 
prismDependencies <- tags$head(
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/prism.min.js"),
    tags$link(rel = "stylesheet", type = "text/css",
              href = "https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/themes/prism.min.css")
)
prismLanguageDependencies <- function(languages) {
    lapply(languages, function(x) {
        tags$head(
            tags$script(
                src = paste0("https://cdnjs.cloudflare.com/ajax/libs/prism/1.8.4/components/prism-",
                             x, ".min.js")
            )
        )
    })
}

## format code with tags and language
prismAddTags <- function(code, language = "r") {
    paste0("<pre><code class = 'language-", language, "'>",
           code, 
           "</code></pre>")
}
prismCodeBlock <- function(code, language = "r") {
    tagList(
        HTML(prismAddTags(code, language = language)),
        tags$script("Prism.highlightAll()")
    )
}

## run app
library(shiny)
runApp(list(
    ui = bootstrapPage(
        prismDependencies,
        prismLanguageDependencies(c("sql", "r", "python")),
        sliderInput("mu", "Mean", min=-30, max=30, value=0, step=0.2),
        uiOutput('r_chunk'),
        uiOutput('python_chunk'),
        uiOutput('sql_chunk')
    ),
    server = function(input, output) {
        output$r_chunk <- renderUI({ 
            prismCodeBlock(
                code = paste0("# this is R code\ndnorm(0, ", input$mu,", 2)"),
                language = "r"
                )
        })
        output$python_chunk <- renderUI({
            prismCodeBlock(
                    code = '# this is python code
# Say hello, world.
print ("Hello, world!")',
                    language = "python"
            )
        })
        output$sql_chunk <- renderUI({
            prismCodeBlock(
                code = "-- this is SQL code
SELECT * FROM mytable WHERE 1=2",
                language = "sql"
            )
        })
    }
))

更新答案

正如 cmets 中所指出的，原来的答案是行不通的。事实证明，让突出显示工作需要更多的努力。

幸运的是，已经有人想通了！他们编写了两个函数：renderCode 用于server 和outputCode 用于ui，它们似乎运行良好。封装为here，相关功能为here。

这是一个例子：

## install the package
library(devtools)
install_github("statistikat/codeModules")

## run the app
library(codeModules)
library(shiny)
runApp(list(
    ui = bootstrapPage(
        sliderInput("mu", "Mean", min=-30, max=30, value=0, step=0.2),
        codeOutput('chunk')
    ),
    server = function(input, output) {
        output$chunk <- renderCode({ 
            paste0("dnorm(0, ", input$mu,", 2)")
        })
    }
))

原始答案 -- 不起作用

highlight.js 将格式化您的代码并包含在shiny 中。根据answer，目前支持 169 种语言。

您只需要标记您的代码。试试这样的：

library(shiny)
highlightCode <- function(code) {
    HTML(
        paste0("<pre><code class='html'>",
               code,
               "</code></pre>")
        )
}
runApp(list(
    ui = bootstrapPage(
        sliderInput("mu", "Mean", min=-30, max=30, value=0, step=0.2),
        uiOutput('chunk')
    ),
    server = function(input, output) {
        output$chunk <- renderUI({ 
            highlightCode(paste0("dnorm(0, ", input$mu,", 2)"))
        })
    }
))