Shiny Dashboard 中的 dateRangeInput 简介我的数据标题、侧边栏和正文界面服务器

如何解决Shiny Dashboard 中的 dateRangeInput 简介我的数据标题、侧边栏和正文界面服务器

简介

我正在尝试根据日期创建交互式 shinydashboard，因此我的目标是使用 daterangeInput 过滤我的数据，以便我的图形和 valueBox 成为交互式。问题可能是我误解了一些东西，我的闪亮仪表板不能交互或返回错误的值，我不知道为什么不能工作。

我的数据

我的数据来源是一个 csv 文件。我在此示例中使用的两列分别是 Doses_aplicadas 和 Data 数字和日期。我的日期格式为 "%d/%m/%Y"，但我使用函数 as.Date 使事情变得简单。

library(shiny)
library(shinydashboard)
library(dplyr)
my_df <- rio::import("my_data.csv")
my_df <- my_df %>% mutate(Data =  as.Date(Data,format = "%d/%m/%Y"))

由于不是一个大的 csv，我将分享一个 dput 版本。

> dput(head(my_df))
structure(list(Data = structure(c(18706,18708,18710,18712,18714,18716),class = "Date"),Doses_aplicadas = c(10000L,16000L,14000L,18000L,10000L),Primeira_dose = c(9500L,10000L,8000L),Segunda_dose = c(0L,5400L,3600L,5870L,7720L,1600L),Doses_perdidas = c(500L,600L,400L,130L,280L,400L),Doses_acumuladas = c(19500L,45500L,69500L,95500L,123500L,141500L),Doses_estoque = c(130L,100L,210L,250L,260L,230L)),row.names = c(NA,6L),class = "data.frame")

标题、侧边栏和正文

header 和 sidebar 看起来没有错，因为它们是静态的。


header <- dashboardHeader(
  title = paste0("my title"),titleWidth = 300
)
sidebar <- dashboardSidebar(disable = TRUE)

我正在分享的 body 有两件事：daterangeInput 的开始和结束日期取决于 Data，关于日期的简单文本（这仅适用于我）和 valueBoxOutput 返回框的值。

body <- dashboardBody(
  fluidRow(
    daterangeInput('daterange',label = 'Selecione a data desejada',start = min(my_df$Data),end = max(my_df$Data),format = "yyyy-mm-d",language = "pt-BR",separator  = "até",weekstart = 0
    ),verbatimtextoutput("daterangeText")
  ),#### value Box----
  fluidRow(
    title = "Doses aplicadas",valueBoxOutput("card_1")
)

界面

因为我使用的是 shinydashboard ui，所以操作起来也很简单。

ui <- dashboardPage(
  header,sidebar,body
)

服务器

这里是我认为问题的来源。在服务器中，我使用 observe 使仪表板具有交互性，但在尝试 renderValueBox 时返回 0，它应该返回 sum 的 Doses_aplicadas。我不明白为什么会发生这种情况，daterangeText 返回正确的日期，但 renderValueBox 没有。

server <- function(input,output) {
  output$daterangeText  <- renderText({
  paste("Data de filtro",paste0(input$daterange[1]," a ",input$daterange[2])
  )
  })

  observe({
    output$card_1 <- renderValueBox({
      value_card_1 <-  subset(my_df,Data >= as.Date(input$date[1]) & 
                                Data <= as.Date(input$date[2])
      )  %>% select(Doses_aplicadas) %>% 
        summarise(Doses_aplicadas = sum(Doses_aplicadas))
    valueBox(paste0(value_card_1[1,1]),"Doses aplicadas",icon = icon("heartbeat"))
    })
  })

}
shinyApp(ui = ui,server = server)

我不明白为什么 shinydashboard 不是交互式的，因此欢迎您提供任何帮助。