Browse Source

Fully working commute type map

Petra Lamborn 3 years ago
parent
commit
b92916c37f
1 changed files with 46 additions and 20 deletions
  1. 46
    20
      viz/app.R

+ 46
- 20
viz/app.R View File

21
   mutate(sa2_code = as.numeric(as.character(SA22018_V1))) %>% 
21
   mutate(sa2_code = as.numeric(as.character(SA22018_V1))) %>% 
22
   select(sa2_code)
22
   select(sa2_code)
23
 
23
 
24
-startcols <- codelist %>% left_join(work_from, by = c("sa2_code" = "res_code"))
25
-startcols <- tencols[startcols$MAX]
26
-startcols <- ifelse(is.na(startcols), "#808080", startcols)
24
+startcols.res <- codelist %>% left_join(work_from, by = c("sa2_code" = "res_code"))
25
+startcols.res <- tencols[startcols.res$MAX]
26
+startcols.res <- ifelse(is.na(startcols.res), "#808080", startcols.res)
27
+startcols.work <- codelist %>% left_join(work_to, by = c("sa2_code" = "work_code"))
28
+startcols.work <- tencols[startcols.work$MAX]
29
+startcols.work <- ifelse(is.na(startcols.work), "#808080", startcols.work)
27
 
30
 
28
 
31
 
29
 # Define UI
32
 # Define UI
64
   }"),
67
   }"),
65
   leafletOutput("map"),
68
   leafletOutput("map"),
66
   absolutePanel(top = 10, right = 10, id="mapcontrol",
69
   absolutePanel(top = 10, right = 10, id="mapcontrol",
67
-                radioButtons("radioinout", label=NULL,
70
+                radioButtons("radioinout", label="Show commuters who",
68
                              choices = c(
71
                              choices = c(
69
-                               "Work in" = "work",
70
-                               "Live in" = "res"
72
+                               "Live in area" = "res",
73
+                               "Work in area" = "work"
71
                                ),
74
                                ),
72
-                             inline = TRUE),
75
+                             inline = FALSE),
76
+                radioButtons("radiocolour",
77
+                             label = "Colour by",
78
+                             choices = c(
79
+                               "Transport type" = "type",
80
+                               "Number of commuters" = "number"
81
+                             ),
82
+                             inline = FALSE),
73
                 div(id="locinfo",
83
                 div(id="locinfo",
74
                     htmlOutput("lochtml"))),
84
                     htmlOutput("lochtml"))),
75
   absolutePanel(bottom = 30, left = 30, id="loading",
85
   absolutePanel(bottom = 30, left = 30, id="loading",
83
   output$map <- renderLeaflet({
93
   output$map <- renderLeaflet({
84
     leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>% 
94
     leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>% 
85
       addPolygons(color="#000", opacity = 1, weight=1,
95
       addPolygons(color="#000", opacity = 1, weight=1,
86
-                                fillColor = startcols, 
96
+                                fillColor = startcols.res, 
87
                   layerId = ~SA22018_V1,
97
                   layerId = ~SA22018_V1,
88
                   label = shpf@data$SA22018__1,
98
                   label = shpf@data$SA22018__1,
89
                   fillOpacity = 1) %>%
99
                   fillOpacity = 1) %>%
97
     leaf
107
     leaf
98
   })
108
   })
99
   updateMap <- function() {
109
   updateMap <- function() {
100
-    selcode <- sel.SA2.code()
101
-    selcode <- ifelse(is.na(selcode), 0, selcode)
102
     shinyjs::showElement(selector="#loading p", asis = TRUE, 
110
     shinyjs::showElement(selector="#loading p", asis = TRUE, 
103
                          anim=TRUE, animType = "slide")
111
                          anim=TRUE, animType = "slide")
104
-    fcols <- startcols
112
+    selcode <- sel.SA2.code()
113
+    selcode <- ifelse(is.na(selcode), 0, selcode)
105
     
114
     
106
-    if (selcode != 0) {
107
-      codvs <- work_simp %>% filter(work_code == selcode)
108
-      codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
109
-      codvs <- tencols[codvs$MAX]
110
-      fcols <- ifelse(is.na(codvs), "#808080", codvs)
115
+    if (input$radioinout == "work") {
116
+      fcols <- startcols.work
117
+      if (selcode != 0) {
118
+        codvs <- work_simp %>% filter(work_code == selcode)
119
+        codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
120
+        codvs <- tencols[codvs$MAX]
121
+        fcols <- ifelse(is.na(codvs), "#808080", codvs)
122
+      }
123
+    } else {
124
+    fcols <- startcols.res
125
+      if (selcode != 0) {
126
+        codvs <- work_simp %>% filter(res_code == selcode)
127
+        codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "work_code"))
128
+        codvs <- tencols[codvs$MAX]
129
+        fcols <- ifelse(is.na(codvs), "#808080", codvs)
130
+      }
131
+      
111
     }
132
     }
112
     lp <- leafletProxy("map", data = shpf) %>%
133
     lp <- leafletProxy("map", data = shpf) %>%
113
       setShapeStyle(layerId = ~SA22018_V1, fillColor = fcols) %>%
134
       setShapeStyle(layerId = ~SA22018_V1, fillColor = fcols) %>%
127
                          anim=TRUE, animType = "slide",
148
                          anim=TRUE, animType = "slide",
128
                          time = 1)
149
                          time = 1)
129
   }
150
   }
130
-  observeEvent(input$map_shape_click, {
151
+  observeEvent(input$map_shape_click, ignoreInit = TRUE, {
131
     p <- input$map_shape_click
152
     p <- input$map_shape_click
132
     pdat <- data.frame(Longitude = p$lng,
153
     pdat <- data.frame(Longitude = p$lng,
133
                       Latitude =p$lat)
154
                       Latitude =p$lat)
139
     sel.SA2.code(ifelse(sel.SA2.code() == codetmp, 0, codetmp))
160
     sel.SA2.code(ifelse(sel.SA2.code() == codetmp, 0, codetmp))
140
     updateMap()
161
     updateMap()
141
   })
162
   })
163
+  observeEvent(input$radioinout, ignoreInit = TRUE, {
164
+    updateMap()
165
+  })
142
   output$lochtml <- renderUI({
166
   output$lochtml <- renderUI({
143
     seled <- sel.SA2.code()
167
     seled <- sel.SA2.code()
144
     seled <- ifelse(is.na(seled), 0, seled)
168
     seled <- ifelse(is.na(seled), 0, seled)
146
       HTML("")
170
       HTML("")
147
     } else {
171
     } else {
148
       hrstr <- "<hr style='border-top: 1px solid #000;'/>"
172
       hrstr <- "<hr style='border-top: 1px solid #000;'/>"
149
-      str <- sprintf("<p><b>%s</b></p>", 
173
+      str <- sprintf("<b>%s</b>", 
150
                      shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled])
174
                      shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled])
151
       if (input$radioinout == "work") {
175
       if (input$radioinout == "work") {
152
-        str <- paste0("<p>People who work in</p>", str)
176
+        str <- sprintf("<p>Commuting method of people who <b>work</b> in</p>
177
+                       <p><b><u>%s</u></b></p>", str)
153
         vals <- as.numeric(work_to[work_to$work_code == seled, 5:15])
178
         vals <- as.numeric(work_to[work_to$work_code == seled, 5:15])
154
         vals <- ifelse(is.na(vals), 0, vals)
179
         vals <- ifelse(is.na(vals), 0, vals)
155
         vals <- ifelse(vals < 0, "~0", as.character(vals))
180
         vals <- ifelse(vals < 0, "~0", as.character(vals))
158
                 collapse="")
183
                 collapse="")
159
         str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
184
         str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
160
       } else {
185
       } else {
161
-        str <- paste0("<p>People who live in</p>", str)
186
+        str <- sprintf("<p>Commuting method of people who <b>live</b> in</p>
187
+                       <p><b><u>%s</u></b></p>", str)
162
         vals <- as.numeric(work_from[work_from$res_code == seled, 5:15])
188
         vals <- as.numeric(work_from[work_from$res_code == seled, 5:15])
163
         vals <- ifelse(is.na(vals), 0, vals)
189
         vals <- ifelse(is.na(vals), 0, vals)
164
         vals <- ifelse(vals < 0, "~0", as.character(vals))
190
         vals <- ifelse(vals < 0, "~0", as.character(vals))