【发布时间】：2018-12-11 12:16:51
【问题描述】：
我正在使用闪亮和闪亮的仪表板。在某些情况下，我希望隐藏所有或大多数框/图。
- 如果日期范围不可能（即结束日期早于开始日期）。
- 如果选择的输入会使样本量过小。
对于问题 1，我想隐藏所有框并返回错误消息。对于问题 2，我想在顶部显示一些信息框（例如样本大小），但隐藏所有其余的框。
目前，我在第一个条件下使用 validate 生成错误消息，并在发生这种情况时使用 validate 来阻止绘图运行。然而，这仍然留下了盒子，即使它们是空的，这非常丑陋和凌乱。
我想我可能可以将每个框放入一个条件面板中，但这似乎非常重复 - 肯定有一种更简单的方法可以将参数传递给所有（或一组）框？此代码是一个示例 - 我正在开发的应用程序中有更多的框。
示例代码：
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)
【问题讨论】：
标签： r shiny shinydashboard