R Shiny ggvis не реагирует на динамический ввод
Я пытаюсь построить блестящую приборную панель с ggvis barcharts. Идея состоит в том, чтобы отображать столбцы с 10 лучшими ценами за определенный месяц в году. Пользователь может выбрать год и месяц. Выбор месяцев зависит от выбранного года, поэтому при выборе 2016 года можно выбрать только месяцы на дату.
Почему-то я не могу передать значение динамического поля ввода в виде диаграммы. Хотя это работает до тех пор, пока оба поля ввода статичны (обмен ввода $month1 с input$monthtest в первых строках серверного скрипта покажет вам, как он должен выглядеть). Я пробовал все, что я могу придумать: от isolating() входного месяца до использования наблюдаем () вместо реактивного ().
Возвращенная ошибка: Предупреждение: Ошибка в 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)
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)