如何在 Shinydashboard 中创建信息框作为操作按钮？

Question

I have Shinydashboard which basically take input file from user and displays 2 plots at top and datatable at the bottom of the dashboard. Next, I added infobox at the top of the Box1 so that when users clicks on infobox, the plot2 gets updated after user clicks on infobox with new plot, otherwise dashboard displays default plot. Below is reproducible example. I am following gogol comment/code here . However, I am not sure how to proceed with infobox coding for server side as the question was related to Valuebox?

Overall, ask is If user clicks on "Infobox" then plot 2 (Box2 in this case) will get updated with other plot (ex. hp vs weight) otherwise the plot2 will be default. In this case, it will be Pressure vs temperature plot. Also, If the plot2 is updated then when user clicks on plot2 the updated plot should get displayed in Modal dialog otherwise the default plot should get displayed in modal dialog.

Thanks in advance for your time and efforts!

library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(shinyBS)
library(DT)

ui<-dashboardPage(
  dashboardHeader(title="Missing",titleWidth = 230),
  dashboardSidebar(
    fileInput("file1", "Upload CSV File below",
              accept = c(
                "text/csv",
                "text/comma-separated-values,text/plain",
                ".csv")
    )),
  dashboardBody(
    fluidRow(
      tags$head(tags$style(HTML('.info-box {min-height: 45px;} .info-box-icon {height: 45px; line-height: 45px;} .info-box-content {padding-top: 0px; padding-bottom: 0px;}'))),
      infoBox(" ", fill = TRUE,width = 7,value = tags$p("Infobox", style = "font-size: 100%;")),
      infoBoxOutput("Infobox"),
      div(id="popme1", box(plotOutput("Plot1"),collapsible = TRUE,title="Plot 1",solidHeader = TRUE,status = "primary")),
      bsModal("modalExample1", "Plot1", "popme1", size = "large", plotOutput("Plot11")),
      div(id="popme2", box(plotOutput("Plot2"),collapsible=TRUE,title="Plot 2",solidHeader = TRUE,status = "primary")),
      bsModal("modalExample2", "Plot2", "popme2", size = "large", plotOutput("Plot22")),
      div(id="popme3", fluidRow(column(width=8,box(DTOutput("Missing_datatable"), width = NULL,collapsible = TRUE)) )),
      bsModal("modalExample3", "Data Table", "popme3", size = "large", DTOutput("Missing_datatable2"))
    )
  )
)

server<- function(input, output,session) {
  
  output$Plot1 <- renderPlot({
    plot(cars)
  })
  output$Plot11 <- renderPlot({
    plot(cars)
  })
  output$Plot22 <- renderPlot({ plot(pressure)})
  
  output$Plot2 <- renderPlot({ plot(pressure) })
  
  output$Missing_datatable <- renderDT({iris[1:7,]})
  output$Missing_datatable2 <- renderDT({iris[1:7,]})
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

We can use actionLink and wrap it around infoBox . This will generate an input in the example below named input$info_clk which starts at 0 and gos up with each click. To turn this into an control-flow we use the remainder of the devision with 2 in an if statement if(input$info_clk %% 2) :

library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(shinyBS)
library(DT)

ui<-dashboardPage(
  dashboardHeader(title="Missing",titleWidth = 230),
  dashboardSidebar(
    fileInput("file1", "Upload CSV File below",
              accept = c(
                "text/csv",
                "text/comma-separated-values,text/plain",
                ".csv")
    )),
  dashboardBody(
    fluidRow(
      
      tags$head(
        tags$style(HTML('.info-box {min-height: 45px;} .info-box-icon {height: 45px; line-height: 45px;} .info-box-content {padding-top: 0px; padding-bottom: 0px;}')
                   )
        ),
      
      actionLink("info_clk",
        infoBox(" ", fill = TRUE, width = 7, value = tags$p("Infobox", style = "font-size: 100%;"))
        ),
      
      # infoBoxOutput("Infobox"),
      
      div(id="popme1", box(plotOutput("Plot1"),collapsible = TRUE,title="Plot 1",solidHeader = TRUE,status = "primary")),
      bsModal("modalExample1", "Plot1", "popme1", size = "large", plotOutput("Plot11")),
      
      div(id="popme2", box(plotOutput("Plot2"),collapsible=TRUE,title="Plot 2",solidHeader = TRUE,status = "primary")),
      bsModal("modalExample2", "Plot2", "popme2", size = "large", plotOutput("Plot22")),
      
      div(id="popme3", fluidRow(column(width=8,box(DTOutput("Missing_datatable"), width = NULL,collapsible = TRUE)) )),
      bsModal("modalExample3", "Data Table", "popme3", size = "large", DTOutput("Missing_datatable2"))
      
    )
  )
)

server<- function(input, output,session) {
  
  output$Plot1 <- output$Plot11 <- renderPlot({
    plot(cars)
  })
  
  output$Plot2 <- output$Plot22 <- renderPlot({
    
    if (input$info_clk %% 2L) {
      plot(mtcars$wt, mtcars$hp)
    } else {
      plot(pressure)
    }
    })
  
    output$Missing_datatable <- renderDT({iris[1:7,]})
  output$Missing_datatable2 <- renderDT({iris[1:7,]})
}

# Run the application 
shinyApp(ui = ui, server = server)