Browse Source

Add hover code

Petra Lamborn 3 years ago
parent
commit
b971ba1757
2 changed files with 186 additions and 33 deletions
  1. 168
    33
      viz/app.R
  2. 18
    0
      viz/extras.R

+ 168
- 33
viz/app.R View File

16
 sa.in.home <- shpf@data$SA22018_V1 %in% work_from$res_code
16
 sa.in.home <- shpf@data$SA22018_V1 %in% work_from$res_code
17
 transport.t <- c("Work at home", "Private car", "Company car", 
17
 transport.t <- c("Work at home", "Private car", "Company car", 
18
                 "Carpool", "Bus", "Train", "Bicycle", "Walk",
18
                 "Carpool", "Bus", "Train", "Bicycle", "Walk",
19
-                "Ferry", "Other", "None")
19
+                "Ferry", "Other", "None/Unknown")
20
 edu.t <- c("Drive self", "Passenger in car", "Walk", "Bicycle",
20
 edu.t <- c("Drive self", "Passenger in car", "Walk", "Bicycle",
21
            "School bus", "Public bus", "Train", "Ferry", "Study at home",
21
            "School bus", "Public bus", "Train", "Ferry", "Study at home",
22
-           "Other", "None")
22
+           "Other", "None/Unknown")
23
 cols.labs <- c(transport.t[1:10], "Total")
23
 cols.labs <- c(transport.t[1:10], "Total")
24
 cols.edu.labs <- c(edu.t[1:10], "Total")
24
 cols.edu.labs <- c(edu.t[1:10], "Total")
25
 
25
 
41
 startcols.edu <- tencols[startcols.edu$MAX]
41
 startcols.edu <- tencols[startcols.edu$MAX]
42
 startcols.edu <- ifelse(is.na(startcols.edu), "#808080", startcols.edu)
42
 startcols.edu <- ifelse(is.na(startcols.edu), "#808080", startcols.edu)
43
 
43
 
44
-hrstr <- "<hr style='border-top: 1px solid #000;'/>"
44
+hrstr <- "<hr/>"
45
 
45
 
46
 # Define UI
46
 # Define UI
47
 ui <- fluidPage(
47
 ui <- fluidPage(
75
                                "number"
75
                                "number"
76
                              ),
76
                              ),
77
                              inline = FALSE),
77
                              inline = FALSE),
78
-                div(id="locinfo",
79
-                    htmlOutput("lochtml")))),
78
+                div(class="locinfo",
79
+                    htmlOutput("lochtml")),
80
+                div(id="loc2"),
81
+                    htmlOutput("secondarylochtml"))
82
+                ),
80
   absolutePanel(top = 25, right = 10, id="control2",
83
   absolutePanel(top = 25, right = 10, id="control2",
81
                 materialSwitch("controlswitch", value=TRUE, right=TRUE,
84
                 materialSwitch("controlswitch", value=TRUE, right=TRUE,
82
                                inline=TRUE, status="info")),
85
                                inline=TRUE, status="info")),
99
 server <- function(input, output) {
102
 server <- function(input, output) {
100
   sel.SA2.code <- reactiveVal(0)
103
   sel.SA2.code <- reactiveVal(0)
101
   attribupdate <- FALSE
104
   attribupdate <- FALSE
105
+  mouseover <- reactive({
106
+    lastover <- input$map_shape_mouseover$id
107
+    lastover <- ifelse(is.null(lastover), 0, lastover)
108
+    lastout <- input$map_shape_mouseout$id
109
+    lastout <- ifelse(is.null(lastout), 0, lastout)
110
+    ifelse(lastout == lastover, 0, lastover)
111
+  })
102
   output$map <- renderLeaflet({
112
   output$map <- renderLeaflet({
103
     leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>% 
113
     leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13)) %>% 
104
       addPolygons(color="#000", opacity = 1, weight=1,
114
       addPolygons(color="#000", opacity = 1, weight=1,
319
     seled <- sel.SA2.code()
329
     seled <- sel.SA2.code()
320
     seled <- ifelse(is.na(seled), 0, seled)
330
     seled <- ifelse(is.na(seled), 0, seled)
321
     if (!(seled %in% shpf@data$SA22018_V1)) {
331
     if (!(seled %in% shpf@data$SA22018_V1)) {
322
-      div(class="locinfo",
323
-        HTML(paste0(hrstr, 
324
-                  "<p><em>No area selected</em></p>"))
325
-      )
332
+      HTML("")
326
     } else {
333
     } else {
327
       namesel <- shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled]
334
       namesel <- shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled]
328
       if (input$radioeduemp == "Employment") {
335
       if (input$radioeduemp == "Employment") {
329
         if (input$radiocolour == "type") {
336
         if (input$radiocolour == "type") {
330
           str <- sprintf("<b>%s</b>", namesel)
337
           str <- sprintf("<b>%s</b>", namesel)
331
           if (input$radioinout == "work") {
338
           if (input$radioinout == "work") {
332
-            str <- sprintf("<p>Commuting method of people who <b>work</b> in</p>
333
-                           <p><b><u>%s</u></b></p>", str)
339
+            str <- sprintf("<p>Commuting method of people who <b>work</b> in 
340
+                           <u>%s</u></p>", str)
334
             vals <- as.numeric(work_to[work_to$work_code == seled, 5:15])
341
             vals <- as.numeric(work_to[work_to$work_code == seled, 5:15])
335
             vals <- ifelse(is.na(vals), 0, vals)
342
             vals <- ifelse(is.na(vals), 0, vals)
336
             vals <- ifelse(vals < 0, "~0", as.character(vals))
343
             vals <- ifelse(vals < 0, "~0", as.character(vals))
339
                     collapse="")
346
                     collapse="")
340
             str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
347
             str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
341
           } else {
348
           } else {
342
-            str <- sprintf("<p>Commuting method of people who <b>live</b> in</p>
343
-                           <p><u>%s</u></p>", str)
349
+            str <- sprintf("<p>Commuting method of people who <b>live</b> in 
350
+                           <u>%s</u></p>", str)
344
             vals <- as.numeric(work_from[work_from$res_code == seled, 5:15])
351
             vals <- as.numeric(work_from[work_from$res_code == seled, 5:15])
345
             vals <- ifelse(is.na(vals), 0, vals)
352
             vals <- ifelse(is.na(vals), 0, vals)
346
             vals <- ifelse(vals < 0, "~0", as.character(vals))
353
             vals <- ifelse(vals < 0, "~0", as.character(vals))
349
                     collapse="")
356
                     collapse="")
350
             str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
357
             str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
351
           }
358
           }
352
-          div(class="locinfo",
353
               HTML(str)
359
               HTML(str)
354
-          )
355
         } else {
360
         } else {
356
           str <- hrstr
361
           str <- hrstr
357
           if (input$radioinout == "work") {
362
           if (input$radioinout == "work") {
358
             val <- as.numeric(work_to[work_to$work_code == seled, 15])
363
             val <- as.numeric(work_to[work_to$work_code == seled, 15])
359
             val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
364
             val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
360
-            str <- sprintf("%s<p>%d people commute <b>to</b> employment in</p>
361
-                            <p><b><u>%s</u></b></p>", str, val, namesel)
365
+            str <- sprintf("%s<p>%d people commute <b>to</b> employment in 
366
+                            <b><u>%s</u></b></p>", str, val, namesel)
362
             if (val > 0) {
367
             if (val > 0) {
363
               subs <- work_simp %>% filter(work_code == seled) %>%
368
               subs <- work_simp %>% filter(work_code == seled) %>%
364
                 arrange(desc(total)) %>% head(10)
369
                 arrange(desc(total)) %>% head(10)
371
           } else {
376
           } else {
372
             val <- as.numeric(work_from[work_from$res_code == seled, 15])
377
             val <- as.numeric(work_from[work_from$res_code == seled, 15])
373
             val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
378
             val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
374
-            str <- sprintf("%s<p>%d people commute to employment <b>from</b></p>
375
-                            <p><b><u>%s</u></b></p>", str, val, namesel)
379
+            str <- sprintf("%s<p>%d people commute to employment <b>from</b> 
380
+                            <b><u>%s</u></b></p>", str, val, namesel)
376
             if (val > 0) {
381
             if (val > 0) {
377
               subs <- work_simp %>% filter(res_code == seled) %>%
382
               subs <- work_simp %>% filter(res_code == seled) %>%
378
                 arrange(desc(total)) %>% head(10)
383
                 arrange(desc(total)) %>% head(10)
384
             }
389
             }
385
             
390
             
386
           }
391
           }
387
-          div(class="locinfo",
388
               HTML(str)
392
               HTML(str)
389
-          )
390
         }
393
         }
391
       } else {
394
       } else {
392
         if (input$radiocolour == "type") {
395
         if (input$radiocolour == "type") {
393
           str <- sprintf("<b>%s</b>", namesel)
396
           str <- sprintf("<b>%s</b>", namesel)
394
           if (input$radioinout == "work") {
397
           if (input$radioinout == "work") {
395
-            str <- sprintf("<p>Commuting method of people who<br/>go to 
396
-                           <b>education</b> in</p>
397
-                           <p><b><u>%s</u></b></p>", str)
398
+            str <- sprintf("<p>Commuting method of people who commute to 
399
+                           <b>education</b> in 
400
+                           <u>%s</u></p>", str)
398
             vals <- as.numeric(edu_to[edu_to$edu_code == seled, 5:15])
401
             vals <- as.numeric(edu_to[edu_to$edu_code == seled, 5:15])
399
             vals <- ifelse(is.na(vals), 0, vals)
402
             vals <- ifelse(is.na(vals), 0, vals)
400
             vals <- ifelse(vals < 0, "~0", as.character(vals))
403
             vals <- ifelse(vals < 0, "~0", as.character(vals))
403
                     collapse="")
406
                     collapse="")
404
             str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
407
             str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
405
           } else {
408
           } else {
406
-            str <- sprintf("<p>Commuting method to education<br/>
407
-                           of people who <b>live</b> in</p>
408
-                           <p><u>%s</u></p>", str)
409
+            str <- sprintf("<p>Commuting method to education
410
+                           of people who <b>live</b> in 
411
+                           <u>%s</u></p>", str)
409
             vals <- as.numeric(edu_from[edu_from$res_code == seled, 5:15])
412
             vals <- as.numeric(edu_from[edu_from$res_code == seled, 5:15])
410
             vals <- ifelse(is.na(vals), 0, vals)
413
             vals <- ifelse(is.na(vals), 0, vals)
411
             vals <- ifelse(vals < 0, "~0", as.character(vals))
414
             vals <- ifelse(vals < 0, "~0", as.character(vals))
420
           if (input$radioinout == "work") {
423
           if (input$radioinout == "work") {
421
             val <- as.numeric(edu_to[edu_to$edu_code == seled, 15])
424
             val <- as.numeric(edu_to[edu_to$edu_code == seled, 15])
422
             val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
425
             val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
423
-            str <- sprintf("%s<p>%d people commute <b>to</b> education in</p>
424
-                            <p><b><u>%s</u></b></p>", str, val, namesel)
426
+            str <- sprintf("%s<p>%d people commute <b>to</b> education in 
427
+                            <b><u>%s</u></b></p>", str, val, namesel)
425
             if (val > 0) {
428
             if (val > 0) {
426
               subs <- edu_simp %>% filter(edu_code == seled) %>%
429
               subs <- edu_simp %>% filter(edu_code == seled) %>%
427
                 arrange(desc(total)) %>% head(10)
430
                 arrange(desc(total)) %>% head(10)
434
           } else {
437
           } else {
435
             val <- as.numeric(edu_from[edu_from$res_code == seled, 15])
438
             val <- as.numeric(edu_from[edu_from$res_code == seled, 15])
436
             val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
439
             val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
437
-            str <- sprintf("%s<p>%d people commute to education <b>from</b></p>
438
-                            <p><b><u>%s</u></b></p>", str, val, namesel)
440
+            str <- sprintf("%s<p>%d people commute to education <b>from</b> 
441
+                            <b><u>%s</u></b></p>", str, val, namesel)
439
             if (val > 0) {
442
             if (val > 0) {
440
               subs <- edu_simp %>% filter(res_code == seled) %>%
443
               subs <- edu_simp %>% filter(res_code == seled) %>%
441
                 arrange(desc(total)) %>% head(10)
444
                 arrange(desc(total)) %>% head(10)
448
               
451
               
449
           }
452
           }
450
         }
453
         }
451
-        div(class="locinfo",
452
           HTML(str)
454
           HTML(str)
453
-        )
455
+      }
456
+    }
457
+  })
458
+  
459
+  output$secondarylochtml <- renderUI({
460
+    curshp <- mouseover()
461
+    cursel <- sel.SA2.code()
462
+    if (curshp == 0) {
463
+      if (cursel == 0) {
464
+        HTML(paste0(hrstr, 
465
+                  "<p><em>No area selected. Click on 
466
+                  an area for more information.</em></p>"))
467
+      } else {
468
+        HTML("")
469
+      }
470
+    } else {
471
+      shpname <- shpf@data$SA22018__1[curshp == shpf@data$SA22018_V1]
472
+      if (cursel == 0) {
473
+        if (input$radioeduemp == "Employment") {
474
+          if (input$radioinout == "res") {
475
+            fdf <- work_from %>% filter(res_code == curshp)
476
+            tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
477
+            ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
478
+            pmp <- ""
479
+            if (ttype != 0) {
480
+              pmp <- sprintf("Primary mode of transport: %s", 
481
+                             transport.t[ttype])
482
+            }
483
+            HTML(sprintf("%s<p><em>%d people commute to employment from 
484
+                         %s. %s</em></p>", hrstr, tot, shpname,
485
+                         pmp))
486
+          } else {
487
+            fdf <- work_to %>% filter(work_code == curshp)
488
+            tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
489
+            ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
490
+            pmp <- ""
491
+            if (ttype != 0) {
492
+              pmp <- sprintf("Primary mode of transport: %s", 
493
+                             transport.t[ttype])
494
+            }
495
+            HTML(sprintf("%s<p><em>%d people commute to employment in 
496
+                         %s. %s</em></p>", hrstr, tot, shpname,
497
+                         pmp))
498
+            
499
+          }
500
+        } else {
501
+          if (input$radioinout == "res") {
502
+            fdf <- edu_from %>% filter(res_code == curshp)
503
+            tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
504
+            ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
505
+            pmp <- ""
506
+            if (ttype != 0) {
507
+              pmp <- sprintf("Primary mode of transport: %s", 
508
+                             edu.t[ttype])
509
+            }
510
+            HTML(sprintf("%s<p><em>%d people commute to education from 
511
+                         %s. %s</em></p>", hrstr, tot, shpname,
512
+                         pmp))
513
+          } else {
514
+            fdf <- edu_to %>% filter(edu_code == curshp)
515
+            tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
516
+            ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
517
+            pmp <- ""
518
+            if (ttype != 0) {
519
+              pmp <- sprintf("Primary mode of transport: %s", 
520
+                             edu.t[ttype])
521
+            }
522
+            HTML(sprintf("%s<p><em>%d people commute to education in 
523
+                         %s. %s</em></p>", hrstr, tot, shpname,
524
+                         pmp))
525
+            
526
+          }
527
+          
528
+        }
529
+      } else {
530
+        shpname.0 <- shpf@data$SA22018__1[cursel == shpf@data$SA22018_V1]
531
+        if (input$radioeduemp == "Employment") {
532
+          if (input$radioinout == "res") {
533
+            fdf <- work_simp %>% filter(res_code == cursel,
534
+                                        work_code == curshp)
535
+            tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
536
+            ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
537
+            pmp <- ""
538
+            if (ttype != 0) {
539
+              pmp <- sprintf("Primary mode of transport: %s", 
540
+                             transport.t[ttype])
541
+            }
542
+            HTML(sprintf("%s<p><em>%d people commute to employment 
543
+                          in %s from %s. %s</em></p>", hrstr, tot, shpname,
544
+                         shpname.0, pmp))
545
+          } else {
546
+            fdf <- work_simp %>% filter(work_code == cursel,
547
+                                        res_code == curshp)
548
+            tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
549
+            ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
550
+            pmp <- ""
551
+            if (ttype != 0) {
552
+              pmp <- sprintf("Primary mode of transport: %s", 
553
+                             transport.t[ttype])
554
+            }
555
+            HTML(sprintf("%s<p><em>%d people commute to employment 
556
+                          in %s from %s. %s</em></p>", hrstr, tot, shpname.0,
557
+                         shpname, pmp))
558
+          }
559
+        } else {
560
+          if (input$radioinout == "res") {
561
+            fdf <- edu_simp %>% filter(res_code == cursel,
562
+                                        edu_code == curshp)
563
+            tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
564
+            ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
565
+            pmp <- ""
566
+            if (ttype != 0) {
567
+              pmp <- sprintf("Primary mode of transport: %s", 
568
+                             edu.t[ttype])
569
+            }
570
+            HTML(sprintf("%s<p><em>%d people commute to education 
571
+                          in %s from %s. %s</em></p>", hrstr, tot, shpname,
572
+                         shpname.0, pmp))
573
+          } else {
574
+            fdf <- edu_simp %>% filter(edu_code == cursel,
575
+                                        res_code == curshp)
576
+            tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
577
+            ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
578
+            pmp <- ""
579
+            if (ttype != 0) {
580
+              pmp <- sprintf("Primary mode of transport: %s", 
581
+                             edu.t[ttype])
582
+            }
583
+            HTML(sprintf("%s<p><em>%d people commute to education 
584
+                          in %s from %s. %s</em></p>", hrstr, tot, shpname.0,
585
+                         shpname, pmp))
586
+          }
587
+        }
588
+        
454
       }
589
       }
455
     }
590
     }
456
   })
591
   })

+ 18
- 0
viz/extras.R View File

30
 #mapcontrol, #control2 {
30
 #mapcontrol, #control2 {
31
   z-index: 1000;
31
   z-index: 1000;
32
 }
32
 }
33
+#mapcontrol {
34
+  width: 22em;
35
+  max-height: 90%;
36
+  overflow: auto;
37
+  -ms-overflow-style: none;  /* IE and Edge */
38
+  scrollbar-width: none;  /* Firefox */
39
+}
40
+#mapcontrol::-webkit-scrollbar {
41
+  display: none;
42
+}
33
 #infopanel {
43
 #infopanel {
34
   display: none;
44
   display: none;
35
   background-color: rgba(255, 255, 255, 0.9);
45
   background-color: rgba(255, 255, 255, 0.9);
94
 .locinfo {
104
 .locinfo {
95
   max-width: 100%;
105
   max-width: 100%;
96
 }
106
 }
107
+.loading p {
108
+  margin: 0;
109
+}
110
+hr {
111
+  margin-top: 10px;
112
+  margin-bottom: 10px;
113
+  border-top: 1px solid #000;
114
+}
97
 "
115
 "
98
 
116
 
99
 attribhtml <- '
117
 attribhtml <- '