---
title: "Assessing Canada’s Drug Shortage Problem"
author: "Jon Pipitone "
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    source_code: embed
---

```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse, warn.conflicts = FALSE)
library(lubridate)
library(DT)
library(fuzzyjoin)

# settings
FAR_FUTURE = parse_datetime("2100-01-01")
FAR_PAST = parse_datetime("1970-01-01")
theme_set(theme_minimal())
sources = list(labs(caption = "source: drugshortagescanada.ca\nauthor: Jon Pipitone, 2020"))

# load data
DSCDATA= "data/dsc_shortages_2020-12-29.csv"
dsc_df = read_csv(DSCDATA, col_types = cols(
  status = col_factor(),
  shortage_reason_en = col_factor())) %>%
  mutate(
    reason = fct_recode(shortage_reason_en,  
      "Demand increase" = "Demand increase for the drug.", 
      "Manufacturing distruption" = "Disruption of the manufacture of the drug.",
      "Ingredient shortage" = "Shortage of an active ingredient.", 
      "Ingredient shortage" = "Shortage of an inactive ingredient or component.",
      "Manufacturing practices" = "Requirements related to complying with good manufacturing practices.",
      "Other" = "Other (Please describe in comments)",
      "Shipping delay" = "Delay in shipping of the drug." 
    ) 
  ) %>%
  mutate(
    end_date_no_na = coalesce(actual_end_date, estimated_end_date, FAR_FUTURE), 
    start_date_no_na = coalesce(actual_start_date, anticipated_start_date, FAR_PAST))
```

Column
-----------------------------------------------------------------------

### Total number of drugs in shortage over time
```{r}
time.by.month = tibble(
  month = seq(parse_datetime("2017-01-01"), parse_datetime("2020-01-01"), by = "month"), 
  i = 1
)
# https://community.rstudio.com/t/tidy-way-to-range-join-tables-on-an-interval-of-dates/7881
shortages.by.month = 
  dsc_df %>%
  mutate(i = 1) %>%
  full_join(time.by.month, by = "i") %>%
  filter(month %within% interval(floor_date(actual_start_date, "month"), end_date_no_na)) %>%
  group_by(month) %>%
  summarize(n = n())

ggplot(shortages.by.month, aes(x = month, y = n)) + 
  geom_point() + geom_line() + 
  labs(x = "Date", y = "Number of drugs in shortage") + 
  sources
```

### Shortage start date

```{r, fig.asp=0.70}
dsc_df %>% 
  mutate(Month = floor_date(actual_start_date, "month")) %>% 
  filter(between(actual_start_date, parse_datetime("2017-01-01"), parse_datetime("2020-01-01")), 
         status != "avoided_shortage") %>%
  group_by(Month, status) %>% 
  summarize(count = n()) %>%
  ggplot(aes(x=Month, y = count, fill = status)) + 
    #geom_point() + geom_line() +  
    geom_col(position="stack") + 
    scale_x_datetime(
      date_breaks = "1 year", 
      date_labels = "%Y") + 
    theme(legend.position="bottom") +
    labs(x = "Shortage start date", y = "Number of shortages", fill = "Current status") + 
    sources
```

Column 
-----------------------------------------------------------------------

### Duration of shortages
```{r}
data = dsc_df %>%
  filter(status %in% c("active_confirmed", "resolved")) %>%
  mutate(duration = interval(actual_start_date, actual_end_date)/weeks(1), 
         year = year(actual_start_date)) %>%
  filter(duration > 0, year >= 2017)

data %>%
  ggplot(aes(x = ceiling(duration))) + 
    geom_histogram(bins=50, position="identity") + 
    facet_grid(. ~ year) + 
    labs(fill = "Year", x = "Duration (weeks)", y = "# of shortages") + 
    theme(legend.position = "none") + 
    sources
```


### Shortage start date by reason

```{r, fig.asp=0.70}
dsc_df %>% 
  mutate(Month = floor_date(actual_start_date, "month"), 
         Reason = fct_rev(fct_infreq(reason))) %>%
  ggplot(aes(x=Month, fill = Reason)) + 
  geom_bar() + 
  xlim(parse_datetime("2017-01-01"), parse_datetime("2020-01-01")) + 
  theme(legend.position="bottom", legend.direction="horizontal") + 
  labs(x = "Shortage start date", y="Number of shortages") + 
  sources
```

Column {data-width=350}
-----------------------------------------------------------------------

### Active shortages
```{r}
active_shortages = dsc_df %>% 
  filter(
    status == "active_confirmed", 
    now() %within% interval(actual_start_date, end_date_no_na))
valueBox(nrow(active_shortages), icon="fa-capsules")
```

### Anticipated shortages next week
```{r}
week_start = floor_date(now(), "week")
this_week = interval(week_start, week_start + weeks(1))
next_week = int_shift(this_week, by = weeks(1))
expected_shortages = dsc_df %>% 
  filter(
    int_overlaps(next_week, interval(actual_start_date, end_date_no_na)))
valueBox(nrow(expected_shortages), icon="fa-clock")
```

### Summary (via the database)

```{r}
knitr::kable(dsc_df %>% group_by(status) %>% summarize(n = n()))
```