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

Question

我有 Shinydashboard，它基本上从用户那里获取输入文件，并在仪表板顶部显示 2 个绘图，在仪表板底部显示数据表。接下来，我在 Box1 的顶部添加了信息框，这样当用户点击信息框时，plot2 在用户点击带有新绘图的信息框后得到更新，否则仪表板显示默认绘图。下面是可重现的例子。我正在关注 gogol comment/code 。但是，我不确定如何进行服务器端的信息框编码，因为问题与 Valuebox 有关？

总的来说，问题是如果用户点击“信息框”，那么绘图 2（在本例中为 Box2）将与其他绘图（例如 hp 与重量）一起更新，否则绘图 2 将是默认的。在这种情况下，它将是压力与温度图。此外，如果 plot2 已更新，则当用户单击 plot2 时，更新后的图应显示在模态对话框中，否则默认图应显示在模态对话框中。

提前感谢您的时间和努力！

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

我们可以使用 actionLink 并将其环绕在 infoBox 周围。这将在下面的示例中生成一个名为 input$info_clk 的输入，它从 0 开始并随着每次点击而增加。为了将其变成 control-flow，我们在 if 语句 if(input$info_clk %% 2):

中使用 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)

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

How to create Infobox as actionbutton in Shinydashboard?

r

shiny

shinydashboard

shiny-server

shiny-reactivity