Browse Source

Some additions to draft

Petra Lamborn 3 years ago
parent
commit
d8c0fcd7ca
2 changed files with 28 additions and 8 deletions
  1. 1
    0
      .gitignore
  2. 27
    8
      viz/app.R

+ 1
- 0
.gitignore View File

5
 
5
 
6
 shapefiles/
6
 shapefiles/
7
 *.RData
7
 *.RData
8
+viz/sa20025WGSfilcth/

+ 27
- 8
viz/app.R View File

9
 
9
 
10
 # work_travel <- read_csv("../travel-work.csv")
10
 # work_travel <- read_csv("../travel-work.csv")
11
 load(file="datasets.RData")
11
 load(file="datasets.RData")
12
-shpf <- readOGR(dsn="../shapefiles/sa20025WGSfilcth")
12
+shpf <- readOGR(dsn="sa20025WGSfilcth")
13
 sa.in.dest <- shpf@data$SA22018_V1 %in% work_to$work_code
13
 sa.in.dest <- shpf@data$SA22018_V1 %in% work_to$work_code
14
 sa.in.home <- shpf@data$SA22018_V1 %in% work_from$res_code
14
 sa.in.home <- shpf@data$SA22018_V1 %in% work_from$res_code
15
 transport.t <- c("Work at home", "Private car", "Company car", 
15
 transport.t <- c("Work at home", "Private car", "Company car", 
28
 startcols.work <- tencols[startcols.work$MAX]
28
 startcols.work <- tencols[startcols.work$MAX]
29
 startcols.work <- ifelse(is.na(startcols.work), "#808080", startcols.work)
29
 startcols.work <- ifelse(is.na(startcols.work), "#808080", startcols.work)
30
 
30
 
31
+hrstr <- "<hr style='border-top: 1px solid #000;'/>"
31
 
32
 
32
 # Define UI
33
 # Define UI
33
 ui <- fluidPage(
34
 ui <- fluidPage(
68
   .radio label span p {
69
   .radio label span p {
69
     margin-top: 3px;
70
     margin-top: 3px;
70
     margin-bottom: 0px;
71
     margin-bottom: 0px;
72
+  }
73
+  .leaflet-container {
74
+    background-color: #84e1e1;
71
   }"),
75
   }"),
72
   leafletOutput("map"),
76
   leafletOutput("map"),
73
   absolutePanel(top = 10, right = 10, id="mapcontrol",
77
   absolutePanel(top = 10, right = 10, id="mapcontrol",
93
                              inline = FALSE),
97
                              inline = FALSE),
94
                 div(id="locinfo",
98
                 div(id="locinfo",
95
                     htmlOutput("lochtml"))),
99
                     htmlOutput("lochtml"))),
96
-  absolutePanel(bottom = 30, left = 30, id="loading",
100
+  absolutePanel(bottom = 30, left = 10, id="loading",
97
                 p("Loading..."))
101
                 p("Loading..."))
98
 )
102
 )
99
 
103
 
100
 # Define server logic
104
 # Define server logic
101
 server <- function(input, output) {
105
 server <- function(input, output) {
102
   sel.SA2.code <- reactiveVal(0)
106
   sel.SA2.code <- reactiveVal(0)
103
-  p.layers <- c("polya", "polyb")
104
   output$map <- renderLeaflet({
107
   output$map <- renderLeaflet({
105
     leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>% 
108
     leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>% 
106
       addPolygons(color="#000", opacity = 1, weight=1,
109
       addPolygons(color="#000", opacity = 1, weight=1,
115
                 labels = transport.t, opacity = 1,
118
                 labels = transport.t, opacity = 1,
116
                 title = "Commute method")
119
                 title = "Commute method")
117
     shinyjs::hideElement(selector="#loading p", asis = TRUE, 
120
     shinyjs::hideElement(selector="#loading p", asis = TRUE, 
118
-                         anim=TRUE, animType = "slide", time=7)
121
+                         anim=TRUE, animType = "slide", time=10)
119
     leaf
122
     leaf
120
   })
123
   })
121
   updateMap <- function() {
124
   updateMap <- function() {
198
                          anim=TRUE, animType = "slide",
201
                          anim=TRUE, animType = "slide",
199
                          time = 1)
202
                          time = 1)
200
   }
203
   }
201
-  observeEvent(input$map_shape_click, ignoreInit = TRUE, {
202
-    p <- input$map_shape_click
204
+  observeEvent(input$map_click, ignoreInit = TRUE, {
205
+    p <- input$map_click
203
     pdat <- data.frame(Longitude = p$lng,
206
     pdat <- data.frame(Longitude = p$lng,
204
                       Latitude =p$lat)
207
                       Latitude =p$lat)
205
     coordinates(pdat) <- ~ Longitude + Latitude
208
     coordinates(pdat) <- ~ Longitude + Latitude
210
     sel.SA2.code(ifelse(sel.SA2.code() == codetmp, 0, codetmp))
213
     sel.SA2.code(ifelse(sel.SA2.code() == codetmp, 0, codetmp))
211
     updateMap()
214
     updateMap()
212
   })
215
   })
216
+  observeEvent(input$map_shape_mouseover, once=TRUE,{
217
+    shinyjs::html(selector=".leaflet-control-attribution.leaflet-control",
218
+                  html = '
219
+<a href="http://leafletjs.com" 
220
+title="A JS library for interactive maps">Leaflet</a> | <a 
221
+href="https://datafinder.stats.govt.nz/data/category/census/2018/commuter-view/"
222
+title="Source data">
223
+StatsNZ</a> | <a href="https://petras.space/page/cv/" title="Hire me!">
224
+Petra Lamborn</a> | Numbers subject to <a
225
+href="http://archive.stats.govt.nz/about_us/legisln-policies-protocols/
226
+confidentiality-of-info-supplied-to-snz/safeguarding-confidentiality.aspx"
227
+title="A method of preserving confidentiality and anonymity">
228
+random rounding</a>
229
+                  '
230
+                )
231
+               })
213
   observeEvent(input$radioinout, ignoreInit = TRUE, {
232
   observeEvent(input$radioinout, ignoreInit = TRUE, {
214
     updateMap()
233
     updateMap()
215
   })
234
   })
220
     seled <- sel.SA2.code()
239
     seled <- sel.SA2.code()
221
     seled <- ifelse(is.na(seled), 0, seled)
240
     seled <- ifelse(is.na(seled), 0, seled)
222
     if (!(seled %in% shpf@data$SA22018_V1)) {
241
     if (!(seled %in% shpf@data$SA22018_V1)) {
223
-      HTML("")
242
+      HTML(paste0(hrstr, 
243
+                  "<p><em>No area selected</em></p>"))
224
     } else {
244
     } else {
225
       namesel <- shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled]
245
       namesel <- shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled]
226
-      hrstr <- "<hr style='border-top: 1px solid #000;'/>"
227
       if (input$radiocolour == "type") {
246
       if (input$radiocolour == "type") {
228
         str <- sprintf("<b>%s</b>", namesel)
247
         str <- sprintf("<b>%s</b>", namesel)
229
         if (input$radioinout == "work") {
248
         if (input$radioinout == "work") {