|
@@ -64,20 +64,31 @@ ui <- fluidPage(
|
64
|
64
|
}
|
65
|
65
|
#lochtml ul {
|
66
|
66
|
padding-left: 15px;
|
|
67
|
+ }
|
|
68
|
+ .radio label span p {
|
|
69
|
+ margin-top: 3px;
|
|
70
|
+ margin-bottom: 0px;
|
67
|
71
|
}"),
|
68
|
72
|
leafletOutput("map"),
|
69
|
73
|
absolutePanel(top = 10, right = 10, id="mapcontrol",
|
70
|
74
|
radioButtons("radioinout", label="Show commuters who",
|
71
|
|
- choices = c(
|
72
|
|
- "Live in area" = "res",
|
73
|
|
- "Work in area" = "work"
|
|
75
|
+ choiceNames = list(
|
|
76
|
+ HTML("<p>Commute <b>from</b> selected area</p>"),
|
|
77
|
+ HTML("<p>Commute <b>to</b> selected area</p>")),
|
|
78
|
+ choiceValues = list(
|
|
79
|
+ "res",
|
|
80
|
+ "work"
|
74
|
81
|
),
|
75
|
82
|
inline = FALSE),
|
76
|
83
|
radioButtons("radiocolour",
|
77
|
84
|
label = "Colour by",
|
78
|
|
- choices = c(
|
79
|
|
- "Transport type" = "type",
|
80
|
|
- "Number of commuters" = "number"
|
|
85
|
+ choiceNames = list(
|
|
86
|
+ HTML("<p>Most common commute method</p>"),
|
|
87
|
+ HTML("<p>Number of commuters</p>")
|
|
88
|
+ ),
|
|
89
|
+ choiceValues = list(
|
|
90
|
+ "type",
|
|
91
|
+ "number"
|
81
|
92
|
),
|
82
|
93
|
inline = FALSE),
|
83
|
94
|
div(id="locinfo",
|
|
@@ -101,7 +112,8 @@ server <- function(input, output) {
|
101
|
112
|
addResetMapButton() %>%
|
102
|
113
|
addLegend(position = "topleft",
|
103
|
114
|
colors = c(tencols, "#808080"),
|
104
|
|
- labels = transport.t, opacity = 1)
|
|
115
|
+ labels = transport.t, opacity = 1,
|
|
116
|
+ title = "Commute method")
|
105
|
117
|
shinyjs::hideElement(selector="#loading p", asis = TRUE,
|
106
|
118
|
anim=TRUE, animType = "slide", time=7)
|
107
|
119
|
leaf
|
|
@@ -111,33 +123,71 @@ server <- function(input, output) {
|
111
|
123
|
anim=TRUE, animType = "slide")
|
112
|
124
|
selcode <- sel.SA2.code()
|
113
|
125
|
selcode <- ifelse(is.na(selcode), 0, selcode)
|
114
|
|
-
|
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)
|
|
126
|
+ psel <- selcode %in% shpf@data$SA22018_V1
|
|
127
|
+ if (input$radiocolour == "type") {
|
|
128
|
+ if (input$radioinout == "work") {
|
|
129
|
+ fcols <- startcols.work
|
|
130
|
+ if (psel) {
|
|
131
|
+ codvs <- work_simp %>% filter(work_code == selcode)
|
|
132
|
+ codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
|
|
133
|
+ codvs <- tencols[codvs$MAX]
|
|
134
|
+ fcols <- ifelse(is.na(codvs), "#808080", codvs)
|
|
135
|
+ }
|
|
136
|
+ } else {
|
|
137
|
+ fcols <- startcols.res
|
|
138
|
+ if (psel) {
|
|
139
|
+ codvs <- work_simp %>% filter(res_code == selcode)
|
|
140
|
+ codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "work_code"))
|
|
141
|
+ codvs <- tencols[codvs$MAX]
|
|
142
|
+ fcols <- ifelse(is.na(codvs), "#808080", codvs)
|
|
143
|
+ }
|
|
144
|
+
|
122
|
145
|
}
|
|
146
|
+ lp <- leafletProxy("map", data = shpf) %>%
|
|
147
|
+ setShapeStyle(layerId = ~SA22018_V1, fillColor = fcols) %>%
|
|
148
|
+ clearControls() %>%
|
|
149
|
+ addLegend(position = "topleft",
|
|
150
|
+ colors = c(tencols, "#808080"),
|
|
151
|
+ labels = transport.t, opacity = 1,
|
|
152
|
+ title = "Commute method"
|
|
153
|
+ ) %>%
|
|
154
|
+ clearGroup("hpoly")
|
123
|
155
|
} 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)
|
|
156
|
+ if (input$radioinout == "work") {
|
|
157
|
+ if (psel) {
|
|
158
|
+ codvs <- work_simp %>% filter(work_code == selcode)
|
|
159
|
+ codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
|
|
160
|
+ cvals <- ifelse(codvs$total == 0, NA, codvs$total)
|
|
161
|
+
|
|
162
|
+ } else {
|
|
163
|
+ codvs <- codelist %>%
|
|
164
|
+ left_join(work_to, by = c("sa2_code" = "work_code"))
|
|
165
|
+ cvals <- ifelse(codvs$total == 0, NA, codvs$total)
|
|
166
|
+ }
|
|
167
|
+ } else {
|
|
168
|
+ if (psel) {
|
|
169
|
+ codvs <- work_simp %>% filter(res_code == selcode)
|
|
170
|
+ codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "work_code"))
|
|
171
|
+ cvals <- ifelse(codvs$total == 0, NA, codvs$total)
|
|
172
|
+ } else {
|
|
173
|
+ codvs <- codelist %>%
|
|
174
|
+ left_join(work_from, by = c("sa2_code" = "res_code"))
|
|
175
|
+ cvals <- ifelse(codvs$total == 0, NA, codvs$total)
|
|
176
|
+ }
|
130
|
177
|
}
|
131
|
|
-
|
|
178
|
+ cvr <- range(cvals, na.rm = TRUE)
|
|
179
|
+ binner <- colorBin(c("white", "red"), cvr, bins = 7, pretty = TRUE)
|
|
180
|
+ lp <- leafletProxy("map", data = shpf) %>%
|
|
181
|
+ setShapeStyle(layerId = ~SA22018_V1, fillColor = binner(cvals)) %>%
|
|
182
|
+ clearControls() %>%
|
|
183
|
+ addLegend(position = "topleft",
|
|
184
|
+ pal = binner,
|
|
185
|
+ values = cvals, opacity = 1,
|
|
186
|
+ na.label = "None",
|
|
187
|
+ title = "Number of commuters") %>%
|
|
188
|
+ clearGroup("hpoly")
|
132
|
189
|
}
|
133
|
|
- lp <- leafletProxy("map", data = shpf) %>%
|
134
|
|
- setShapeStyle(layerId = ~SA22018_V1, fillColor = fcols) %>%
|
135
|
|
- clearControls() %>%
|
136
|
|
- addLegend(position = "topleft",
|
137
|
|
- colors = c(tencols, "#808080"),
|
138
|
|
- labels = transport.t, opacity = 1) %>%
|
139
|
|
- clearGroup("hpoly")
|
140
|
|
- if (selcode %in% shpf@data$SA22018_V1) {
|
|
190
|
+ if (psel) {
|
141
|
191
|
lp %>% addPolygons(group = "hpoly",
|
142
|
192
|
weight = 4,
|
143
|
193
|
data = shpf[which(shpf@data$SA22018_V1 == selcode),],
|
|
@@ -163,37 +213,75 @@ server <- function(input, output) {
|
163
|
213
|
observeEvent(input$radioinout, ignoreInit = TRUE, {
|
164
|
214
|
updateMap()
|
165
|
215
|
})
|
|
216
|
+ observeEvent(input$radiocolour, ignoreInit = TRUE, {
|
|
217
|
+ updateMap()
|
|
218
|
+ })
|
166
|
219
|
output$lochtml <- renderUI({
|
167
|
220
|
seled <- sel.SA2.code()
|
168
|
221
|
seled <- ifelse(is.na(seled), 0, seled)
|
169
|
|
- if (seled == 0) {
|
|
222
|
+ if (!(seled %in% shpf@data$SA22018_V1)) {
|
170
|
223
|
HTML("")
|
171
|
224
|
} else {
|
|
225
|
+ namesel <- shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled]
|
172
|
226
|
hrstr <- "<hr style='border-top: 1px solid #000;'/>"
|
173
|
|
- str <- sprintf("<b>%s</b>",
|
174
|
|
- shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled])
|
175
|
|
- if (input$radioinout == "work") {
|
176
|
|
- str <- sprintf("<p>Commuting method of people who <b>work</b> in</p>
|
177
|
|
- <p><b><u>%s</u></b></p>", str)
|
178
|
|
- vals <- as.numeric(work_to[work_to$work_code == seled, 5:15])
|
179
|
|
- vals <- ifelse(is.na(vals), 0, vals)
|
180
|
|
- vals <- ifelse(vals < 0, "~0", as.character(vals))
|
181
|
|
- listi <- paste0(sprintf("<li>%s: %s</li>", cols.labs,
|
182
|
|
- vals),
|
183
|
|
- collapse="")
|
184
|
|
- str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
|
|
227
|
+ if (input$radiocolour == "type") {
|
|
228
|
+ str <- sprintf("<b>%s</b>", namesel)
|
|
229
|
+ if (input$radioinout == "work") {
|
|
230
|
+ str <- sprintf("<p>Commuting method of people who <b>work</b> in</p>
|
|
231
|
+ <p><b><u>%s</u></b></p>", str)
|
|
232
|
+ vals <- as.numeric(work_to[work_to$work_code == seled, 5:15])
|
|
233
|
+ vals <- ifelse(is.na(vals), 0, vals)
|
|
234
|
+ vals <- ifelse(vals < 0, "~0", as.character(vals))
|
|
235
|
+ listi <- paste0(sprintf("<li>%s: %s</li>", cols.labs,
|
|
236
|
+ vals),
|
|
237
|
+ collapse="")
|
|
238
|
+ str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
|
|
239
|
+ } else {
|
|
240
|
+ str <- sprintf("<p>Commuting method of people who <b>live</b> in</p>
|
|
241
|
+ <p><u>%s</u></p>", str)
|
|
242
|
+ vals <- as.numeric(work_from[work_from$res_code == seled, 5:15])
|
|
243
|
+ vals <- ifelse(is.na(vals), 0, vals)
|
|
244
|
+ vals <- ifelse(vals < 0, "~0", as.character(vals))
|
|
245
|
+ listi <- paste0(sprintf("<li>%s: %s</li>", cols.labs,
|
|
246
|
+ vals),
|
|
247
|
+ collapse="")
|
|
248
|
+ str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
|
|
249
|
+ }
|
|
250
|
+ HTML(str)
|
185
|
251
|
} else {
|
186
|
|
- str <- sprintf("<p>Commuting method of people who <b>live</b> in</p>
|
187
|
|
- <p><b><u>%s</u></b></p>", str)
|
188
|
|
- vals <- as.numeric(work_from[work_from$res_code == seled, 5:15])
|
189
|
|
- vals <- ifelse(is.na(vals), 0, vals)
|
190
|
|
- vals <- ifelse(vals < 0, "~0", as.character(vals))
|
191
|
|
- listi <- paste0(sprintf("<li>%s: %s</li>", cols.labs,
|
192
|
|
- vals),
|
193
|
|
- collapse="")
|
194
|
|
- str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
|
|
252
|
+ str <- hrstr
|
|
253
|
+ if (input$radioinout == "work") {
|
|
254
|
+ val <- as.numeric(work_to[work_to$work_code == seled, 15])
|
|
255
|
+ val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
|
|
256
|
+ str <- sprintf("%s<p>%d people commute <b>to</b></p>
|
|
257
|
+ <p><b><u>%s</u></b></p>", str, val, namesel)
|
|
258
|
+ if (val > 0) {
|
|
259
|
+ subs <- work_simp %>% filter(work_code == seled) %>%
|
|
260
|
+ arrange(desc(total)) %>% head(10)
|
|
261
|
+ listi <- paste0(sprintf("<li>%s: %s</li>", subs$res_name,
|
|
262
|
+ subs$total),
|
|
263
|
+ collapse="")
|
|
264
|
+ str <- sprintf("%s<p>Top areas to commute from<p>
|
|
265
|
+ <ul>%s</ul>", str, listi)
|
|
266
|
+ }
|
|
267
|
+ } else {
|
|
268
|
+ val <- as.numeric(work_from[work_from$res_code == seled, 15])
|
|
269
|
+ val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
|
|
270
|
+ str <- sprintf("%s<p>%d people commute <b>from</b></p>
|
|
271
|
+ <p><b><u>%s</u></b></p>", str, val, namesel)
|
|
272
|
+ if (val > 0) {
|
|
273
|
+ subs <- work_simp %>% filter(res_code == seled) %>%
|
|
274
|
+ arrange(desc(total)) %>% head(10)
|
|
275
|
+ listi <- paste0(sprintf("<li>%s: %s</li>", subs$work_name,
|
|
276
|
+ subs$total),
|
|
277
|
+ collapse="")
|
|
278
|
+ str <- sprintf("%s<p>Top areas to commute to<p>
|
|
279
|
+ <ul>%s</ul>", str, listi)
|
|
280
|
+ }
|
|
281
|
+
|
|
282
|
+ }
|
|
283
|
+ HTML(str)
|
195
|
284
|
}
|
196
|
|
- HTML(str)
|
197
|
285
|
}
|
198
|
286
|
})
|
199
|
287
|
}
|