如何在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