diff --git a/regions_www/m/server.R b/regions_www/m/server.R index 212339fc..3d6ce05d 100644 --- a/regions_www/m/server.R +++ b/regions_www/m/server.R @@ -22,9 +22,11 @@ ## Functions source("pct_shiny_funs.R", local = T) +enableBookmarking(store = "url") + ## Packages (Only regularly used packages are loaded into the global space, the others must be installed but are used with the package prefix, e.g. DT::) available_locally_pkgs <- c("shiny", "leaflet", "sp") -must_be_installed_pkgs <- c("rgdal", "rgeos", "shinyjs") +must_be_installed_pkgs <- c("rgdal", "rgeos", "shinyjs", "httr") ## Path directories to load data (expect regional data as a sibling of interface_root) interface_root <- file.path("..", "..") @@ -76,12 +78,41 @@ lsoa_legend_df <- data.frame( labels = c("1-9", "10-49", "50-99", "100-249", "250-499", "500-999", "1000-1999", "2000+") ) +oldEncodeShinySaveState <- getFromNamespace("encodeShinySaveState", "shiny") + +shortEncodeShinySaveState <- function(state){ + res <- oldEncodeShinySaveState(state) + r <- httr::POST( + "https://www.googleapis.com/urlshortener/v1/url?key=AIzaSyBLGLnQojQm2WQu9Urri2mmVTQolrLuJBc", + body = list(longUrl = paste0("http://www.pct.bike/?", res)), encode = "json" + ) + return(httr::content(r)$id) +} +assignInNamespace("encodeShinySaveState", shortEncodeShinySaveState, ns="shiny") # # # # # # # # # shinyServer # # # # # # # # # shinyServer(function(input, output, session) { + # Save current region in a state variable + onBookmark(function(state) { + state$values$current_region <- region$current + }) + + + onRestore(function(state) { + # Restore state's region into a region variable + region$state_region <- state$values$current_region + # Restore map's location and zoom + region$state_lng <- state$input$map_center$lng + region$state_lat <- state$input$map_center$lat + region$state_mzoom <- state$input$map_zoom + + + }) + + input_purpose <- reactive({ if(is.null(input$purpose)) { "commute" @@ -222,7 +253,8 @@ shinyServer(function(input, output, session) { ############## ## Create region, to_plot and (for persistent geographical values) helper - region <- reactiveValues(current = NA, data_dir = NA, geography = NA, repopulate_region = F, purposes_present = NA) + region <- reactiveValues(current = NA, data_dir = NA, geography = NA, repopulate_region = F, purposes_present = NA, + state_region = NA, state_lat = NA, state_lng = NA, state_mzoom = NA) to_plot <- NULL helper <- NULL helper$e_lat_lng <- "" @@ -252,11 +284,18 @@ shinyServer(function(input, output, session) { # Identify region from URL or use a default if (is.na(region$current)) { - query <- parseQueryString(session$clientData$url_search) - region$current <- if (isTRUE(query[['r']] %in% regions$region_name)) { - query[['r']] - } else { - "isle-of-wight" + + if(!is.null(region$state_region) && !is.na(region$state_region)){ + # Restor's state_region to region's current var + region$current <- region$state_region + } + else{ + query <- parseQueryString(session$clientData$url_search) + region$current <- if (isTRUE(query[['r']] %in% regions$region_name)) { + query[['r']] + } else { + "isle-of-wight" + } } } @@ -359,6 +398,18 @@ shinyServer(function(input, output, session) { }, priority = 3) + # Once all the variables have been initialized - all observe blocks have run, reset the map view + # (including zoom from the saved state of the app) + onRestored(function(state) { + + leafletProxy("map") %>% setView(., + lng = region$state_lng, + lat = region$state_lat, + zoom = region$state_mzoom + ) + }) + + # Only requred to run if the region changes (as that affects purpose) or the purpose changes (as that affects geographies) observe({ shinyjs::showElement(id = "loading") @@ -1091,4 +1142,5 @@ shinyServer(function(input, output, session) { includeHTML(file.path("..", "..", "non_www", "tabs", input_purpose(), "download_national.html")) }) + }) diff --git a/regions_www/m/ui.R b/regions_www/m/ui.R index 9135cc56..a01eb57c 100644 --- a/regions_www/m/ui.R +++ b/regions_www/m/ui.R @@ -61,147 +61,154 @@ map_base_attrs <- c( on_server <- grepl('^/var/shiny/pct-shiny', getwd()) production_branch <- grepl("npt\\d*$", Sys.info()["nodename"]) -shinyUI( - navbarPage( - title = "Propensity to Cycle Tool", - id = "nav", - tabPanel( - "Map", - useShinyjs(), - div( - class = "outer", - tags$head( - if(on_server) includeScript("../www/assets/google-analytics.js"), - includeScript("../www/assets/extra.js"), - includeCSS("../www/stylesheet.css"), - includeHTML(file.path("..", "favicon.html")) - ), - includeHTML(file.path("..", "www", "test-banner.html")), - br(), - div(id="loading", "Loading…"), - leafletOutput("map", width = "100%", height = "95%"), - absolutePanel( - id = "controls", - class = "panel panel-default", - fixed = TRUE, - top = 110, - right = 20, - width = 180, - height = "auto", - style = "opacity: 0.9", - tags$div(title = "Show/Hide Panel", - a( - id = "toggle_panel", - style = "font-size: 80%", - span(class = "glyphicon glyphicon-circle-arrow-up", "Hide") - )), - div( - id = "input_panel", - if (!production_branch) { - tags$div(title = "Trip purpose:", - selectInput("purpose", "Trip purpose:", purposes, selectize = F)) - }, - tags$div(title = "Geography:", +ui <- function(request){ + shinyUI( + navbarPage( + title = "Propensity to Cycle Tool", + id = "nav", + tabPanel( + "Map", + useShinyjs(), + div( + class = "outer", + tags$head( + if(on_server) includeScript("../www/assets/google-analytics.js"), + includeScript("../www/assets/extra.js"), + includeCSS("../www/stylesheet.css"), + includeHTML(file.path("..", "favicon.html")) + ), + includeHTML(file.path("..", "www", "test-banner.html")), + br(), + div(id="loading", "Loading…"), + leafletOutput("map", width = "100%", height = "95%"), + absolutePanel( + id = "controls", + class = "panel panel-default", + fixed = TRUE, + top = 110, + right = 20, + width = 180, + height = "auto", + style = "opacity: 0.9", + tags$div(title = "Show/Hide Panel", + a( + id = "toggle_panel", + style = "font-size: 80%", + span(class = "glyphicon glyphicon-circle-arrow-up", "Hide") + )), + div( + id = "input_panel", + if (!production_branch) { + tags$div(title = "Trip purpose:", + selectInput("purpose", "Trip purpose:", purposes, selectize = F)) + }, + tags$div(title = "Geography:", selectInput("geography", "Geography:", geographies, selectize = F) - ), - tags$div( - title = "Scenario (see manual)", - selectInput("scenario", "Scenario:", scenarios, selectize = F) - ), - tags$div( - title = "Shows the cycling flow between the centres of zones", - selectInput( - "line_type", - "Cycling Flows:", - line_types, - selected = "none", - selectize = F - ) - ), - tags$div(title = "Shows the cycling flow between the centres of zones", - checkboxInput("show_zones", "Show Zones", value = T)), - - conditionalPanel( - condition = "input.line_type != 'none' && input.line_type != 'lsoa_base_map' && input.line_type != 'route_network'", - tags$div(title = "Untick to update lines when you move the map", - checkboxInput("freeze", "Freeze Lines", value = F)) - ), - conditionalPanel( - condition = "input.line_type != 'none' && input.line_type != 'lsoa_base_map'", + ), tags$div( - title = "Number of lines to show", - sliderInput( - "nos_lines", - label = "Top N Lines (most cycled)", - 1, - 200, - value = 30, - ticks = F + title = "Scenario (see manual)", + selectInput("scenario", "Scenario:", scenarios, selectize = F) + ), + tags$div( + title = "Shows the cycling flow between the centres of zones", + selectInput( + "line_type", + "Cycling Flows:", + line_types, + selected = "none", + selectize = F ) ), + tags$div(title = "Shows the cycling flow between the centres of zones", + checkboxInput("show_zones", "Show Zones", value = T)), + + conditionalPanel( + condition = "input.line_type != 'none' && input.line_type != 'lsoa_base_map' && input.line_type != 'route_network'", + tags$div(title = "Untick to update lines when you move the map", + checkboxInput("freeze", "Freeze Lines", value = F)) + ), conditionalPanel( - condition = "input.line_type != 'route_network' && input.scenario != 'olc'", + condition = "input.line_type != 'none' && input.line_type != 'lsoa_base_map'", tags$div( - title = "Order the top flows by", - selectInput( - "line_order", - "Order lines by", - line_order, - selected = "slc", - selectize = F + title = "Number of lines to show", + sliderInput( + "nos_lines", + label = "Top N Lines (most cycled)", + 1, + 200, + value = 30, + ticks = F + ) + ), + conditionalPanel( + condition = "input.line_type != 'route_network' && input.scenario != 'olc'", + tags$div( + title = "Order the top flows by", + selectInput( + "line_order", + "Order lines by", + line_order, + selected = "slc", + selectize = F + ) ) ) + ), + tags$div( + title = "Change base of the map", + selectInput("map_base", "Map Base:", map_base_attrs, selectize = F) + ), + tags$div( + bookmarkButton(label = "", icon = shiny::icon("bookmark", lib ="glyphicon"), + title = "Bookmark this application's state and get a URL for sharing.", + id = "._bookmark_") ) - ), - tags$div( - title = "Change base of the map", - selectInput("map_base", "Map Base:", map_base_attrs, selectize = F) ) - ) - ), - conditionalPanel( - condition = "input.map_base == 'IMD'", - absolutePanel( - cursor = "auto", - id = "legend", - class = "panel panel-default", - bottom = 235, - left = 5, - height = 20, - width = 225, - draggable = TRUE, - style = "opacity: 0.7", - tags$div( - title = "Show/Hide map legend", - a( - id = "toggle_imd_legend", - style = "font-size: 80%", - span(class = "glyphicon glyphicon-circle-arrow-up", "Hide") + ), + conditionalPanel( + condition = "input.map_base == 'IMD'", + absolutePanel( + cursor = "auto", + id = "legend", + class = "panel panel-default", + bottom = 235, + left = 5, + height = 20, + width = 225, + draggable = TRUE, + style = "opacity: 0.7", + tags$div( + title = "Show/Hide map legend", + a( + id = "toggle_imd_legend", + style = "font-size: 80%", + span(class = "glyphicon glyphicon-circle-arrow-up", "Hide") + ) + ), + div( + id = "imd_legend", + tags$div(title = "Index of Multiple Deprivation", + plotOutput( + "imd_legend", width = "100%", height = 180 + )) ) - ), - div( - id = "imd_legend", - tags$div(title = "Index of Multiple Deprivation", - plotOutput( - "imd_legend", width = "100%", height = 180 - )) ) - ) - ), - tags$div(id = "cite", - htmlOutput("cite_html")) - ) - ), + ), + tags$div(id = "cite", + htmlOutput("cite_html")) + ) + ), - tabPanel("Region stats", - htmlOutput("region_stats")), - tabPanel("Region data", - htmlOutput("download_region_current")), - tabPanel("National data", - htmlOutput("download_national_current")), - tabPanel("Manual", - includeHTML(file.path("../tabs/manual_body.html"))), - tabPanel("About", - includeHTML(file.path("../tabs/about_body.html"))) + tabPanel("Region stats", + htmlOutput("region_stats")), + tabPanel("Region data", + htmlOutput("download_region_current")), + tabPanel("National data", + htmlOutput("download_national_current")), + tabPanel("Manual", + includeHTML(file.path("../tabs/manual_body.html"))), + tabPanel("About", + includeHTML(file.path("../tabs/about_body.html"))) + ) ) -) +}