如何在Shinydashboard中創建資訊框作為操作按鈕？

我有Shinydashboard它基本上從用戶那里獲取輸入檔案，并在頂部顯示 2 個圖，在儀表板底部顯示資料表。接下來，我在 Box1 的頂部添加了資訊框，這樣當用戶單擊資訊框時，在用戶單擊帶有新圖的資訊框后，圖 2 會更新，否則儀表板會顯示默認圖。以下是可重現的示例。我在這里關注 gogol 評論/代碼。但是，我不確定如何進行服務器端的資訊框編碼，因為問題與 Valuebox 相關？

總體而言，如果用戶單擊“資訊框”，則圖 2（在本例中為 Box2）將使用其他圖（例如 hp vs weight）進行更新，否則 plot2 將是默認值。在這種情況下，它將是壓力與溫度的關系圖。此外，如果 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)

uj5u.com熱心網友回復：

我們可以使用actionLink和包裹它infoBox。這將在下面的示例中生成一個輸入，命名為每次單擊input$info_clk時開始 0并上升。2為了將其轉換為控制流，我們在 if 陳述句中使用了該定義的其余部分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)

標籤：

上一篇：將多個子標題轉換為R中的因子列

下一篇：當資料沒有輸入值時如何顯示X軸值