R Shiny ggvis reagiert nicht auf dynamischen Eingang

Question

Ich versuche, ein glänzendes Armaturenbrett mit ggvis barcharts zu bauen. Die Idee besteht darin, Barcharts mit Top-10-Kosten für einen bestimmten Monat eines Jahres anzuzeigen. Der Benutzer kann ein Jahr und einen Monat wählen. Die Auswahl der Monate hängt vom gewählten Jahr ab, so dass bei der Wahl 2016 nur die bisherigen Monate ausgewählt werden können.

Irgendwie kann ich den Wert des dynamischen Eingabefeldes nicht an das Balkendiagramm übergeben. Es funktioniert zwar, solange beide Eingabefelder statisch sind (der Input $ month1 mit dem Input $ montest in den ersten Zeilen des Server-Scripts zeigt Ihnen, wie es aussehen soll). Ich habe alles versucht, was mir einfällt, indem ich den Eingabemonat isoliere(), statt beobacht() statt reaktiv().

Der zurückgegebene Fehler ist: Warnung: Fehler in Eval: falsche Länge (0), erwartet: 12; d. h. irgendwie wird der Wert im dynamischen Feld nicht an die reaktive Umgebung weitergegeben

Vielen Dank im Voraus! Hier

ist ein „minimal“ Arbeitsbeispiel nahe genug an, was meine eigentliche Armaturenbrett aussieht:

#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

ich eine Deutsch-Version der Frage hatte. Für die Dokumentation Zweck (und wenn jemand neugierig auf die Antwort lautet:

#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)