Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Storing state of the app as a bookmark #659

Closed
wants to merge 11 commits into from
Closed

Storing state of the app as a bookmark #659

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
28f0885
Make ui variable which has shinyUI insside a function with request as…
usr110 Mar 28, 2018
58606ee
Add a bookmark button without any label
usr110 Mar 28, 2018
38e8fdd
Change icon of bookmark button from link to bookmark
usr110 Mar 28, 2018
b7f7ec7
Enable bookmarking functionality which saves the state of the app on …
usr110 Mar 28, 2018
9494e03
Save state's region in a region var and restore it when session is re…
usr110 Mar 29, 2018
6da322f
Store and then restore map lat and lng along with zoom for state
usr110 Mar 29, 2018
7bb66c9
Merge remote-tracking branch 'origin/master' into bookmark
usr110 Apr 4, 2018
ef48e28
Use onRestored function to set the map's location after all observe b…
usr110 Apr 11, 2018
95c3b84
Move comments inside the function
usr110 Apr 11, 2018
0dd87b6
Remove additional checks for state_region. Relevant to https://github…
usr110 Apr 18, 2018
fdd151b
Dummy attempt at keeping URL short
nikolai-b Apr 18, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 59 additions & 7 deletions regions_www/m/server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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("..", "..")
Expand Down Expand Up @@ -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",
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I generally suggest saving API keys in the .Renviron file, as described here: https://csgillespie.github.io/efficientR/set-up.html#renviron in this case. Is there no issue with rate limits? Maybe no issue sharing this with the world in that case... Another compromise, in this case between the + of short urls and the + of reducing dependencies. In this case I'd lean slightly towards reducing dependencies although can understand the desire to keep URLs short.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nudge on this @nikolai-b - suggest not publicising the key in the code.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks for spotting @Robinlovelace ! Very late response sorry I just saw this. You can see the commit message is

Dummy attempt at keeping URL short

Appears wrong on link, exposes our API key

This API key was locked down to only work from pct.bike and I disabled a few days after posting it here (was just so others could try it) but it just shows what we could do...
Since then the whole goo shortner has been deprecated so to be completely clear this is not the approach I'd suggest it was just to show it was possible to hack the URL to make it shorter, I think using assignInNamespace is probably a bad idea!

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Never come across assignInMyNamespace. The standard way for users to handle API keys now is:

usethis::edit_r_environ()
# add new line like KEY=XYZ
# Restart R
Sys.getenv("KEY")

Would that approach work on the server (if we ever did want to use API keys)?

Late response to a late response!

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"
Expand Down Expand Up @@ -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 <- ""
Expand Down Expand Up @@ -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)){
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why we need to do both na and null checks? I get confused which to use in R...

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

null when it's not initialized - ran before the initialization of the region variable, and na when there is no saved state.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

what about

if (is.character(region$state_region)){
  region$current <- 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"
}
}
}

Expand Down Expand Up @@ -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
)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can this be done in onRestore?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No, it can't be done there. onRestore runs before any observe block is executed - since leaflet variable hasn't been initialized, this can't work.
I now have moved this block to the onRestored function which is run after all observe blocks are executed.

})


# 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")
Expand Down Expand Up @@ -1091,4 +1142,5 @@ shinyServer(function(input, output, session) {

includeHTML(file.path("..", "..", "non_www", "tabs", input_purpose(), "download_national.html"))
})

})
267 changes: 137 additions & 130 deletions regions_www/m/ui.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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&#8230;"),
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&#8230;"),
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")))
)
)
)
}