R Shiny ggvis對動態輸入無反應

Question

我嘗試使用ggvis條形圖構建一個閃亮的儀表板。 這個想法是要顯示一年中特定月份前十項費用最高的條形圖。 用戶可以選擇一年零一個月。 月份的選擇取決於所選的年份，因此，如果選擇2016年，則只能選擇迄今為止的月份。

我不知何故無法將動態輸入字段的值傳遞到條形圖。 盡管只要兩個輸入字段都是靜態的，它就可以工作（在服務器腳本的第一行中將input $ month1與input $ monthtest交換會顯示出它的外觀）。 我已經嘗試了所有我能想到的一切，從隔離輸入月份到使用observe（）代替active（）。

返回的錯誤是：警告：eval錯誤：長度（0）不正確，期望值：12； 即以某種方式將動態字段中的值不傳遞給反應性環境

提前謝謝了！

這是一個“最小”的工作示例，與我的實際儀表板看起來足夠接近：

#Minimal example Shiny dynamic field
#ggvis Barchart depending on static and dynamic dropdown

library("zoo")
library("shiny")
library("ggvis")
library("magrittr")
library("dplyr")
library("lubridate")

#data-------------
#in the actual code months are in German
month.loc <-  c("January","February","March","April","Mai", "June",
            "July","August","September","October","November", "December")

#generate data
Databc1M<-data.frame("date"=seq(as.Date("2015-01-01"), 
as.Date("2016-03-01"), by="months"), "cost1"=runif(15,min=0,max=100),
     "cost2"=runif(15,min=0,max=100), "cost3"=runif(15,min=0,max=100), 
     "cost4"=runif(15,min=0,max=100),
     "cost5"=runif(15,min=0,max=100), "cost6"=runif(15,min=0,max=100),
     "cost7"=runif(15,min=0,max=100),
     "cost8"=runif(15,min=0,max=100), "cost9"=runif(15,min=0,max=100),
     "cost10"=runif(15,min=0,max=100))

#ui-------------
ui <- fluidPage(
 ggvisOutput(plot_id = "Barcha_Abw"),
  selectInput(inputId = "Year1", label = h3("Choose a year"),
           choices = c(2015,2016), selected=2015
),
#Rendering plot works with static input field
selectInput(inputId = "monthtest", label = h3("Choose a month"),
           choices = month.loc[1:3], selected=month.loc[1]
),
uiOutput("bc1month")

)

#server-------------
server <- function(input, output, session) {
 output$bc1month <- renderUI({
 #filter available months in a given year
 outmonths<- Databc1M %>% dplyr::filter(format(Databc1M$date,"%Y")== 
 as.character(input$Year1)) %>% 
   .[[1]] %>% month() %>% month.loc[.]

 #dynamic dropdown; latest month selected
 selectInput(inputId = 'month1', label = h3("Choose a month
  (dynamic drop down)"), choices = outmonths, 
  #choose latest month in dataset
  selected= Databc1M[NROW(Databc1M),"date"] %>% month() %>%
  month.loc[.]) 
 })

#structure data and render barchart
TopAbw1 <- reactive({

 Dataaux <- Databc1M %>%
  dplyr::filter(format(Databc1M$date,"%Y")==input$Year1)

 #!!!!!! not working: match(input$month1,...); input$monthtest works
 Dataaux<-
 dplyr::filter(Dataaux,month(Dataaux$date)==match(input$month1,
 month.loc)) #input$month1
 Dataaux <- gather(Dataaux,key="cost_id",value="Abweichung")
 Dataaux <- Dataaux[-1,]

 Dataaux <- Dataaux[order(Dataaux$Abweichung,decreasing=TRUE),] %>%
  head(10)

 Dataaux$cost_id <- factor(Dataaux$cost_id, levels = Dataaux$cost_id)

 #render barchart 
 Dataaux %>% 
  ggvis(y=~abs(Abweichung),x=~cost_id) %>%
   layer_text(text:=~round(abs(Abweichung),2)) %>%
    layer_bars( stack =FALSE) %>%
     add_axis("x", title = "", properties = axis_props(labels =
      list(angle= 45, align = "left", fontSize = 12))) %>%
       add_axis("y", title = "Mio. EUR") 
})

TopAbw1 %>% bind_shiny("Barcha_Abw")

}

shinyApp(ui = ui, server = server)

Answer 1

我有這個問題的德語版本。 出於文檔目的（如果有人對答案感到好奇：

#Minimal example Shiny dynamic field
#ggis Barchart soll nach Nutzereingabe in 2 Dropdowns neu gerendert werden
#Ein Dropdown ist dynamisch

library("zoo")
library("shiny")
library("ggvis")
library("magrittr")
library("dplyr")
library("lubridate")

#data-------------
month.loc <-  c("Januar","Februar","März","April","Mai", "Juni",
                "Juli","August","September","Oktober","November", "Dezember")

currdate <- as.Date("2015-01-01",format="%Y-%m-%d")

Databc1M<-data.frame("date"=seq(as.Date("2015-01-01"), as.Date("2016-03-01"), by="months"), "cost1"=runif(15,min=0,max=100),
                     "cost2"=runif(15,min=0,max=100), "cost3"=runif(15,min=0,max=100), "cost4"=runif(15,min=0,max=100),
                     "cost5"=runif(15,min=0,max=100), "cost6"=runif(15,min=0,max=100), "cost7"=runif(15,min=0,max=100),
                     "cost8"=runif(15,min=0,max=100), "cost9"=runif(15,min=0,max=100), "cost10"=runif(15,min=0,max=100))




#ui-------------
ui <- fluidPage(
  ggvisOutput(plot_id = "Barcha_Abw"),
  selectInput(inputId = "Year1", label = h3("Wählen Sie ein Jahr"),
              choices = c(2015,2016), selected=2015
  ),
  #Test mit fixem dropdown funktioniert der Plot
  uiOutput("bc1month"),
  plotOutput("TopAbw1")

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

  output$bc1month <- renderUI({

    outmonths<- Databc1M %>% dplyr::filter(format(Databc1M$date,"%Y")== input$Year1) %>% 
      .[[1]] %>% month() %>% month.loc[.]

    #input$Year1
    selectInput(inputId = 'month1', label = h3("Wählen Sie einen Monat (dynamisch)"), choices = outmonths) 

  })
  TopAbw1 <- reactive({

    Dataaux <- Databc1M[which(year(Databc1M$date) %in% input$Year1),]
    Dataaux <- Dataaux[which(months(Dataaux$date) %in% input$month1),]
    Dataaux <- gather(Dataaux,key="cost_id",value="Abweichung")
    Dataaux <- Dataaux[-1,]

    Dataaux <- Dataaux[order(Dataaux$Abweichung,decreasing=TRUE),] %>%
      head(10)

    Dataaux$cost_id <- factor(Dataaux$cost_id, levels = Dataaux$cost_id)

    Dataaux %>% 
      ggvis(y=~abs(Abweichung),x=~cost_id) #%>%
      #layer_text(text:=~round(abs(Abweichung),2)) %>%
      #layer_bars( stack =FALSE) %>%
      #add_axis("x", title = "", properties = axis_props(labels = list(angle = 45, align = "left", fontSize = 12))) %>%
      #add_axis("y", title = "Mio. EUR") 

  })
  TopAbw1 %>% bind_shiny("Barcha_Abw")

}
shinyApp(ui = ui, server = server)