【问题标题】:Reset actionButton to display modaldialog more than once in Shiny重置 actionButton 以在 Shiny 中多次显示 modaldialog
【发布时间】:2020-11-14 10:35:41
【问题描述】:

我正在开发一个仪表板,如果用户需要一些额外的信息,我需要一个帮助按钮来显示一些信息。我希望能够根据需要多次点击帮助按钮。现在我在多个选项卡中使用相同的 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)

【问题讨论】:

    标签: r shiny shinydashboard


    【解决方案1】:

    闪亮的doesn't allow to use twice the same output in two different elements,没有任何警告。
    这就是这里发生的情况,因为输出 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

    【讨论】:

      猜你喜欢
      • 2018-10-19
      • 1970-01-01
      • 2016-09-15
      • 2019-10-14
      • 2018-06-04
      • 2017-01-23
      • 2023-02-12
      • 2021-04-27
      • 2018-09-18
      相关资源
      最近更新 更多