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

Question

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

当前问题：根据Ben和Ronak的建议，我能够根据需要过滤2018年和2019年的数据。 即，当用户选择2019时，它将显示2019、2018和0的数据。当用户选择2018时，将显示2018和0的数据。 然而，当我在今年选择0，对于所有的几年得到的数据显示在mainpanel仪表板。 所有需要的是在特定位置显示0年的数据。不确定“ 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和Ronak Shah提出建议后的代码

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与选定的输入（Select Year）进行比较。 d $ year是数字，而selectInput提供了一个字符串。 如果在selectInput语句中包含数字值，则似乎应该可以（请告诉我）：

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

注意：如果您打算将Year = 0的选项读取为“ No Use”，那么在selectInput中应将其设置为“ No Use” = 0：

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

编辑：根据我们的聊天，如果所选年份和位置存在任何数据，我们只希望包括以前的年份。 例如，如果选择“ loc3”和“ 2018”，则不会显示任何数据，因为没有匹配该确切组合的行（即使存在“ 0”年的数据）。 但是，如果选择“ loc3”和“ 0”，则会显示一行数据，因为有一行与“ loc3”和Year 0匹配。

data_filter方法在此处更新。 它首先检查与位置和年份都匹配的数据。 如果有数据，则它将返回该年和前几年的所有数据。 如果没有数据，则它将返回NULL。 （或者，您可以返回一个空数据框，并使用“无可用数据”消息保留相同的变量---仅使用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，]：

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中显示年初至今数据？

问题描述

1 个解决方案

解决方案1
1 已采纳 2019-08-12 20:26:31

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

问题描述

1 个解决方案

解决方案1 1 已采纳 2019-08-12 20:26:31

解决方案1
1 已采纳 2019-08-12 20:26:31