Reputation: 1389
I want to render shiny plots on launch and then require clicking the action button to re-render. I tried to simplify my app to post here. As you can, see changing the "week" selection triggers a refresh. how do I suppress all refreshes unless action Is clicked?
library(shiny); library(dplyr); library(ggplot2)
#toy data
dates= seq.Date(as.Date("2020-01-01"),as.Date("2020-05-01"),by="days")
set.seed(1)
data = data.frame(date = dates,val = runif(length(dates),50,150))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("group","Group",choices = LETTERS[1:3]),
dateRangeInput('dateRangeCal', "Input date range"),
selectInput("week","shift week",choices = c(0:3)),
actionButton("action","Submit")
),
mainPanel(
plotOutput(outputId = "plot")
)
)
)
server <- function(input, output,session) {
observeEvent( input$action, {
startDate = as.Date("2020-01-01")+days(case_when(
input$group == "A" ~ 0,
input$group == "B" ~ 30,
input$group == "C" ~ 60
))
endDate=startDate+days(60)
updateDateRangeInput(session = session,
inputId = 'dateRangeCal',
label = 'Date range input:',
start = startDate,
end = endDate
)
},ignoreNULL = F)
output$plot <- renderPlot({
p = data %>%
filter(date>=input$dateRangeCal[1]+days(input$week)*7,date<=input$dateRangeCal[2]) %>%
ggplot(.,aes(x=date,y=val))+
geom_line()
p
})
}
shinyApp(ui, server)
Upvotes: 2
Views: 2379
Reputation: 29387
Would this work?
library(shiny); library(dplyr); library(ggplot2); library(lubridate)
#toy data
dates= seq.Date(as.Date("2020-01-01"),as.Date("2020-05-01"),by="days")
set.seed(1)
data = data.frame(date = dates,val = runif(length(dates),50,150))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("group","Group",choices = LETTERS[1:3]),
dateRangeInput('dateRangeCal', "Input date range"),
selectInput("week","shift week",choices = c(0:3)),
actionButton("action","Submit")
),
mainPanel(
plotOutput(outputId = "plot")
)
)
)
server <- function(input, output,session) {
observeEvent(input$action, {
grp <- isolate(input$group)
startDate = as.Date("2020-01-01")+days(case_when(
grp == "A" ~ 0,
grp == "B" ~ 30,
grp == "C" ~ 60
))
endDate=startDate+days(60)
updateDateRangeInput(session = session,
inputId = 'dateRangeCal',
label = 'Date range input:',
start = startDate,
end = endDate
)
},ignoreNULL = F)
output$plot <- renderPlot({
input$action
rangecal <- isolate(input$dateRangeCal)
p = data %>%
filter(date>=rangecal[1]+days(isolate(input$week))*7,date<=rangecal[2]) %>%
ggplot(.,aes(x=date,y=val))+
geom_line()
p
})
}
shinyApp(ui, server)
Upvotes: 1
Reputation: 84529
That should do it:
server <- function(input, output,session) {
week <- reactiveVal()
observeEvent( input$action, {
week(input$week)
startDate = as.Date("2020-01-01")+days(case_when(
input$group == "A" ~ 0,
input$group == "B" ~ 30,
input$group == "C" ~ 60
))
endDate=startDate+days(60)
updateDateRangeInput(session = session,
inputId = 'dateRangeCal',
label = 'Date range input:',
start = startDate,
end = endDate
)
},ignoreNULL = F)
output$plot <- renderPlot({
p = data %>%
filter(date>=input$dateRangeCal[1]+days(week())*7,date<=input$dateRangeCal[2]) %>%
ggplot(.,aes(x=date,y=val))+
geom_line()
p
})
}
Upvotes: 1