我正在开发一个面板，如果用户需要一些额外信息，我需要在该面板上有一个帮助按钮来显示一些信息。我希望能够根据需要多次点击帮助按钮。现在，我在多个选项卡上使用相同的actionButton来获得帮助，但modalDialog只有在第一次单击按钮后才会显示。如何重置actionButton，以便根据需要多次显示modalDialog？
下方的可执行代码
library(shiny)
library(shinythemes)
library(shinydashboard)
library(tidyverse)
options(warn=-1)
data(iris)
data(mtcars)
tabset1 = tabsetPanel(id = "mtcars",
tabPanel(id = "mtplots","mtcars plots",
fluidRow(actionButton("helpme", "?????"), box(title = "Plot1", plotOutput("mtcarsplot1"))
)),
tabPanel(id = "mttable","MTcars tables",
fluidRow(box(title = "Table 1", tableOutput("mtcarstable1")))
))
tabset2 = tabsetPanel(id = "iris",
tabPanel(id = "iris","iris plots",
fluidRow(actionButton("helpme", "?????"), box(title = "Plot1", plotOutput("irisplot1"))
)),
tabPanel(id = "mttable","iris tables",
fluidRow(box(title = "Table 1", tableOutput("iristable1")))
))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("MTCARS", tabName = "mt", icon = icon("user-tie")),
selectInput("mtvar", "Choose a variable", choices = colnames(mtcars)),
sliderInput("mtlines", "Number of lines", 1,50,10),
menuItem("IRIS", icon = icon("envelope-open-text"), tabName = "ir"),
selectInput("irvar", "Choose a variable", choices = colnames(iris)),
sliderInput("irislines", "Number of lines", 1,50,10)
)
),
dashboardBody(
tabItems(
tabItem("ir", tabset2),
tabItem("mt", tabset1)
)
)
)
# Begin Server ----------------------------------------------
server <- function(input, output, session) {
observeEvent(input$helpme, {
showModal(modalDialog(
title = "What is the meaning of life?",
"THE MEANING OF LIFE IS 42",
easyClose = TRUE,
footer = NULL
))
})
output$mtcarsplot1=renderPlot({
ggplot(mtcars, aes_string(x = input$mtvar)) + geom_histogram()
})
output$irisplot1=renderPlot({
ggplot(iris, aes_string(x = input$irvar)) + geom_histogram()
})
output$mtcarstable1=renderTable({
head(mtcars, input$mtlines)
})
output$iristable1=renderTable({
head(iris, input$irislines)
})
}
shinyApp(ui, server)
Shiny不允许在两个不同的元素中使用两次相同的输出，并且没有任何警告。
这就是这里发生的情况，因为输出helpme在两个选项卡中使用
解决方法是创建两个不同的helpme:
library(shiny)
library(shinythemes)
library(shinydashboard)
library(tidyverse)
options(warn=-1)
data(iris)
data(mtcars)
tabset1 = tabsetPanel(id = "mtcars",
tabPanel(id = "mtplots","mtcars plots",
fluidRow(actionButton("helpme1", "?????"), box(title = "Plot1", plotOutput("mtcarsplot1"))
)),
tabPanel(id = "mttable","MTcars tables",
fluidRow(box(title = "Table 1", tableOutput("mtcarstable1")))
))
tabset2 = tabsetPanel(id = "iris",
tabPanel(id = "iris","iris plots",
fluidRow(actionButton("helpme2", "?????"), box(title = "Plot1", plotOutput("irisplot1"))
)),
tabPanel(id = "mttable","iris tables",
fluidRow(box(title = "Table 1", tableOutput("iristable1")))
))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("MTCARS", tabName = "mt", icon = icon("user-tie")),
selectInput("mtvar", "Choose a variable", choices = colnames(mtcars)),
sliderInput("mtlines", "Number of lines", 1,50,10),
menuItem("IRIS", icon = icon("envelope-open-text"), tabName = "ir"),
selectInput("irvar", "Choose a variable", choices = colnames(iris)),
sliderInput("irislines", "Number of lines", 1,50,10)
)
),
dashboardBody(
tabItems(
tabItem("ir", tabset2),
tabItem("mt", tabset1)
)
)
)
# Begin Server ----------------------------------------------
server <- function(input, output, session) {
observeEvent(input$helpme1, {
showModal(modalDialog(
title = "What is the meaning of life?",
"THE MEANING OF LIFE IS 42",
easyClose = TRUE,
footer = NULL
))
})
observeEvent(input$helpme2, {
showModal(modalDialog(
title = "What is the meaning of life?",
"THE MEANING OF LIFE IS 42",
easyClose = TRUE,
footer = NULL
))
})
output$mtcarsplot1=renderPlot({
ggplot(mtcars, aes_string(x = input$mtvar)) + geom_histogram()
})
output$irisplot1=renderPlot({
ggplot(iris, aes_string(x = input$irvar)) + geom_histogram()
})
output$mtcarstable1=renderTable({
head(mtcars, input$mtlines)
})
output$iristable1=renderTable({
head(iris, input$irislines)
})
}
shinyApp(ui, server)
您也可以在标头中仅使用一个output$helpme。