04_crosstalk_flexdashboard.Rmd

---
title: "HTS Households with crosstalk"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    source_code: embed
    vertical_layout: fill
---

```{r setup, include=FALSE}

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

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

source('tmrtools.R')

# Create 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)]


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

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


# Wrap data frame in SharedData
sd = SharedData$new(hh_map)

```

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.  

*** 

Select income range(s) of interest

```{r}
# Create a filter input
filter_checkbox(
  id="income", 
  label="Income", 
  sharedData=sd,
  group=~income_aggregate)
```


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

### Interactive maps with `leaflet`

```{r}

leaflet(sd) %>%
  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=sd,
  extensions="Scroller",
  style="bootstrap",
  class=c("display", "compact"),
  rownames=FALSE,
  width="100%",
   options=list(
     deferRender=TRUE,
     scrollY=300,
     scroller=TRUE,
     searching=TRUE)
)

```