|
@@ -1,26 +1,78 @@
|
1
|
1
|
library(shiny)
|
|
2
|
+library(shinyjs)
|
2
|
3
|
library(leaflet)
|
3
|
4
|
library(rgdal)
|
4
|
|
-library(readr)
|
5
|
5
|
library(dplyr)
|
6
|
6
|
|
7
|
|
-work_travel <- read_csv("../travel-work.csv")
|
|
7
|
+# work_travel <- read_csv("../travel-work.csv")
|
|
8
|
+load(file="datasets.RData")
|
8
|
9
|
shpf <- readOGR(dsn="../shapefiles/sa20025WGSfilcth")
|
|
10
|
+sa.in.dest <- shpf@data$SA22018_V1 %in% work_to$work_code
|
|
11
|
+sa.in.home <- shpf@data$SA22018_V1 %in% work_from$res_code
|
|
12
|
+transport.t <- c("Work at home", "Private car", "Company car",
|
|
13
|
+ "Carpool", "Bus", "Train", "Bicycle", "Walk",
|
|
14
|
+ "Ferry", "Other", "None")
|
|
15
|
+
|
|
16
|
+codelist <- shpf@data %>%
|
|
17
|
+ mutate(sa2_code = as.numeric(as.character(SA22018_V1))) %>%
|
|
18
|
+ select(sa2_code)
|
|
19
|
+
|
|
20
|
+startcols <- codelist %>% left_join(work_from, by = c("sa2_code" = "res_code"))
|
|
21
|
+startcols <- tencols[startcols$MAX]
|
|
22
|
+startcols <- ifelse(is.na(startcols), "#808080", startcols)
|
|
23
|
+
|
9
|
24
|
|
10
|
25
|
# Define UI
|
11
|
26
|
ui <- fluidPage(
|
12
|
|
- leafletOutput("map")
|
|
27
|
+ useShinyjs(),
|
|
28
|
+ tags$style(type = "text/css",
|
|
29
|
+ "html, body {
|
|
30
|
+ width:100%;
|
|
31
|
+ height:100%
|
|
32
|
+ }
|
|
33
|
+ #map {
|
|
34
|
+ height: 100% !important;
|
|
35
|
+ position: absolute !important;
|
|
36
|
+ top: 0;
|
|
37
|
+ left: 0;
|
|
38
|
+ }
|
|
39
|
+ #loading {
|
|
40
|
+ cursor: progress !important;
|
|
41
|
+ }
|
|
42
|
+ #loading p {
|
|
43
|
+ border-radius: 25px;
|
|
44
|
+ background: #FFFFFF;
|
|
45
|
+ padding: 10px;
|
|
46
|
+ border: 2px solid #000000;
|
|
47
|
+ font-size: 1.5em;
|
|
48
|
+ font-weight: bold;
|
|
49
|
+ }"),
|
|
50
|
+ leafletOutput("map"),
|
|
51
|
+ absolutePanel(bottom = 30, left = 30, id="loading",
|
|
52
|
+ p("Loading..."))
|
13
|
53
|
)
|
14
|
54
|
|
15
|
55
|
# Define server logic
|
16
|
56
|
server <- function(input, output) {
|
|
57
|
+ sel.SA2.code <- 0
|
|
58
|
+ p.layers <- c("polya", "polyb")
|
17
|
59
|
output$map <- renderLeaflet({
|
18
|
|
- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>%
|
19
|
|
- addPolygons(color="#000", opacity = 1, weight=1,
|
20
|
|
- popup = shpf@data$SA22018__1) %>%
|
21
|
|
- setView(174, -41, 5)
|
|
60
|
+ leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>%
|
|
61
|
+ addPolygons(group = p.layers[1] ,color="#000", opacity = 1, weight=1,
|
|
62
|
+ fillColor = startcols,
|
|
63
|
+ label = shpf@data$SA22018__1,
|
|
64
|
+ fillOpacity = 1) %>%
|
|
65
|
+ setView(174, -41, 5) %>%
|
|
66
|
+ addLegend(position = "topleft",
|
|
67
|
+ colors = c(tencols, "#808080"),
|
|
68
|
+ labels = transport.t, opacity = 1)
|
|
69
|
+ shinyjs::hideElement(selector="#loading p", asis = TRUE,
|
|
70
|
+ anim=TRUE, animType = "slide", time=7)
|
|
71
|
+ leaf
|
22
|
72
|
})
|
23
|
73
|
observeEvent(input$map_shape_click, {
|
|
74
|
+ shinyjs::showElement(selector="#loading p", asis = TRUE,
|
|
75
|
+ anim=TRUE, animType = "slide")
|
24
|
76
|
p <- input$map_shape_click
|
25
|
77
|
print(p)
|
26
|
78
|
pdat <- data.frame(Longitude = p$lng,
|
|
@@ -30,9 +82,37 @@ server <- function(input, output) {
|
30
|
82
|
# Set the projection of the SpatialPointsDataFrame using the projection of the shapefile
|
31
|
83
|
proj4string(pdat) <- proj4string(shpf)
|
32
|
84
|
ppoly <- over(pdat, shpf)
|
|
85
|
+ codetmp <- as.numeric(as.character(ppoly[1,"SA22018_V1"]))
|
|
86
|
+ print(sel.SA2.code)
|
|
87
|
+ sel.SA2.code <<- ifelse(sel.SA2.code == codetmp, 0, codetmp)
|
33
|
88
|
print(ppoly)
|
34
|
|
- print(work_travel[work_travel$SA2_code_usual_residence_address ==
|
35
|
|
- ppoly[1,"SA22018_V1"],])
|
|
89
|
+ #print(work_simp[work_simp$res_code ==
|
|
90
|
+ # sel.SA2.code,])
|
|
91
|
+ print(sel.SA2.code)
|
|
92
|
+ print(codetmp)
|
|
93
|
+ fcols <- startcols
|
|
94
|
+ if (sel.SA2.code != 0) {
|
|
95
|
+ print(head(work_simp))
|
|
96
|
+ codvs <- work_simp %>% filter(work_code == sel.SA2.code)
|
|
97
|
+ print(head(codvs))
|
|
98
|
+ codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
|
|
99
|
+ print(head(codvs))
|
|
100
|
+ print(table(codvs$MAX))
|
|
101
|
+ codvs <- tencols[codvs$MAX]
|
|
102
|
+ print(table(codvs))
|
|
103
|
+ fcols <- ifelse(is.na(codvs), "#808080", codvs)
|
|
104
|
+ print(table(fcols))
|
|
105
|
+ }
|
|
106
|
+ print(table(fcols))
|
|
107
|
+ leafletProxy("map", data = shpf) %>%
|
|
108
|
+ addPolygons(group = p.layers[2] ,color="#000", opacity = 1, weight=1,
|
|
109
|
+ fillColor = fcols,
|
|
110
|
+ label = shpf@data$SA22018__1,
|
|
111
|
+ fillOpacity = 1) %>%
|
|
112
|
+ clearGroup(p.layers[1])
|
|
113
|
+ p.layers <<- rev(p.layers)
|
|
114
|
+ shinyjs::hideElement(selector="#loading p", asis=TRUE,
|
|
115
|
+ anim=TRUE, animType = "slide", time = 7)
|
36
|
116
|
})
|
37
|
117
|
}
|
38
|
118
|
|