I have just started include bookmark functionality to my app. My app have a few selection inputs which do not seem to be restored and I couldnt figure out the problems.
The app has 2 key inputs:
At the current state, the app cant seem to restore the radio button (if I switch to duration, it just doesnt work)
The simplify code is below:
library(shiny)
library(data.table)
library(tidyverse)
library(lubridate)
library(shinydashboard)
library(zoo)
library(shinyWidgets)
library(nycflights13)
flight.dt <- flights %>% mutate(flight.date =ymd(substr(time_hour,1,10)),duration=round(air_time,-2))
### --------Analyse module ---------------------------
plotUI <- function(id) {
ns <- NS(id)
tagList(
uiOutput(ns("groupmenu")),
plotOutput(ns("plot"))
)
}
plotServer <- function(id,method,carr) {
moduleServer(
id,
function(input, output, session) {
filtered.data <- reactive(flight.dt %>% filter(carrier == carr))
output$groupmenu <- renderUI({
getselection <- if (method() != "duration") c("Year Quarter"="yearqtr") else c("Duration"="dur.grp")
rng.min <- switch (method(),
"date" = min(filtered.data()$flight.date),
"duration" = max(0,min(filtered.data()$duration,na.rm = TRUE)))
rng.max <- switch(method(),
"date" = max(filtered.data()$flight.date),
"duration" = max(0,max(filtered.data()$duration,na.rm = TRUE)))
ns <- session$ns
tagList(
fluidRow(
column(2,selectInput(ns("group"), "Group by:",choices =as.list(getselection))),
conditionalPanel("input.method == 'date'",
dateRangeInput(ns("daterange"),"Date range:",start = rng.min,end = rng.max,format = "dd/mm/yyyy", separator = " - ")),
conditionalPanel("input.method == 'duration'",
numericRangeInput(ns("durrange"), label = "Duration range:",value = c(rng.min,rng.max)))
)
)
})
dt <- reactiveVal(NULL)
observeEvent(input$group,{
tmp <- filtered.data() %>% mutate(sel.method = switch(method(),"date" = flight.date,"duration" = duration))
if (input$group == "yearqtr") {
tmp$key <- paste0(year(tmp$sel.method),"-Q",quarter(tmp$sel.method))
} else if (input$group == "dur.grp") {
tmp$key <- tmp$duration
}
dt(tmp)
})
dt.sum <- reactive({
req(dt())
setDT(dt())
if (method() == "date") {
tmp <- dt()[sel.method >= input$daterange[1] & sel.method <= input$daterange[2]]
} else if (method() == "duration") {
tmp <- dt()[key >= input$durrange[1] & key <= input$durrange[2]]
}
tmp %>% group_by(key) %>% dplyr::summarise(count=n())
})
output$plot <- renderPlot({
dt.sum() %>% ggplot(aes(x = as.character(key), y = count)) + geom_col()
})
}
)
}
### UI part -----------------------
header <- dashboardHeader(title = 'Analysis')
sidebar <- dashboardSidebar(
radioButtons("method", "Select method:",c("Date" = "date","Duration" = "duration"),selected = "date"),
bookmarkButton()
)
body <- dashboardBody(uiOutput('tablist'))
ui <- function(request) {
dashboardPage(title="Analysis", header,sidebar,body)
}
### Server part ----------------------------
server = function(input, output) {
method <- reactive(input$method)
carr <- reactive(unique(flight.dt$carrier)[1:3])
ntabs <- reactive(length(carr()))
observeEvent(ntabs(),{
lapply(1:ntabs(), function (i) plotServer(paste0("count",i),method,carr()[i]))
})
output$tablist = renderUI({
addtabs <- lapply(1:ntabs(),function (i) {
tabPanel(carr()[i],plotUI(paste0("count",i)))
})
do.call(tabsetPanel, addtabs)
})
}
### Running part ----------------------------
enableBookmarking("server")
shinyApp(ui, server)
Put your ui elements you want restored within ui function. See simplified example:
library(shiny)
library(shinydashboard)
### UI part -----------------------
ui <- function(request) {
header <- dashboardHeader(title = 'Analysis')
sidebar <- dashboardSidebar(
radioButtons("method", "Select method:",c("Date" = "date","Duration" = "duration"),selected = "date"),
bookmarkButton()
)
body <- dashboardBody("BODY")
dashboardPage(title="Analysis", header,sidebar,body)
}
### Server part ----------------------------
server = function(input, output) {
}
### Running part ----------------------------
enableBookmarking("server")
shinyApp(ui, server)