R Shiny ggvis不會對動態輸入做出反應

Question

我嘗試使用ggvis barcharts構建閃亮的儀表板。這個想法是在一年的特定月份裏顯示十大成本的barcharts。用戶可以選擇一年和一個月。月份的選擇取決於所選年份，因此如果選擇2016年，只能選擇迄今爲止的月份。

不知何故，我無法將動態輸入字段的值傳遞給條形圖。儘管只要兩個輸入字段都是靜態的，它就會工作（在服務器腳本的第一行中將輸入$ month1與輸入$ monthtest交換，顯示它應該是什麼樣子）。我已經嘗試了從隔離（）輸入月份到使用observe（）而不是reactive（）的所有可以想到的事情。

返回的錯誤是：警告：在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)