91_shiny_flexdashboard.Rmd

---
title: "HTS Households using Shiny"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    source_code: embed
runtime: shiny_prerendered
---

```{r global, context='data', include=FALSE}

library(data.table)
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)

```

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, context='render'}

checkboxGroupInput(
  inputId="income",
  label = "Income",
  choices = income_levels, 
  selected = income_levels)
```

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

### Interactive maps with `leaflet`

```{r, context='render'}
leafletOutput(outputId='map')

```

```{r, context='server'}

data_filtered = reactive({
  hh_map[income_aggregate %in% input$income]
})

output$map = renderLeaflet({
  
leaflet(data_filtered()) %>%
  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, context='render'}
DTOutput(outputId='dt')
```

```{r, context='server'}

output$dt = renderDataTable({
  
  datatable(
    data=data_filtered(),
    extensions="Scroller",
    style="bootstrap",
    class=c("display", "compact"),
    rownames=FALSE,
    width="100%",
    options=list(
      #deferRender=TRUE,
      scrollY='650px',
      scroller=TRUE,
      searching=TRUE)
  )
  
  
})
```