Skip to content

Commit 3f4f02e

Browse files
RWParsonsRWParsons
committed
lazy load tour map and add aria layer
1 parent 9200f85 commit 3f4f02e

File tree

5 files changed

+140
-22
lines changed

5 files changed

+140
-22
lines changed

‎2_pallettes.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,3 +31,5 @@ palNum <- function(x){
3131
palNum_hours <- function(x){
3232
palNum(x*60)
3333
}
34+
35+
palFac <- colorFactor("Greens", levels=ra_scale_to_text(0:4), ordered = TRUE, reverse=TRUE)

‎3_load_data.R‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,3 +42,8 @@ polygons <-
4242
left_join(., groupings, by=c("ra", "seifa_quintile"="seifa", "SA_level"="sa", "care_type"))
4343

4444
rmarkdown::render("input/iTRAQI_info.md")
45+
46+
aria <-
47+
polygons %>%
48+
filter(SA_level==1, care_type=="acute") %>%
49+
mutate(ra_label=factor(ra_scale_to_text(ra), levels=ra_scale_to_text(0:4)))

‎4_tour.R‎

Lines changed: 39 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,43 @@
11
tour_text <- list(
2-
c("text 1"),
3-
c("text 2"),
4-
c("text 3"),
5-
c("text 5"),
6-
c("text 6")
2+
"<h3>tour-1-title text</h3><br>This tour will show you around the iTRAQI map and highlight some of the main findings. Use the 'Next' and 'Back' buttons to go progress through the tour.",
3+
4+
"<h3>tour-2-title text</h3><br>For many injuries time to treatment plays a large role on survival and recovery. Quick access to [[correct]] healthcare facilities can provide patients with a better [[chance]] of a full recovery. But some injuries also require extensive rehabilitation and access to these facilities can be hindered by location. Current methods in determining accessibility and remoteness use [[indexes]] like ARIA+ which use broad generalisations and does not specifically consider access to health care. ",
5+
6+
"<h3>tour-3-title text</h3><br>It also has a population distribution throughout a number of large major cities as well as big rural and remote population base ranging from the Simpson desert on the western border to the isolated islands of the Torres Strait.",
7+
8+
"<h3>tour-4-title text</h3><br>text 4",
9+
10+
"<h3>tour-5-title text</h3><br>text 5"
711
)
812

913
n_tour_windows <- length(tour_text)
14+
15+
tab_ids <- list(
16+
"tab1" = c(),
17+
"tab2" = c("aria", "ariaLegend"),
18+
"tab3" = c("Towns"),
19+
"tab4" = c(),
20+
"tab5" = c(),
21+
"tab6" = c()
22+
)
23+
24+
tab_legend_ids <- list(
25+
"tab1" = c(),
26+
"tab2" = c("ariaLegend"),
27+
"tab3" = c(),
28+
"tab4" = c(),
29+
"tab5" = c(),
30+
"tab6" = c()
31+
)
32+
33+
tab_legends <- list(
34+
"ariaLegend" = function(x) {addLegendFactor(
35+
x,
36+
pal=palFac,
37+
values=unique(aria$ra_label),
38+
layerId="ariaLegend"
39+
)}
40+
)
41+
42+
unique_legend_ids <- unique(unlist(tab_legend_ids))
43+
unique_ids <- unique(unlist(tab_ids))

‎server.R‎

Lines changed: 93 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -2,22 +2,11 @@ library(leaflet)
22
library(dplyr)
33

44
function(input, output, session) {
5-
rvs <- reactiveValues(to_load=NULL, map=NULL, to_load_rehab=NULL, map_rehab=NULL, map_complete=FALSE, map_rehab_complete=FALSE, map_tour=NULL, tour_tab=1)
6-
7-
output$map_tour <- renderLeaflet({
8-
rvs$map_tour <-
9-
leaflet(options=leafletOptions(minZoom=5)) %>%
10-
setMaxBounds(lng1 = 115, lat1 = -45.00, lng2 = 170, lat2 = -5) %>%
11-
addSearchOSM(options=searchOptions(moveToLocation=FALSE, zoom=NULL)) %>%
12-
addMapPane(name = "layers", zIndex = 200) %>%
13-
addMapPane(name = "maplabels", zIndex = 400) %>%
14-
addMapPane(name = "markers", zIndex = 205) %>%
15-
addProviderTiles("CartoDB.VoyagerNoLabels") %>%
16-
addProviderTiles("CartoDB.VoyagerOnlyLabels",
17-
options = leafletOptions(pane = "maplabels"),
18-
group = "map labels")
19-
rvs$map_tour
20-
})
5+
rvs <- reactiveValues(
6+
to_load=NULL, map=NULL, map_complete=FALSE,
7+
to_load_rehab=NULL, map_rehab=NULL, map_rehab_complete=FALSE,
8+
to_load_tour=NULL, map_tour=NULL, map_tour_complete=FALSE, tour_tab=1
9+
)
2110

2211
output$nextButtonControl <- renderUI({
2312
if(rvs$tour_tab != n_tour_windows) actionButton("nextButton", "Next") else NULL
@@ -39,6 +28,89 @@ function(input, output, session) {
3928
HTML(tour_text[[rvs$tour_tab]])
4029
})
4130

31+
output$map_tour <- renderLeaflet({
32+
rvs$map_tour <-
33+
leaflet(options=leafletOptions(minZoom=5)) %>%
34+
setMaxBounds(lng1 = 115, lat1 = -45.00, lng2 = 170, lat2 = -5) %>%
35+
addSearchOSM(options=searchOptions(moveToLocation=FALSE, zoom=NULL)) %>%
36+
addMapPane(name = "layers", zIndex = 200) %>%
37+
addMapPane(name = "maplabels", zIndex = 400) %>%
38+
addMapPane(name = "markers", zIndex = 205) %>%
39+
addProviderTiles("CartoDB.VoyagerNoLabels") %>%
40+
addProviderTiles("CartoDB.VoyagerOnlyLabels",
41+
options = leafletOptions(pane = "maplabels"),
42+
group = "map labels")
43+
rvs$map_tour
44+
})
45+
46+
observeEvent(rvs$to_load_tour,{
47+
if(is.null(isolate(rvs$map_tour)) | isolate(rvs$map_tour_complete))return()
48+
49+
leafletProxy("map_tour") %>%
50+
hideGroup(unique_ids) %>%
51+
addCircleMarkers(
52+
lng=df_locations$x, lat=df_locations$y,
53+
radius=2, fillOpacity=0,
54+
popup=df_locations$popup,
55+
group="Towns"
56+
) %>%
57+
addPolygons(
58+
data=aria,
59+
fillColor=~palFac(aria$ra_label),
60+
color="black",
61+
fillOpacity=1,
62+
weight=1,
63+
group="aria",
64+
options=leafletOptions(pane="layers")
65+
)
66+
67+
if(!isolate(rvs$map_tour_complete)) rvs$map_tour_complete <- TRUE
68+
})
69+
70+
observeEvent(rvs$tour_tab, {
71+
hide_groups <- unique_ids
72+
show_groups <- unique_ids
73+
74+
tab_num <- paste0("tab", rvs$tour_tab)
75+
desired_groups <- tab_ids[[tab_num]]
76+
if(is.null(desired_groups)) desired_groups <- c()
77+
hide_groups <- unique_ids[!unique_ids %in% desired_groups]
78+
show_groups <- desired_groups
79+
80+
desired_legend <- tab_legend_ids[[tab_num]]
81+
hide_legend_id <- unique_legend_ids[!unique_legend_ids %in% desired_legend]
82+
if(!is.null(desired_legend)){
83+
show_legend_fx <- tab_legends[[desired_legend]]
84+
} else{
85+
show_legend_fx <- function(x) {x}
86+
}
87+
88+
show_hide_layers_and_legends <- function(map) {
89+
map %>%
90+
hideGroup(hide_groups) %>%
91+
showGroup(show_groups) %>%
92+
show_legend_fx %>%
93+
removeControl(layerId=hide_legend_id)
94+
}
95+
96+
if(rvs$tour_tab == 1){
97+
leafletProxy("map_tour") %>%
98+
show_hide_layers_and_legends()
99+
} else if(rvs$tour_tab == 2){
100+
leafletProxy("map_tour") %>%
101+
show_hide_layers_and_legends()
102+
} else if(rvs$tour_tab == 3){
103+
leafletProxy("map_tour") %>%
104+
show_hide_layers_and_legends() %>%
105+
setView(lng=152, lat=-27, zoom=7)
106+
} else {
107+
leafletProxy("map_tour") %>%
108+
show_hide_layers_and_legends()
109+
}
110+
111+
112+
})
113+
42114
output$map <- renderLeaflet({
43115
rvs$map <-
44116
leaflet(options=leafletOptions(minZoom=5)) %>%
@@ -244,6 +316,7 @@ function(input, output, session) {
244316
f <- function(){
245317
if(is.null(isolate(rvs$to_load))) rvs$to_load <- 1
246318
if(is.null(isolate(rvs$to_load_rehab))) rvs$to_load_rehab <- 1
319+
if(is.null(isolate(rvs$to_load_tour))) rvs$to_load_tour <- 1
247320

248321
if(!is.null(isolate(rvs$to_load)) & !isolate(rvs$map_complete) & !is.null(isolate(rvs$map))){
249322
rvs$to_load <- isolate(rvs$to_load) + 1
@@ -252,6 +325,10 @@ function(input, output, session) {
252325
if(!is.null(isolate(rvs$to_load_rehab)) & !isolate(rvs$map_rehab_complete) & !is.null(isolate(rvs$map_rehab))){
253326
rvs$to_load_rehab <- isolate(rvs$to_load_rehab) + 1
254327
}
328+
329+
if(!is.null(isolate(rvs$to_load_tour)) & !isolate(rvs$map_tour_complete) & !is.null(isolate(rvs$map_tour))){
330+
rvs$to_load_tour <- isolate(rvs$to_load_tour) + 1
331+
}
255332
}
256333
session$onFlushed(f, once=FALSE)
257334

‎ui.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ navbarPage(
2525
"iTRAQI", id="nav",
2626

2727
tabPanel(
28-
"tour",
28+
"Tour",
2929
div(class="outer",
3030
tags$head(
3131
includeCSS("styles.css")

0 commit comments

Comments
 (0)