---
output: 
  bookdown::html_document2
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)

# load cleaned data
d <- readRDS("rides_weather.rds")

```

```{=html}
<style>

.main-container {
  min-width: 900px;
  max-width: 1600px;

}

a {
  color: #bbbbbb;
}

.gridlayout { 
  display: grid;
  position: relative;
  margin: 10px;
  gap: 10px;
  grid-template-columns: 
    repeat(8, minmax(0, 1fr));
  grid-template-rows: 
    repeat(8, minmax(0, auto));
}

.gridlayout * {
  max-width: 100%;
  object-fit: contain;
}

.title {
  grid-column: 1 / 9;
  grid-row: 1 / 2;
  font-size: 30pt;
  font-weight: 900;
}

.lefttoptext {
  grid-column: 1 / 2;
  grid-row: 4 / 5;
  hyphens: auto;
  text-align: justify;
  font-size: 10pt;
  line-height: 1.4;
}

.righttoptext {
  grid-column: 3 / 4;
  grid-row: 4 / 5;
  hyphens: auto;
  text-align: justify;
  font-size: 10pt;
  line-height: 1.4;
}

.leftbottomtext {
  grid-column: 1 / 2;
  grid-row: 6 / 7;
  hyphens: auto;
  text-align: justify;
  font-size: 10pt;
  line-height: 1.4;
}

.rightbottomtext {
  grid-column: 3 / 4;
  grid-row: 6 / 7;
  hyphens: auto;
  text-align: justify;
  font-size: 10pt;
  line-height: 1.4;
}

.rightinteractive {
  grid-column: 5 / 9;
  grid-row: 3 / 8;
}

.instructions {
  grid-column: 5 / 9;
  grid-row: 2 / 3;
  font-size: 10pt;
  line-height: 1.4;
  color: #888888;
  column-count: 2;
  column-gap: 30px;
  hyphens: auto;
  text-align: justify;
}

.citesource {
  color: #bbbbbb;
  text-align: right;
  grid-column: 3 / 9;
  grid-row: 8 / 9;
  font-size: 8pt;
}

</style>
```
::: {.gridlayout}
::: {.title}
Explore conditions of January, CitiBike<br>ridership for segmentation and targeting.
:::

::: {.instructions}
[How to explore :]{style="color: #000000; font-weight: 900;"} **Hovering** over any line will link the four variables --- *weather*, *rides per minute*, *average age*, and *percent female* --- and identify the *date* and *weekday* selected. [Quick takes :]{style="color: #000000; font-weight: 900;"} The morning and evening weekday peak commutes stand out from weekends, of course. But more interestingly, on New Year's Day, our warmest of the month, you'll find a significant swing in average age `r sparkline::sparkline(round(d$avg_age[d$date=="2019-01-01"], digits = 0 ), lineColor = "black", fillColor = NA, lineWidth = 3)` as [night]{style="background:#eeeeee;"} became morning; were our younger commuters out late, sleeping in? Below are ***smoothed functions*** of the data.
:::

::: {.lefttoptext}
Do rider **attributes** correlate with lower usage? Are we missing key target audiences?
:::

::: {.righttoptext}
Are there better **temperatures** for us to trigger marketing messages to encourage rides?
:::

::: {.leftbottomtext}
How can we **segment** our audience to find opportunities for increasing ridership?
:::

::: {.rightbottomtext}
Are there better **times of day** for us to trigger marketing messages to encourage rides?
:::

::: {.citesource}
The lines show cubic splines, smoothing variation of each variable over the day. Sources: <a href="https://www.citibikenyc.com/system-data">NYC Open Data</a>,<br><a href="https://www.theopenbus.com/raw-data.html">The Open Bus project</a>, and <a href="https://www.wunderground.com/history/daily/KLGA/date/2019-1-1">Weather Underground</a>. 2019 January 1-31. Design and code by <a hraf="https://ssp3nc3r.github.io">Scott Spencer</a>. 2021 March 31.
:::

::: {.rightinteractive}
```{r}
# we loaded the data d in the top code chunk of this file

# here are the libraries and default theme settings
library(ggplot2)
library(ggthemes)
theme_set(
  theme_tufte(
    base_family = "sans", 
    base_size = 16/.pt) + 
    theme(axis.ticks = element_blank(),
          axis.text = element_text(face = "bold")))
library(patchwork)
library(ggiraph)

# save ggplot of rides per minute ~ time of day | date
p_riderate <- 
  ggplot(d) +
  geom_rect(
    mapping = aes(
      xmin = hms::as_hms("00:50:00"),
      xmax = hms::as_hms("07:20:00"),
      ymin = 0,
      ymax = 61
    ),
    fill = "#efefef"
  ) +
  geom_rect(
    mapping = aes(
      xmin = hms::as_hms("16:48:00"),
      xmax = hms::as_hms("24:00:00"),
      ymin = 0,
      ymax = 61
    ),
    fill = "#efefef"
  ) +
  geom_smooth_interactive(
    mapping = aes(
      x = time_weather, 
      y = rides_minute, 
      group = date,
      data_id = date,
      # this was a quick and dirty approach to making a tooltip, but is ugly and the code is duplicated four times (for four plots)
      # making one with package flextable would be much better
      # https://ardata-fr.github.io/flextable-book/index.html
      # google for how it's used in this context
      tooltip = paste(
        paste0('<span style="border-bottom: 1px solid; font-weight: 900;">', format(as.Date(date), '%A %B %d'), '</span>'),
        paste0('<span style="color:gray;">Daily averages<br><br></span><span style="color:dodgerblue;">Temperature, </span>', round(daily_avg_temp, digits = 0)),
        paste0('<span style="color:dodgerblue;">Rides / minute, </span>', round(daily_avg_rate, digits = 0)),
        paste0('<span style="color:dodgerblue;">Age, </span>', round(daily_avg_age, digits = 0)),
        paste0('<span style="color:dodgerblue;">Percent female, </span>', round(daily_frac_female * 100, digits = 0)),
        sep = '\n'
      )), 
    se = F, 
    color = "black", 
    size = 0.3, 
    method = "gam",
    formula = y ~ s(x, bs = "cs")) +
  scale_x_time(name = "", 
               breaks = NULL,
               expand = c(0,0)) +
  scale_y_continuous(name = "Rides / minute")

# save ggplot of rides per minute ~ time of day | date
p_temp <- 
  ggplot(d) +
  geom_rect(
    mapping = aes(
      xmin = hms::as_hms("00:50:00"),
      xmax = hms::as_hms("07:20:00"),
      ymin = 0,
      ymax = 61
    ),
    fill = "#efefef"
  ) +
  geom_rect(
    mapping = aes(
      xmin = hms::as_hms("16:48:00"),
      xmax = hms::as_hms("24:00:00"),
      ymin = 0,
      ymax = 61
    ),
    fill = "#efefef"
  ) +
  geom_smooth_interactive(
    mapping = aes(
      x = time_weather, 
      y = avg_temp, 
      group = date,
      data_id = date,
      tooltip = paste(
        paste0('<span style="border-bottom: 1px solid; font-weight: 900;">', format(as.Date(date), '%A %B %d'), '</span>'),
        paste0('<span style="color:gray;">Daily averages<br><br></span><span style="color:dodgerblue;">Temperature, </span>', round(daily_avg_temp, digits = 0)),
        paste0('<span style="color:dodgerblue;">Rides / minute, </span>', round(daily_avg_rate, digits = 0)),
        paste0('<span style="color:dodgerblue;">Age, </span>', round(daily_avg_age, digits = 0)),
        paste0('<span style="color:dodgerblue;">Percent female, </span>', round(daily_frac_female * 100, digits = 0)),
        sep = '\n'
      )), 
    se = F, 
    color = "black", 
    size = 0.3, 
    method = "gam",
    formula = y ~ s(x, bs = "cs")) +
  scale_x_time(name = "", 
               breaks = NULL,
               expand = c(0,0)) +
  scale_y_continuous(name = "Weather, degrees F")

# save ggplot of average age ~ time of day | date
p_age <- 
  ggplot(d) +
  geom_rect(
    mapping = aes(
      xmin = hms::as_hms("00:50:00"),
      xmax = hms::as_hms("07:20:00"),
      ymin = 34,
      ymax = 45
    ),
    fill = "#efefef"
  ) +
  geom_rect(
    mapping = aes(
      xmin = hms::as_hms("16:48:00"),
      xmax = hms::as_hms("24:00:00"),
      ymin = 34,
      ymax = 45
    ),
    fill = "#efefef"
  ) +
  geom_smooth_interactive(
    mapping = aes(
      x = time_weather, 
      y = avg_age, 
      group = date,
      data_id = date,
      tooltip = paste(
        paste0('<span style="border-bottom: 1px solid; font-weight: 900;">', format(as.Date(date), '%A %B %d'), '</span>'),
        paste0('<span style="color:gray;">Daily averages<br><br></span><span style="color:dodgerblue;">Temperature, </span>', round(daily_avg_temp, digits = 0)),
        paste0('<span style="color:dodgerblue;">Rides / minute, </span>', round(daily_avg_rate, digits = 0)),
        paste0('<span style="color:dodgerblue;">Age, </span>', round(daily_avg_age, digits = 0)),
        paste0('<span style="color:dodgerblue;">Percent female, </span>', round(daily_frac_female * 100, digits = 0)),
        sep = '\n'
      )), 
    se = F, 
    color = "black", 
    size = 0.3, 
    method = "gam",
    formula = y ~ s(x, bs = "cs")) +
  scale_x_time(name = "", 
               breaks = NULL,
               expand = c(0,0)) +
  scale_y_continuous(name = "Average age")

# save ggplot of fraction female ~ time of day | date
p_female <- 
  ggplot(d) +
  geom_rect(
    mapping = aes(
      xmin = hms::as_hms("00:50:00"),
      xmax = hms::as_hms("07:20:00"),
      ymin = 0,
      ymax = 35
    ),
    fill = "#efefef"
  ) +
  geom_rect(
    mapping = aes(
      xmin = hms::as_hms("16:48:00"),
      xmax = hms::as_hms("24:00:00"),
      ymin = 0,
      ymax = 35
    ),
    fill = "#efefef"
  ) +
  geom_smooth_interactive(
    mapping = aes(
      x = time_weather, 
      y = frac_female * 100, 
      group = date,
      data_id = date,
      tooltip = paste(
        paste0('<span style="border-bottom: 1px solid; font-weight: 900;">', format(as.Date(date), '%A %B %d'), '</span>'),
        paste0('<span style="color:gray;">Daily averages<br><br></span><span style="color:dodgerblue;">Temperature, </span>', round(daily_avg_temp, digits = 0)),
        paste0('<span style="color:dodgerblue;">Rides / minute, </span>', round(daily_avg_rate, digits = 0)),
        paste0('<span style="color:dodgerblue;">Age, </span>', round(daily_avg_age, digits = 0)),
        paste0('<span style="color:dodgerblue;">Percent female, </span>', round(daily_frac_female * 100, digits = 0)),
        sep = '\n'
      )), 
    se = F, 
    color = "black", 
    size = 0.3, 
    method = "gam",
    formula = y ~ s(x, bs = "cs")) +
  scale_x_time(name = "Time of day",
               breaks = scales::date_breaks("60 mins"),
               labels = seq(0, 24),
               expand = c(0,0)) +
  scale_y_continuous(name = "Percent Female",
                     breaks = seq(0, 35, by = 10),
                     expand = c(0,0))

# here we bind those interactive layers to css and svg elements using 
# package ggiraph and this function. Notice the forward slashes are
# functions from the patchwork package
# can add animation, e.g.,  transition:0.5s ease-in-out;
girafe(
  code = print(p_temp / p_riderate / p_age / p_female),
  options = list(
  opts_hover(css = "stroke-width:2;"),
  opts_hover_inv(css = "stroke-opacity:0.1;"),
  opts_tooltip(
    css = 'background-color:white;color:black;font-size:8pt;padding:10px;',
    offx = 10,
    offy = 10
    ),
  opts_toolbar(saveaspng = FALSE)
  ))

```
:::
:::