rTED_2020/03_flexdashboard.Rmd at main · landisrm/rTED_2020 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
---
title: "HTS Households with flexdashboard"
output:
  flexdashboard::flex_dashboard:
    orientation: columns
    source_code: embed
    vertical_layout: fill
---

```{r setup, include=FALSE}

# Load packages ----------------------------------------------------------------

library(data.table)
library(leaflet)
library(DT)

source('tmrtools.R')

# Create data -----------------------------------------------------------------

# Load data
hh_labeled = readRDS('data/tnc_bayarea_hh_labeled.rds')
hh_map = hh_labeled[
  !income_aggregate %in% c('Prefer not to answer', 'Missing: Non-response', 'Missing: Skip logic') & !is.na(income_aggregate)]

hh_table = hh_labeled[, .(hh_id, num_people, income_aggregate, rent_own, res_type)]

# Define map palette  -------------------------------------------------------

income_levels = levels(factor(hh_map[, income_aggregate]))
pal = colorFactor(
  colorRampPalette(
    get_rsg_palette('hot')
    )(length(income_levels)),
  levels=income_levels)

```

Column {.sidebar}
-----------------------------------------------------------------------

### About:

This is a demonstration project to show how to interact with household travel survey data.  The project and all source code is available on [Github](https://github.com/landisrm/rTED_2020).

Note: These data have been fully anonymized by randomizing the ids, locations, and descriptive variables.  In addition the actual locations have been jittered.

***


Column {data-width=500}
-----------------------------------------------------------------------

### Interactive maps with `leaflet`

```{r}

leaflet(hh_map) %>%
  addTiles() %>%
  addCircleMarkers(
    lng=~reported_home_lon,
    lat=~reported_home_lat,
    stroke=FALSE,
    radius=5,
    fillOpacity=0.5,
    color=~pal(income_aggregate),
    popup = ~paste0(
           'hh_id: ', hh_id, '<br>',
           'income: ', income_detailed, '<br>')) %>%
  addLegend(pal=pal, values=~income_aggregate, opacity=0.5)

```

Column {data-width=500}
-----------------------------------------------------------------------

### Interactive tables with `DT`

```{r}
datatable(
  data=hh_table,
  extensions="Scroller",
  style="bootstrap",
  class=c("display", "compact"),
  rownames=FALSE,
  width="100%",
   options=list(
     deferRender=TRUE,
     scrollY=300,
     scroller=TRUE,
     searching=TRUE)
  )
```