【发布时间】：2021-07-29 21:00:55
【问题描述】：
我正在使用来自以下帖子的 Stéphane Laurent 的“EDIT 2”解决方案
在 R Shiny 表中渲染数学。但是，当应用程序中存在多个表时，只会呈现第一个表（请参见下面的表示）。
我无法在多个表中使用此功能，因此我们将不胜感激！
library(shiny)
js <- "
$(document).on('shiny:value', function(event) {
if(event.name === 'table'){
var matches = event.value.match(/(%%+[^%]+%%)/g);
var newvalue = event.value;
for(var i=0; i<matches.length; i++){
var code = '\\\\' + matches[i].slice(2,-2);
newvalue = newvalue.replace(matches[i], katex.renderToString(code));
}
event.value = newvalue;
}
})
"
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", href="https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/katex.min.css", integrity="sha384-9tPv11A+glH/on/wEu99NVwDPwkMQESOocs/ZGXPoIiLE8MU/qkqUcZ3zzL+6DuH", crossorigin="anonymous"),
tags$script(src="https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/katex.min.js", integrity="sha384-U8Vrjwb8fuHMt6ewaCy8uqeUXv4oitYACKdB0VziCerzt011iQ/0TqlSlv8MReCm", crossorigin="anonymous"),
tags$script(HTML(js))
),
titlePanel("Hello Shiny!"),
mainPanel(
numericInput("mean", "Enter mean", value = 1),
numericInput("mean_2", "Enter 2nd mean", value = 2),
tableOutput("table"),
tableOutput("table_2")
)
)
server <- function(input, output) {
output$table <- renderTable({
x <- rnorm(2)
y <- rnorm(2, input$mean)
tab <- data.frame(x = x, y = y, z = c("hello", "%%gamma%%%%delta%%"))
rownames(tab) <- c("%%alpha%%", "%%beta%%")
tab
}, rownames = TRUE)
output$table_2 <- renderTable({
x <- rnorm(2)
y <- rnorm(2, input$mean_2)
tab <- data.frame(x = x, y = y, z = c("hello", "%%eta%%%%epsilon%%"))
rownames(tab) <- c("%%alpha%%", "%%beta%%")
tab
}, rownames = TRUE)
}
shinyApp(ui, server)
编辑：
第二个问题是当表格事件被封装在 ns() 中时，如何在模块中实现这一点。请在下面找到演示此问题的代表：
app.R
library(shiny)
library(shinydashboard)
source("table1.R")
source("table2.R")
ui = dashboardPage(
header = dashboardHeader(),
body = dashboardBody(
tabItems(
tabItem(tabName = "table_1",
table1UI(id = "table1id")),
tabItem(tabName = "table_2",
table2UI(id = "table2id"))
) # Closes tabItems
), # Closes dashboard body
sidebar = dashboardSidebar(
width = 272.25, # Header is 230px button is 42.5px
minified = FALSE,
sidebarMenu(
menuItem("Table 1", tabName = "table_1", icon = icon("chalkboard-teacher"))),
menuItem("Table 2", tabName = "table_2", icon = icon("chalkboard-teacher")))
) # Closes UI
server = function(input, output, session) {
callModule(module = table1,
id = "table1id")
callModule(module = table2,
id = "table2id")
} # Closes Server
shinyApp(ui, server)
table1.R
js <- "
$(document).on('shiny:value', function(event) {
if(event.name === 'table_1'){
var matches = event.value.match(/(%%+[^%]+%%)/g);
var newvalue = event.value;
for(var i=0; i<matches.length; i++){
var code = '\\\\' + matches[i].slice(2,-2);
newvalue = newvalue.replace(matches[i], katex.renderToString(code));
}
event.value = newvalue;
}
})
"
table1UI <- function(id) {
ns <- NS(id)
fluidRow(
tags$head(
tags$link(rel="stylesheet", href="https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/katex.min.css", integrity="sha384-9tPv11A+glH/on/wEu99NVwDPwkMQESOocs/ZGXPoIiLE8MU/qkqUcZ3zzL+6DuH", crossorigin="anonymous"),
tags$script(src="https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/katex.min.js", integrity="sha384-U8Vrjwb8fuHMt6ewaCy8uqeUXv4oitYACKdB0VziCerzt011iQ/0TqlSlv8MReCm", crossorigin="anonymous"),
tags$script(HTML(js))
),
tagList(
numericInput(ns("mean"), "Enter mean", value = 2),
tableOutput(outputId = ns("table_1"))
))
} # Closes UI
table1 <- function(input, output, session, mean) {
output$table_1 <- renderTable({
x <- rnorm(2)
y <- rnorm(2, input$mean)
tab <- data.frame(x = x, y = y, z = c("hello", "%%gamma%%%%delta%%"))
rownames(tab) <- c("%%alpha%%", "%%beta%%")
tab
}, rownames = TRUE)
} # Closes server
table2.R
js <- "
$(document).on('shiny:value', function(event) {
if(event.name === 'table_2'){
var matches = event.value.match(/(%%+[^%]+%%)/g);
var newvalue = event.value;
for(var i=0; i<matches.length; i++){
var code = '\\\\' + matches[i].slice(2,-2);
newvalue = newvalue.replace(matches[i], katex.renderToString(code));
}
event.value = newvalue;
}
})
"
table2UI <- function(id) {
ns <- NS(id)
fluidRow(
tags$head(
tags$link(rel="stylesheet", href="https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/katex.min.css", integrity="sha384-9tPv11A+glH/on/wEu99NVwDPwkMQESOocs/ZGXPoIiLE8MU/qkqUcZ3zzL+6DuH", crossorigin="anonymous"),
tags$script(src="https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/katex.min.js", integrity="sha384-U8Vrjwb8fuHMt6ewaCy8uqeUXv4oitYACKdB0VziCerzt011iQ/0TqlSlv8MReCm", crossorigin="anonymous"),
tags$script(HTML(js))
),
tagList(
numericInput(ns("mean_2"), "Enter 2nd mean", value = 2),
tableOutput(outputId = ns("table_2"))
))
} # Closes UI
table2 <- function(input, output, session, mean_2) {
output$table_2 <- renderTable({
x <- rnorm(2)
y <- rnorm(2, input$mean_2)
tab <- data.frame(x = x, y = y, z = c("hello", "%%eta%%%%epsilon%%"))
rownames(tab) <- c("%%alpha%%", "%%beta%%")
tab
}, rownames = TRUE)
} # Closes server
【问题讨论】：