如何在 ShinyDashboard R 中显示年初至今的数据？

Question

下面是数据集。该数据集是关于特定年份特定位置的仪器使用情况。当前下面的代码根据 SideBar 面板中的选定选项显示结果，即当用户选择 "Loc1" 和年份“2018”时，它将过滤并显示 mainpanel 中的数据图表形式以及 table。接下来，我想在选择最新年份时在 mainpanel 中显示 YTD（年初至今）结果。在这种情况下，当用户选择 Loc1 和 Year 2019 时，mainpanel 中的输出应该显示 2018 年和 2019 年的数据。但是，当用户在这种情况下选择去年的数据 2018 年时，它应该只显示 2018 年的数据。

当前问题： 在 Ben 和 Ronak 的建议下，我能够根据需要过滤 2018 年和 2019 年的数据。即，当用户选择 2019 时，它显示 2019 年、2018 年和 0 的数据。当用户选择 2018 年时，显示 2018 年和 0 年的数据。但是，当我选择 0 年时，所有年份的数据都显示在仪表板的 mainpanel 中。 所有需要的是在特定 location.Not 处显示 0 年的数据确定代码中的问题是什么"Code after Suggestion from Ben and Ronak Shah"节。

提供代码说明。

数据集：

structure(list(Systems = c("Sys1", "Sys1", "Sys2", "Sys3", "Sys4", 
"Sys6", "Sys7"), Locations = c("loc1", "loc1", "loc1", "loc2", 
"loc2", "loc3", "loc1"), year = structure(c(2L, 1L, 1L, 1L, 1L, 
3L, 3L), .Label = c("2019", "2018", "0"), class = "factor"), 
    frequency = c(1L, 2L, 1L, 1L, 1L, 0L, 0L), freq_cal = c(33.33, 
    66.67, 100, 100, 100, 0, 0), label = c("33.33%", "66.67%", 
    "100.00%", "100.00%", "100.00%", "0.00%", "0.00%")), row.names = c(NA, 
-7L), class = "data.frame")

Ben 和 Ronak 建议之前的代码：

library(shiny)
library(shinydashboard)
library(plotly)

resetForm<-function(session){
  updateSelectInput(session,"slct1",selected = ' ')
}
ui<-dashboardPage(
  dashboardHeader(title="System Tracker"),
  dashboardSidebar(
    selectInput('slct1',"Select Location",choices = c(" ",d$Locations)),
    selectInput('slct2',"Select Year",choices = d$year),
    actionButton('clear',"Reset Form"),
    h4("Powered by:"),
    tags$img(src='baka.png',height=50,width=50)
  ),
  dashboardBody(
    #fluidRow(
    # box( DT::dataTableOutput("mytable")),
    #     box(plotlyOutput('out'))
    conditionalPanel(
      #Uses a Javascript formatted condition
      condition="input.slct1 !== ' '",
     #box(DT::dataTableOutput("mytable"),background = "maroon"),
     tags$style(HTML("


                     .box.box-solid.box-primary>.box-header {
                     color:#fff;
                     background:##00C5CD
                     }

                     .box.box-solid.box-primary{
                     border-bottom-color:##00C5CD;
                     border-left-color:##00C5CD;
                     border-right-color:##00C5CD;
                     border-top-color:##00C5CD;
                     }")),
      uiOutput("mytable"),
      uiOutput("placeholder")
    )

  )
)


server<-function(input, output,session) {

  output$mytable=renderUI({
    box(title = paste("Selected Location: ",input$slct1),
        output$aa<-DT::renderDataTable({
      req(input$slct1)
      d %>%
        filter(Locations==input$slct1)%>%
      filter(year==input$slct2)
    }),status = "primary",solidHeader = T)
  })

  output$placeholder = renderUI({
    req(input$slct1)
    box(title = paste("Selected Location: ",input$slct1),plotlyOutput('out'),status = 'primary',solidHeader = T)
  })

 # output$mytable = DT::renderDataTable({
  #  req(input$slct1)

   #d %>%
    #  filter(Locations==input$slct1)

#})


  output$out<-renderPlotly({
    req(input$slct1)

    data_filter<-d %>%
      filter(Locations==input$slct1)%>%
      filter(year==input$slct2)

    req(nrow(data_filter)>0)

    ggplotly(ggplot(data_filter, aes(Systems,frequency,fill=year)) +
               geom_col(position = 'stack')+geom_text(aes(label=label), position = position_stack(vjust = .5)))#+
    #facet_grid(.~Locations, space= "free_x", scales = "free_x"))

  })


  observeEvent(input$clear,{
    req(input$slct1)
    updateSelectInput(session,"slct1",selected = ' ')
  })
}

shinyApp(ui, server)

根据 Ben 和

建议的代码

library(shiny)
library(shinydashboard)
library(plotly)


d$year<-as.numeric(as.character(d$year)) 

resetForm<-function(session){
  updateSelectInput(session,"slct1",selected = ' ')
}
ui<-dashboardPage(
  dashboardHeader(title="System Tracker"),
  dashboardSidebar(
    selectInput('slct1',"Select Location",choices = c(" ",d$Locations)),
    selectInput('slct2',"Select Year",choices = c("2018"="2018","2019"="2019","0"="No Use")),
    actionButton('clear',"Reset Form"),
    h4("Powered by:"),
    tags$img(src='baka.png',height=50,width=50)
  ),
  dashboardBody(
    #fluidRow(
    # box( DT::dataTableOutput("mytable")),
    #     box(plotlyOutput('out'))
    conditionalPanel(
      #Uses a Javascript formatted condition
      condition="input.slct1 !== ' '",
     #box(DT::dataTableOutput("mytable"),background = "maroon"),
     tags$style(HTML("


                     .box.box-solid.box-primary>.box-header {
                     color:#fff;
                     background:##00C5CD
                     }

                     .box.box-solid.box-primary{
                     border-bottom-color:##00C5CD;
                     border-left-color:##00C5CD;
                     border-right-color:##00C5CD;
                     border-top-color:##00C5CD;
                     }")),
      uiOutput("mytable"),
      uiOutput("placeholder")
    )

  )
)


server<-function(input, output,session) {

  output$mytable=renderUI({
    box(title = paste("Selected Location: ",input$slct1),
        output$aa<-DT::renderDataTable({
      req(input$slct1)
    #  d %>%
     #   filter(Locations==input$slct1)%>%
     #filter(year<=input$slct2)
          data_filter<-function(d,loc,num) {
            d %>% 
              filter(Locations==loc)%>%
              filter(year <= num) 
          }
        data_filter(d,input$slct1,input$slct2)

   }),status = "primary",solidHeader = T)
  })

  output$placeholder = renderUI({
    req(input$slct1)
    box(title = paste("Selected Location: ",input$slct1),plotlyOutput('out'),status = 'primary',solidHeader = T)
  })


  output$out<-renderPlotly({
    req(input$slct1)

   # data_filter<-d %>%
    # filter(Locations==input$slct1)%>%
     # filter(year<=input$slct2)

   data_filter<- function(d,loc, num) {
      d %>% 
        filter(Locations==loc)%>%
        filter(year <= num) 
    }
    data_filter<-data_filter(d,input$slct1,input$slct2)

    req(nrow(data_filter)>0)

    ggplotly(ggplot(data_filter, aes(Systems,frequency,fill=as.factor(year))) +
               geom_col(position = 'stack')+geom_text(aes(label=label), position = position_stack(vjust = .5)))#+
    #facet_grid(.~Locations, space= "free_x", scales = "free_x"))

  })


  observeEvent(input$clear,{
    req(input$slct1)
    updateSelectInput(session,"slct1",selected = ' ')
  })
}

shinyApp(ui, server)

Answer 1

根据您最近的代码，您似乎想将 d$year 与闪亮的 selected 输入（Select 年）进行比较。 d$year 是数字，而 selectInput 提供一个字符串。如果您在 selectInput 语句中包含数值，它似乎应该有效（让我知道）：

selectInput('slct2',"Select Year",choices = c("2018"=2018,"2019"=2019,"0"=0))

注意：如果您想要一个选项来读取 "No Use" for Year = 0，那么在您的 selectInput:

中它应该是 "No Use" = 0

selectInput('slct2',"Select Year",choices = c("2018"=2018,"2019"=2019,"No Use"=0))

编辑：根据我们的聊天记录，如果 selected 年份和位置存在任何数据，我们只想包括前几年。例如，如果 select 'loc3' 和 '2018' 它不会显示任何数据，因为没有行与该组合完全匹配（即使存在年份 '0' 的数据）。但是，如果 select 'loc3' 和 '0' 则将显示一行数据，因为有一行匹配 'loc3' 和年份 0.

这里更新了data_filter方法。它首先检查匹配位置和年份的数据。如果有数据，那么它将 return 当年和往年的所有数据。如果没有数据，那么它将 return NULL。（或者，您可以 return 一个空数据框，并使用 'no data available' 的消息保留相同的变量 --- 只需使用 return (d[0,]) 而不是 NULL）。

此外，将只使用一个 data_filter 方法而不是两个（放在服务器 <- 函数（输入、输出、会话）声明之后的开头。

data_filter <- function (d,loc,num) {
  if (nrow(d %>% filter(Locations == loc, year == num)) > 0) {
    return (d %>% filter(Locations == loc, year <= num))
  } else {
    return (NULL)
  }
}

如果这是您的想法并且逻辑正确，请告诉我。这是完整的服务器方法，d[0, ] returned for 'no data available':

server<-function(input, output,session) {

  data_filter <- function (d,loc,num) {
    if (nrow(d %>% filter(Locations == loc, year == num)) > 0) {
      return (d %>% filter(Locations == loc, year <= num))
    } else {
      return (d[0,])
    }
  }

  output$mytable=renderUI({
    box(title = paste("Selected Location: ",input$slct1),
        output$aa<-DT::renderDataTable({
          req(input$slct1)
          data_filter(d, input$slct1, input$slct2)
        }),status = "primary",solidHeader = T)
  })

  output$placeholder = renderUI({
    req(input$slct1)
    box(title = paste("Selected Location: ",input$slct1),plotlyOutput('out'),status = 'primary',solidHeader = T)
  })

  output$out<-renderPlotly({
    req(input$slct1)
    data_filter<-data_filter(d,input$slct1,input$slct2)
    req(nrow(data_filter)>0)
    ggplotly(ggplot(data_filter, aes(Systems,frequency,fill=as.factor(year))) +
               geom_col(position = 'stack')+geom_text(aes(label=label), position = position_stack(vjust = .5)))
  })

  observeEvent(input$clear,{
    req(input$slct1)
    updateSelectInput(session,"slct1",selected = ' ')
  })
}

如何在 ShinyDashboard R 中显示年初至今的数据？

How to display Year to Date data in ShinyDashboard R?

r

shiny

dplyr

shinydashboard

shiny-reactivity