dashboard.Rmd

---
title: "Example Dashboard"
output: 
  flexdashboard::flex_dashboard:
    vertical_layout: scroll
knit: (function(inputFile, encoding) { rmarkdown::render(inputFile, encoding=encoding, output_dir = "output") })
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(
  # cache = TRUE,
  fig.height = 5,
  echo = FALSE
)

library(crosstalk)
library(dplyr)
library(glue)
library(plotly)
```

```{js}
const setDefaultValue = function(filterId, defaultValue) {
  window.addEventListener("load", function(event) { 
    document.getElementById(filterId).getElementsByClassName("selectized")[0].selectize.setValue(defaultValue, false);
  });
};
```

# Overview

## Column

### Background

This is an example of an interactive dashboard built using 
[R Markdown](https://rmarkdown.rstudio.com/), 
[flexdashboard](https://pkgs.rstudio.com/flexdashboard/), 
[Plotly](https://plotly-r.com/), and
[crosstalk](https://rstudio.github.io/crosstalk/).

It's probably most useful to look at this in conjunction with [the source code on GitHub](https://github.com/igelstorm/static-dashboard) and [a blog post I wrote](https://www.erikigelstrom.com/articles/interactive-dashboards-in-r-without-shiny) about some aspects of the implementation.

# Daily time series

## Sidebar {.sidebar}

```{r}
daily_totals <- readRDS("output/results/daily_totals.rds")

shared_data <- daily_totals %>%
  group_by(carrier) %>%
  SharedData$new()

filter_select("daily_time_series_origin", "Choose an airport", shared_data, ~origin, multiple = FALSE)
filter_select(
  "daily_time_series_carrier",
  "Choose carrier",
  shared_data,
  ~carrier,
  multiple = TRUE
)
```
```{js}
setDefaultValue("daily_time_series_origin", "JFK");
setDefaultValue("daily_time_series_carrier", "All carriers");
```

## Column

### Number of flights

```{r}
shared_data %>%
  plot_ly(type = "scatter", x = ~month_name, y = ~n,
          color = ~carrier, name = ~carrier,
          mode = "markers+lines", colors = unname(pals::glasbey())
  ) %>%
  layout(
    yaxis = list(title = "", fixedrange = TRUE),
    xaxis = list(title = "Flights", rangeslider = list(type = "date"))
  )
```

### Delayed flights

```{r}
shared_data %>%
  plot_ly(type = "scatter", x = ~month_name, y = ~n_delayed,
          color = ~carrier, name = ~carrier,
          mode = "markers+lines", colors = unname(pals::glasbey())
  ) %>%
  layout(
    yaxis = list(title = "", fixedrange = TRUE),
    xaxis = list(title = "Delayed flights", rangeslider = list(type = "date"))
  )
```

# Top destinations

```{r}
top_destinations <- readRDS("output/results/top_destinations.rds")
shared_data <- top_destinations %>%
  arrange(carrier, n) %>%
  SharedData$new()
```

## Sidebar {.sidebar}

```{r}
filter_select("top_destinations_carrier", "Choose a carrier", shared_data, ~carrier, multiple = FALSE)
```

```{js}
setDefaultValue("top_destinations_carrier", "AA");
```

## Column

### Top destinations by carrier

```{r}
shared_data %>%
  plot_ly() %>%
  add_bars(x = ~n, y = ~dest, text = ~n, textposition = "outside", cliponaxis = FALSE, name = ~carrier, color = I("darkblue")) %>%
  layout(
    yaxis = list(title = "", categoryorder = "trace"),
    showlegend = FALSE
  )
```

# Fancy top destinations

```{r}
fancy_top_destinations <- readRDS("output/results/fancy_top_destinations.rds")
shared_data <- fancy_top_destinations %>%
  arrange(carrier, n) %>%
  SharedData$new()
```

## Sidebar {.sidebar}

```{r}
filter_select("fancy_top_dest_carrier", "Choose a carrier", shared_data, ~carrier, multiple = FALSE)
```

```{js}
setDefaultValue("fancy_top_dest_carrier", "AA");
```

## Column

### Top destinations by carrier

```{r}
p1 <- shared_data %>%
  plot_ly() %>%
  add_bars(x = ~carrier_share, y = ~dest, text = ~scales::percent(carrier_share, 0.1), textposition = "outside", cliponaxis = FALSE, name = ~carrier, color = I("darkblue")) %>%
  layout(
    yaxis = list(title = "", categoryorder = "trace"),
    showlegend = FALSE
  )
p2 <- shared_data %>%
  plot_ly() %>%
  add_bars(x = ~carrier_diff_from_mean, y = ~dest, text = ~scales::percent(carrier_diff_from_mean, 0.1), textposition = "outside", cliponaxis = FALSE, name = ~glue("Difference from average"), color = I("dimgray")) %>%
  layout(showlegend = TRUE)

subplot(p1, p2, shareY = TRUE) %>%
  layout(
    yaxis = list(showgrid = T),
    xaxis = list(
      title = "Proportion of flights",
      tickformat = ".0%"
    ),
    xaxis2 = list(
      title = "Percentage points",
      tickformat = ".0%"
    )
  ) %>%
  highlight(on = NULL) %>%
  suppressWarnings()
```

# Top destinations GONE WRONG

```{r}
top_destinations <- readRDS("output/results/top_destinations.rds")
shared_data <- top_destinations %>%
  arrange(carrier, n) %>%
  SharedData$new()
```

## Sidebar {.sidebar}

```{r}
filter_select("bad_top_destinations_carrier", "Choose a carrier", shared_data, ~carrier, multiple = FALSE)
```

## Column

### Top destinations by carrier

```{r}
shared_data %>%
  plot_ly() %>%
  add_bars(x = ~n, y = ~dest, text = ~n, textposition = "outside", cliponaxis = FALSE, name = ~carrier, color = I("darkblue")) %>%
  layout(
    yaxis = list(title = "", categoryorder = "trace"),
    showlegend = FALSE
  )
```

### What is this?

This is a demonstration of how terribly wrong things can go if you don't manage to set a default value for the controls on a page: before the user selects an airline, they can see all the data at once, which is really not what we want. The [Top destinations](#top-destinations) page shows how it *should* work.