selectInput only outputs first option - r

Question

I am writing a shiny app to manipulate daily percentage distributions of call arrivals per interval via drag and drop.
I am trying to display one day only via selectInput.
However, the DataTable Output and Plot Output do not change when I select another day than Monday (first option in selectInput), i.e., the outputs (datatable and plotly) only display Monday regardless of what I am selecting via selectInput.
Appreciate your help! Thank you in advance!
Dummy data:
save_name2 <- paste("Percentage_Forecasts.csv")
df_MON<-data.frame(b=c("MON 07:00","MON 07:30","MON 08:00","MON 08:30","MON 09:00","MON 09:30","MON 10:00"),a=c(15,20,14,6,10,15,20))
df_TUE<-data.frame(b=c("TUE 07:00","TUE 07:30","TUE 08:00","TUE 08:30","TUE 09:00","TUE 09:30","TUE 10:00"),a=c(15,20,14,6,10,15,20))
df_WED<-data.frame(b=c("WED 07:00","WED 07:30","WED 08:00","WED 08:30","WED 09:00","WED 09:30","WED 10:00"),a=c(15,20,14,6,10,15,20))
df_THU<-data.frame(b=c("THU 07:00","THU 07:30","THU 08:00","THU 08:30","THU 09:00","THU 09:30","THU 10:00"),a=c(15,20,14,6,10,15,20))
df_FRI<-data.frame(b=c("FRI 07:00","FRI 07:30","FRI 08:00","FRI 08:30","FRI 09:00","FRI 09:30","FRI 10:00"),a=c(15,20,14,6,10,15,20))
df_SAT<-data.frame(b=c("SAT 07:00","SAT 07:30","SAT 08:00","SAT 08:30","SAT 09:00","SAT 09:30","SAT 10:00"),a=c(15,20,14,6,10,15,20))
Here is my ui.R:
ui <- fluidPage( titlePanel("Prozentuale Verteilung Prognosewoche"),
fluidRow(
column(selectInput(inputId = "dataset",
label = "Choose a weekday",
choices = c("MON", "TUE","WED","THU","FRI","SAT")),
DTOutput("table"),width = 5,downloadButton("downloadData", "Save")),
column(12, plotlyOutput("p"))))
Here is my server.R:
server <- function(input, output, session) {
#i think here is where the problem starts!
datasetInput <- reactive({
switch(input$dataset,
"MON" = df_MON,
"TUE" = df_TUE,
"WED" = df_WED,
"THU" = df_THU,
"FRI" = df_FRI,
"SAT" = df_SAT)
})
rv <- reactiveValues(
x = isolate(datasetInput())$b,
y = isolate(datasetInput())$a)
grid <- reactive({
data.frame(y = rv$y, length=180)})
output$p <- renderPlotly({
circles <- map2(rv$x,
rv$y,
~list(
type = "circle",
xanchor = .x,
yanchor = .y,
x0 = -4, x1 = 4,
y0 = -4, y1 = 4,
xsizemode = "pixel",
ysizemode = "pixel",
# other visual properties
fillcolor = "orange",
line = list(color = "transparent") ) )
plot_ly(grid(), type="scatter", mode='lines+markers', width = 1200, height = 300) %>%
add_trace(y = grid()$y, x = isolate(datasetInput())$b,mode='lines+markers') %>%
layout(shapes = circles) %>%
config(edits = list(shapePosition = TRUE))
})
output$table <-renderDT(rbind({data.frame(rv$x,rv$y)}, c(NULL,sum(rv$y))),colnames=c("Weekday/Time", "Percentage"),width = 800,options = list(
lengthMenu = list(c(15,31), list('15','31')),
pageLength = 15, initComplete = JS(
"function(settings, json) {",
"$(this.api().table().body()).css({'font-size': '70%'});",
"}")
))
observe({
ed <- event_data("plotly_relayout")
shape_anchors <- ed[grepl("^shapes.*anchor$", names(ed))]
if (length(shape_anchors) != 2) return()
row_index <- unique(readr::parse_number(names(shape_anchors)) + 1)
pts <- as.numeric(shape_anchors)
rv$y[row_index] <- pts[2]
})
output$downloadData <- downloadHandler(
filename = function(){save_name2},
content = function(fname){
write.table(data.frame(rv$x,rv$y), row.names=FALSE, sep=";", fname,col.names=c("Weekday/Calendar Week","Percentage"))
})
}
shinyApp(ui, server)

Answer 1

I edited these parts and removed the isolate's:
rv <- reactiveValues()
observe({
rv$x = datasetInput()$b
rv$y = datasetInput()$a
})
and
add_trace(y = grid()$y, x = rv$x,mode='lines+markers')
Full server code:
server <- function(input, output, session) {
#i think here is where the problem starts!
datasetInput <- reactive({
switch(input$dataset,
"MON" = df_MON,
"TUE" = df_TUE,
"WED" = df_WED,
"THU" = df_THU,
"FRI" = df_FRI,
"SAT" = df_SAT)
})
rv <- reactiveValues()
observe({
rv$x = datasetInput()$b
rv$y = datasetInput()$a
})
grid <- reactive({
data.frame(y = rv$y, length=180)})
output$p <- renderPlotly({
circles <- map2(rv$x,
rv$y,
~list(
type = "circle",
xanchor = .x,
yanchor = .y,
x0 = -4, x1 = 4,
y0 = -4, y1 = 4,
xsizemode = "pixel",
ysizemode = "pixel",
# other visual properties
fillcolor = "orange",
line = list(color = "transparent") ) )
plot_ly(grid(), type="scatter", mode='lines+markers', width = 1200, height = 300) %>%
add_trace(y = grid()$y, x = rv$x,mode='lines+markers') %>%
layout(shapes = circles) %>%
config(edits = list(shapePosition = TRUE))
})
output$table <-renderDT(rbind({data.frame(rv$x,rv$y)}, c(NULL,sum(rv$y))),colnames=c("Weekday/Time", "Percentage"),width = 800,options = list(
lengthMenu = list(c(15,31), list('15','31')),
pageLength = 15, initComplete = JS(
"function(settings, json) {",
"$(this.api().table().body()).css({'font-size': '70%'});",
"}")
))
observe({
ed <- event_data("plotly_relayout")
shape_anchors <- ed[grepl("^shapes.*anchor$", names(ed))]
if (length(shape_anchors) != 2) return()
row_index <- unique(readr::parse_number(names(shape_anchors)) + 1)
pts <- as.numeric(shape_anchors)
rv$y[row_index] <- pts[2]
})
output$downloadData <- downloadHandler(
filename = function(){save_name2},
content = function(fname){
write.table(data.frame(rv$x,rv$y), row.names=FALSE, sep=";", fname,col.names=c("Weekday/Calendar Week","Percentage"))
})
}
shinyApp(ui, server)