|
@@ -21,9 +21,12 @@ codelist <- shpf@data %>%
|
21
|
21
|
mutate(sa2_code = as.numeric(as.character(SA22018_V1))) %>%
|
22
|
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
|
32
|
# Define UI
|
|
@@ -64,12 +67,19 @@ ui <- fluidPage(
|
64
|
67
|
}"),
|
65
|
68
|
leafletOutput("map"),
|
66
|
69
|
absolutePanel(top = 10, right = 10, id="mapcontrol",
|
67
|
|
- radioButtons("radioinout", label=NULL,
|
|
70
|
+ radioButtons("radioinout", label="Show commuters who",
|
68
|
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
|
83
|
div(id="locinfo",
|
74
|
84
|
htmlOutput("lochtml"))),
|
75
|
85
|
absolutePanel(bottom = 30, left = 30, id="loading",
|
|
@@ -83,7 +93,7 @@ server <- function(input, output) {
|
83
|
93
|
output$map <- renderLeaflet({
|
84
|
94
|
leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>%
|
85
|
95
|
addPolygons(color="#000", opacity = 1, weight=1,
|
86
|
|
- fillColor = startcols,
|
|
96
|
+ fillColor = startcols.res,
|
87
|
97
|
layerId = ~SA22018_V1,
|
88
|
98
|
label = shpf@data$SA22018__1,
|
89
|
99
|
fillOpacity = 1) %>%
|
|
@@ -97,17 +107,28 @@ server <- function(input, output) {
|
97
|
107
|
leaf
|
98
|
108
|
})
|
99
|
109
|
updateMap <- function() {
|
100
|
|
- selcode <- sel.SA2.code()
|
101
|
|
- selcode <- ifelse(is.na(selcode), 0, selcode)
|
102
|
110
|
shinyjs::showElement(selector="#loading p", asis = TRUE,
|
103
|
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
|
133
|
lp <- leafletProxy("map", data = shpf) %>%
|
113
|
134
|
setShapeStyle(layerId = ~SA22018_V1, fillColor = fcols) %>%
|
|
@@ -127,7 +148,7 @@ server <- function(input, output) {
|
127
|
148
|
anim=TRUE, animType = "slide",
|
128
|
149
|
time = 1)
|
129
|
150
|
}
|
130
|
|
- observeEvent(input$map_shape_click, {
|
|
151
|
+ observeEvent(input$map_shape_click, ignoreInit = TRUE, {
|
131
|
152
|
p <- input$map_shape_click
|
132
|
153
|
pdat <- data.frame(Longitude = p$lng,
|
133
|
154
|
Latitude =p$lat)
|
|
@@ -139,6 +160,9 @@ server <- function(input, output) {
|
139
|
160
|
sel.SA2.code(ifelse(sel.SA2.code() == codetmp, 0, codetmp))
|
140
|
161
|
updateMap()
|
141
|
162
|
})
|
|
163
|
+ observeEvent(input$radioinout, ignoreInit = TRUE, {
|
|
164
|
+ updateMap()
|
|
165
|
+ })
|
142
|
166
|
output$lochtml <- renderUI({
|
143
|
167
|
seled <- sel.SA2.code()
|
144
|
168
|
seled <- ifelse(is.na(seled), 0, seled)
|
|
@@ -146,10 +170,11 @@ server <- function(input, output) {
|
146
|
170
|
HTML("")
|
147
|
171
|
} else {
|
148
|
172
|
hrstr <- "<hr style='border-top: 1px solid #000;'/>"
|
149
|
|
- str <- sprintf("<p><b>%s</b></p>",
|
|
173
|
+ str <- sprintf("<b>%s</b>",
|
150
|
174
|
shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled])
|
151
|
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
|
178
|
vals <- as.numeric(work_to[work_to$work_code == seled, 5:15])
|
154
|
179
|
vals <- ifelse(is.na(vals), 0, vals)
|
155
|
180
|
vals <- ifelse(vals < 0, "~0", as.character(vals))
|
|
@@ -158,7 +183,8 @@ server <- function(input, output) {
|
158
|
183
|
collapse="")
|
159
|
184
|
str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
|
160
|
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
|
188
|
vals <- as.numeric(work_from[work_from$res_code == seled, 5:15])
|
163
|
189
|
vals <- ifelse(is.na(vals), 0, vals)
|
164
|
190
|
vals <- ifelse(vals < 0, "~0", as.character(vals))
|