Question

我使用的是闪亮仪表板。在某些情况下，我希望隐藏所有或大多数盒子/图。

如果日期范围是不可能的（即结束日期早于开始日期）。
如果选择输入，将使样本大小过小。

对于问题1，我想隐藏所有框并仅返回错误消息。对于第2期，我想在顶部显示一些信息框（例如样本量），但将其余所有框都隐藏起来。

当前，我正在使用第一个条件的validate生成一条错误消息，并且在发生这种情况时也使用validate来阻止绘图运行。然而，即使它们是空的，这仍然留下盒子，这是非常丑陋和混乱的。

我想我可能可以将每个框放到conditionalPanel中，但这似乎很重复-当然，有一种更简单的方法可以将参数传递给所有（或一组）框？此代码是一个示例-我正在处理的应用程序中有很多框。

示例代码：

library(shiny)
library(shinydashboard)
library(tidyverse)


random_data <- data.frame(replicate(2, sample(0:10, 1000, rep=TRUE)))
set.seed(1984)
random_data$date <- sample(seq(as.Date('2016-01-01'), as.Date(Sys.Date()), by = "day"), 1000)

sidebar <- dashboardSidebar(dateRangeInput(
  "dates", label = h4("Date range"), start = '2016-01-01', end = Sys.Date(),
  format = "dd-mm-yyyy", startview = "year", min = "2016-01-01", max = Sys.Date()
))

body <- dashboardBody(
  textOutput("selected_dates"),
  br(),
  fluidRow(
        infoBoxOutput("total", width = 12)
  ),
  fluidRow(
    box(width = 12, solidHeader = TRUE,
        title = "X1 over time",
        plotOutput(outputId = "x1_time")
    )
  ),
  fluidRow(
    box(width = 12, solidHeader = TRUE,
        title = "X2 over time",
        plotOutput(outputId = "x2_time")
    )
  )
)

ui <- dashboardPage(dashboardHeader(title = "Example"),
                    sidebar,
                    body
)

server <- function(input, output) {
  filtered <- reactive({
    filtered_data <- random_data %>%
        filter(date >= input$dates[1] & date <= input$dates[2])
    return(filtered_data)
  })

  output$selected_dates <- renderText({
    validate(
      need(input$dates[2] >= input$dates[1], "End date is earlier than start date"
      )
    )
  })


  output$total<- renderInfoBox({
    validate(
      need(input$dates[2] >= input$dates[1], "")
    )
    infoBox(title = "Sample size", 
            value = nrow(filtered()), 
            icon = icon("binoculars"), color = "light-blue")
  })

  output$x1_time <- renderPlot({
    validate(
      need(input$dates[2] >= input$dates[1], "")
    )
    x1_time_plot <- ggplot(filtered(), aes(x = date, y = X1)) + 
      geom_bar(stat = "identity") 
      theme_minimal()
    x1_time_plot
  }) 

  output$x2_time <- renderPlot({
    validate(
      need(input$dates[2] >= input$dates[1], "")
    )
    x2_time_plot <- ggplot(filtered(), aes(x = date, y = X2)) + 
      geom_bar(stat = "identity") 
    theme_minimal()
    x2_time_plot
  }) 

}

shinyApp(ui, server)

Answer 1

您可以对要隐藏或显示的所有inputId使用shinyjs和show / hide方法，也可以将所有框放在带有类的div中。将隐藏/显示与此类别一起使用，或将类别直接分配给fluidRows。对于这两个示例，不再需要validate + need。

此示例显示/隐藏各个输出ID：

library(shiny)
library(shinydashboard)
library(tidyverse)
library(shinyjs)

## DATA ##################
random_data <- data.frame(replicate(2, sample(0:10, 1000, rep=TRUE)))
set.seed(1984)
random_data$date <- sample(seq(as.Date('2016-01-01'), as.Date(Sys.Date()), by = "day"), 1000)

sidebar <- dashboardSidebar(dateRangeInput(
  "dates", label = h4("Date range"), start = '2016-01-01', end = Sys.Date(),
  format = "dd-mm-yyyy", startview = "year", min = "2016-01-01", max = Sys.Date()
))
##################

## UI ##################
body <- dashboardBody(
  useShinyjs(),
  textOutput("selected_dates"),
  br(),
  fluidRow(
    infoBoxOutput("total", width = 12)
  ),
  fluidRow(
    box(width = 12, solidHeader = TRUE,
        title = "X1 over time",
        plotOutput(outputId = "x1_time")
    )
  ),
  fluidRow(
    box(width = 12, solidHeader = TRUE,
        title = "X2 over time",
        plotOutput(outputId = "x2_time")
    )
  )
)

ui <- dashboardPage(dashboardHeader(title = "Example"),
                    sidebar,
                    body
)
##################


server <- function(input, output) {
  filtered <- reactive({
    filtered_data <- random_data %>%
      filter(date >= input$dates[1] & date <= input$dates[2])
    return(filtered_data)
  })

  observe({
    if (input$dates[2] < input$dates[1]) {
      shinyjs::hide("total")
      shinyjs::hide("x1_time")
      shinyjs::hide("x2_time")
    } else {
      shinyjs::show("total")
      shinyjs::show("x1_time")
      shinyjs::show("x2_time")
    }
  })

  output$total<- renderInfoBox({
    infoBox(title = "Sample size", 
            value = nrow(filtered()), 
            icon = icon("binoculars"), color = "light-blue")
  })

  output$x1_time <- renderPlot({
    x1_time_plot <- ggplot(filtered(), aes(x = date, y = X1)) + 
      geom_bar(stat = "identity") 
    theme_minimal()
    x1_time_plot
  }) 

  output$x2_time <- renderPlot({
    x2_time_plot <- ggplot(filtered(), aes(x = date, y = X2)) + 
      geom_bar(stat = "identity") 
    theme_minimal()
    x2_time_plot
  }) 

}

shinyApp(ui, server)

该示例为fluidRows使用类，因此这将隐藏仪表板的整个主页：

## UI ##################
body <- dashboardBody(
  useShinyjs(),
  textOutput("selected_dates"),
  br(),
  fluidRow(class ="rowhide",
    infoBoxOutput("total", width = 12)
  ),
  fluidRow(class ="rowhide",
    box(width = 12, solidHeader = TRUE,
        title = "X1 over time",
        plotOutput(outputId = "x1_time")
    )
  ),
  fluidRow(class ="rowhide",
    box(width = 12, solidHeader = TRUE,
        title = "X2 over time",
        plotOutput(outputId = "x2_time")
    )
  )
)

ui <- dashboardPage(dashboardHeader(title = "Example"),
                    sidebar,
                    body
)
##################


server <- function(input, output) {
  filtered <- reactive({
    filtered_data <- random_data %>%
      filter(date >= input$dates[1] & date <= input$dates[2])
    return(filtered_data)
  })

  observe({
    if (input$dates[2] < input$dates[1]) {
      shinyjs::hide(selector = ".rowhide")
    } else {
      shinyjs::show(selector = ".rowhide")
    }
  })

  output$total<- renderInfoBox({
    infoBox(title = "Sample size", 
            value = nrow(filtered()), 
            icon = icon("binoculars"), color = "light-blue")
  })

  output$x1_time <- renderPlot({
    x1_time_plot <- ggplot(filtered(), aes(x = date, y = X1)) + 
      geom_bar(stat = "identity") 
    theme_minimal()
    x1_time_plot
  }) 

  output$x2_time <- renderPlot({
    x2_time_plot <- ggplot(filtered(), aes(x = date, y = X2)) + 
      geom_bar(stat = "identity") 
    theme_minimal()
    x2_time_plot
  }) 

}

shinyApp(ui, server)

如果输入不适合Shiny，则隐藏框

1 个答案: