Minimal working app

.gitignore

@@ -4,3 +4,4 @@
 .Ruserdata
 
 shapefiles/
+*.RData

scratch.R

@@ -91,4 +91,15 @@ work_simp %>%
   ) -> work_to
 
 tencols <-  c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c", "#fb9a99", 
-              "#e31a1c", "#fdbf6f", "#ff7f00", "#cab2d6", "#6a3d9a")
+              "#e31a1c", "#fdbf6f", "#ff7f00", "#cab2d6", "#6a3d9a")
+tencols[which.max(work_from[1, 5:14])]
+
+
+work_from$MAX <- work_from %>% select(home:other) %>% as.matrix() %>% 
+  apply(1, which.max)
+work_to$MAX <- work_to %>% select(home:other) %>% as.matrix() %>% 
+  apply(1, which.max)
+work_simp$MAX <- work_simp %>% select(home:other) %>% as.matrix() %>% 
+  apply(1, which.max)
+
+save(work_simp, work_to, work_from, tencols, file="datasets.RData")

viz/app.R

@@ -1,26 +1,78 @@
 library(shiny)
+library(shinyjs)
 library(leaflet)
 library(rgdal)
-library(readr)
 library(dplyr)
 
-work_travel <- read_csv("../travel-work.csv")
+# work_travel <- read_csv("../travel-work.csv")
+load(file="datasets.RData")
 shpf <- readOGR(dsn="../shapefiles/sa20025WGSfilcth")
+sa.in.dest <- shpf@data$SA22018_V1 %in% work_to$work_code
+sa.in.home <- shpf@data$SA22018_V1 %in% work_from$res_code
+transport.t <- c("Work at home", "Private car", "Company car", 
+                "Carpool", "Bus", "Train", "Bicycle", "Walk",
+                "Ferry", "Other", "None")
+
+codelist <- shpf@data %>% 
+  mutate(sa2_code = as.numeric(as.character(SA22018_V1))) %>% 
+  select(sa2_code)
+
+startcols <- codelist %>% left_join(work_from, by = c("sa2_code" = "res_code"))
+startcols <- tencols[startcols$MAX]
+startcols <- ifelse(is.na(startcols), "#808080", startcols)
+
 
 # Define UI
 ui <- fluidPage(
-  leafletOutput("map")
+  useShinyjs(),
+  tags$style(type = "text/css", 
+  "html, body {
+    width:100%;
+    height:100%
+  }
+  #map {
+    height: 100% !important;
+    position: absolute !important;
+    top: 0;
+    left: 0;
+  }
+  #loading {
+    cursor: progress !important;
+  }
+  #loading p {
+    border-radius: 25px;
+    background: #FFFFFF;
+    padding: 10px;
+    border: 2px solid #000000;
+    font-size: 1.5em;
+    font-weight: bold;
+  }"),
+  leafletOutput("map"),
+  absolutePanel(bottom = 30, left = 30, id="loading",
+                p("Loading..."))
 )
 
 # Define server logic
 server <- function(input, output) {
+  sel.SA2.code <- 0
+  p.layers <- c("polya", "polyb")
   output$map <- renderLeaflet({
-    leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>% 
-      addPolygons(color="#000", opacity = 1, weight=1,
-                                popup = shpf@data$SA22018__1) %>%
-      setView(174, -41, 5)
+    leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>% 
+      addPolygons(group = p.layers[1] ,color="#000", opacity = 1, weight=1,
+                                fillColor = startcols, 
+                  label = shpf@data$SA22018__1,
+                  fillOpacity = 1) %>%
+      setView(174, -41, 5) %>%
+      addLegend(position = "topleft",
+                colors = c(tencols, "#808080"),
+                labels = transport.t, opacity = 1)
+    shinyjs::hideElement(selector="#loading p", asis = TRUE, 
+                         anim=TRUE, animType = "slide", time=7)
+    leaf
   })
   observeEvent(input$map_shape_click, {
+    shinyjs::showElement(selector="#loading p", asis = TRUE, 
+                         anim=TRUE, animType = "slide")
     p <- input$map_shape_click
     print(p)
     pdat <- data.frame(Longitude = p$lng,
@@ -30,9 +82,37 @@ server <- function(input, output) {
     # Set the projection of the SpatialPointsDataFrame using the projection of the shapefile
     proj4string(pdat) <- proj4string(shpf)
     ppoly <- over(pdat, shpf)
+    codetmp <- as.numeric(as.character(ppoly[1,"SA22018_V1"]))
+    print(sel.SA2.code)
+    sel.SA2.code <<- ifelse(sel.SA2.code == codetmp, 0, codetmp)
     print(ppoly)
-    print(work_travel[work_travel$SA2_code_usual_residence_address == 
-                        ppoly[1,"SA22018_V1"],])
+    #print(work_simp[work_simp$res_code == 
+    #                    sel.SA2.code,])
+    print(sel.SA2.code)
+    print(codetmp)
+    fcols <- startcols
+    if (sel.SA2.code != 0) {
+      print(head(work_simp))
+      codvs <- work_simp %>% filter(work_code == sel.SA2.code)
+      print(head(codvs))
+      codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
+      print(head(codvs))
+      print(table(codvs$MAX))
+      codvs <- tencols[codvs$MAX]
+      print(table(codvs))
+      fcols <- ifelse(is.na(codvs), "#808080", codvs)
+      print(table(fcols))
+    }
+    print(table(fcols))
+    leafletProxy("map", data = shpf) %>%
+      addPolygons(group = p.layers[2] ,color="#000", opacity = 1, weight=1,
+                                fillColor = fcols,
+                  label = shpf@data$SA22018__1,
+                  fillOpacity = 1) %>%
+      clearGroup(p.layers[1])
+    p.layers <<- rev(p.layers)
+    shinyjs::hideElement(selector="#loading p", asis=TRUE, 
+                         anim=TRUE, animType = "slide", time = 7)
   })
 }