progressdash.Rmd

---
title: "MOSAIC Study Progress"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    theme: cosmo
    logo: favicon_48x48.png
    favicon: favicon_48x48.png
---

<style>                     
.navbar {
  background-color:#003D79;
  border-color:white;
}
.navbar-brand {
color:white!important;
}
</style>   

<style type="text/css">

.chart-title {  /* chart_title  */
   font-size: 15px

</style>

```{r setup, include=FALSE}
library(flexdashboard)
library(plotly)
library(highcharter)
library(treemap)
library(knitr)
library(scales)
library(glue)
library(googleVis)

source("R/datamgmt_progress.R")
source("R/plot_asmts_comp.R")

mosaic_pal <- c(
  ## Row 1, starting with leftmost diamond
  "blue1" = "#283C72", "blue2" = "#243E8B", "blue3" = "#0477BF",
  "green1" = "#8EC63E", "green2" = "#3BB547",
  ## Row 2
  "blue4" = "#24ADCD", "blue5" = "#0976B7", "blue6" = "#23AEDD",
  "green3" = "#3BB54A", "green4" = "#1A653E",
  ## Row 3
  "orange1" = "#E76A32", "orange2" = "#F69723", "orange3" = "#FA961F",
  "orange4" = "#FBCD93", "ecru" = "#FFF8DE",
  ## Row 4
  "red1" = "#D71A60", "red2" = "#F27074", "red3" = "#EC835F",
  "gray1" = "#E4DAD1", "gray2" = "#F7F5EB",
  ## Row 5
  "red4" = "#C0232C", "red5" = "#EE1C27", "red6" = "#FF686D",
  "red7" = "#F8D4D1", "cream" = "#FEFEFC"
)

## Function to get hex for a specific element
mosaic_col <- function(hex){ as.character(mosaic_pal[hex]) }

## Colors for assessment plots
asmt_values = c(
  "Excellent" = mosaic_col("green4"),
  "Okay" = mosaic_col("orange3"),
  "Uh-oh" = mosaic_col("red5")
)

## Named vector of colors for exclusions
exc_colors <- c(
  ">5 hospital days in last 30" = mosaic_col("blue1"),
  "Severe neurologic injury" = mosaic_col("blue3"),
  "Death within 24h/hospice" = mosaic_col("blue4"),
  "Rapidly resolving organ failure" = mosaic_col("blue5"),
  "BMI > 50" = mosaic_col("red1"),
  "Substance abuse, etc" = mosaic_col("red2"),
  "Blind, deaf, English" = mosaic_col("red3"),
  "Prisoner" = mosaic_col("red4"),
  "Inability to live independently" = mosaic_col("red5"),
  "Homeless" = mosaic_col("red6"),
  "Patient/surrogate refusal" = mosaic_col("green4"),
  "No surrogate within 72h" = mosaic_col("green1"),
  "Attending refusal" = mosaic_col("green3"),
  ">72h eligibility prior to screening" = mosaic_col("green4"),
  "Lives >150 miles from VUMC" = mosaic_col("orange1"),
  "Study with no co-enrollment" = mosaic_col("orange2"),
  "Other" = mosaic_col("orange3")
)

## Manually set width, height for screening/enrollment over time plots
screenplot_wd <- 640
screenplot_ht <- 325

```

Screening & Enrollment
=====================================

Column {data-width=60%}
-----------------------------------------------------------------------

### Patients Screened, Approached, and Enrolled

```{r nodate_ids}
nodate_ids <- unique(c(exc_id_nodate, enroll_id_nodate))

nodate_statement <- ifelse(
  length(nodate_ids > 0),
  paste(
    "These IDs have no exclusion/enrollment date entered and are not included:",
    paste(nodate_ids, collapse = "; ")
  ),
  ""
)

```

`r nodate_statement`

```{r screening}
## Want figure to start in March 2017
screening_myears <- unique(screening_summary$myear)
screening_myears_num <- 1:length(screening_myears)
names(screening_myears_num) <- screening_myears

## X axis labels: character versions of unique months of enrollment
## Applies to both screening and exclusion charts
screening_xlabs <- exc_over_time %>%
    dplyr::select(myear, myear_char) %>%
  distinct() %>%
  pull(myear_char)

## Which months to use on X axes? (After a year of enrollment, axis labels
## getting crowded)
use_xlabs <- seq(1, length(screening_xlabs), 2)

screening_summary <- screening_summary %>%
  mutate(myear_num = screening_myears_num[myear])

x_screen <- list(
  tickvals = as.numeric(screening_myears_num)[use_xlabs],
  ticktext = screening_xlabs[use_xlabs],
  title = ""
)
y <- list(title = "")

screen_plotly <- plot_ly(
  data = screening_summary,
  x = ~ myear_num,
  y = ~ Screened,
  type = "bar",
  name = "Screened",
  color = I(mosaic_col("red5")),
  alpha = 0.75,
  hoverinfo = "text",
  text = ~ sprintf("%s, Screened: %s", myear_char, Screened)
) %>%
  add_bars(
    y = ~ Approached,
    name = "Approached",
    color = I(mosaic_col("orange3")),
    hoverinfo = "text",
    text = ~ sprintf("%s, Approached: %s", myear_char, Approached)
  ) %>%
  add_bars(
    y = ~ Enrolled,
    name = "Enrolled",
    color = I(mosaic_col("green4")),
    hoverinfo = "text",
    text = ~ sprintf("%s, Enrolled: %s", myear_char, Enrolled)
  )

screen_plotly %>%
  layout(legend = list(x = 0, y = 0.95, bgcolor='transparent'),
         xaxis = x_screen, yaxis = y)

```

### Study Exclusions (% of All Patients Excluded)

```{r exclusions_over_time}
## plotly needs x value to be numeric to sort properly?
exc_myears <- sort(unique(exc_over_time$myear))
exc_myears_num <- 1:length(exc_myears)
names(exc_myears_num) <- exc_myears

exc_over_time <- exc_over_time %>%
  mutate(myear_num = exc_myears_num[myear])

x_exc <- list(tickvals = as.numeric(exc_myears_num)[use_xlabs],
              ticktext = screening_xlabs[use_xlabs],
              title = "")
y_exc <- list(tickvals = seq(0, 100, 20),
              ticktext = paste0(seq(0, 100, 20), "%"),
              title = "Percent of Exclusions")

exc_plotly <- plot_ly(
  data = exc_over_time,
  x = ~ myear_num,
  y = ~ Percent,
  type = "scatter",
  mode = "lines+markers",
  color = ~ Reason,
  colors = exc_colors,
  alpha = 0.6,
  hoverinfo = "text",
  text = ~ sprintf("%s, %s: %s%%", myear_char, Reason, Percent)
)

exc_plotly %>%
  layout(showlegend = FALSE,
         xaxis = x_exc,
         yaxis = y_exc)

```

Column {data-width=40%}
-----------------------------------------------------------------------

### Cumulative Enrollment as of `r format(Sys.Date(), "%B %d, %Y")` {data-height=40%}

```{r enrollment}
screening_statement <- sprintf(
  "We have screened %s patients; %s%% were excluded and %s%% approached. Of those approached, %s%% refused consent and %s%% were enrolled.",
  format(n_screened, big.mark = ","),
  round(pct_excluded*100),
  round(pct_approached*100),
  round(pct_refused*100),
  round(pct_enrolled*100)
)

enroll_gauge <- gauge(
  value = n_enrolled,
  min = 0,
  max = n_goal,
  sectors = gaugeSectors(colors = mosaic_col("green1")),
  label = "patients"
)

enroll_gauge

```
<br>
`r screening_statement`

### Cumulative Exclusions (Total: `r format(nrow(exc_df), big.mark = ",")`) {data-height=60%}

```{r exclusions_cumulative}
tm_exc <- treemap(dtf = exc_cumul,
                  index = c("reason_type", "Reason"),
                  vSize = "n_reason",
                  type = "index",
                  title = "",
                  algorithm = "squarified",
                  palette = mosaic_pal[c("orange1", "green2", "blue3", "green4", "red1")],
                  draw = FALSE)

hc_tm_exc <- hctreemap(
  tm_exc,
  allowDrillToNode = TRUE,
  layoutAlgorithm = "squarified",
  levels = list(levelIsConstant = "false"),
  dataLabels = list(style = list(color = "white",
                                 textOutline = "0px contrast",
                                 fontSize = "8px"))
)

hc_tm_exc

```

Study Conduct{data-orientation=rows}
================================================================================

Row{data-height=50%}
--------------------------------------------------------------------------------

### Prehospital Surrogate Battery Completion Rate{data-width=35%}

```{r ph_comp}
## -- Proportion of full batteries completed -----------------------------------
pct_surrogate_comp <-
  round(mean(all_enrolled$ph_surrogate_comp, na.rm = TRUE) * 100)
pct_caregiver_comp <-
  round(mean(all_enrolled$ph_caregiver_comp, na.rm = TRUE) * 100)

## -- Proportion of individual surrogate assessments completed -----------------
surrogate_compvars <- paste0(
  c("gq", "pase", "adl", "ls", "emp", "audit", "iqcode", "bdi", "zarit",
    "memory"),
  "_comp_ph"
)

surrogate_pctcomp <- all_enrolled %>%
  dplyr::select(one_of(surrogate_compvars)) %>%
  summarise_all(mean, na.rm = TRUE) %>%
  gather(key = asmt_type, value = prop_comp) %>%
  mutate(sort_order = if_else(asmt_type == "ph_surrogate_comp", 1, 2)) %>%
  arrange(sort_order, desc(prop_comp)) %>%
  mutate(
    ## Sort in descending order of % completed
    x_sorted = 1:n(),
    ## Clearer battery names
    asmt_type = case_when(
      asmt_type == "memory_comp_ph" ~ "Mem/Behav",
      asmt_type == "gq_comp_ph"     ~ "General",
      asmt_type == "emp_comp_ph"    ~ "Employment",
      asmt_type == "zarit_comp_ph"  ~ "Zarit",
      TRUE ~ toupper(str_remove(asmt_type, "\\_comp\\_ph$"))
    ),
    asmt_type = fct_reorder(asmt_type, x_sorted),
    htext = paste0(asmt_type, ": ", scales::percent(prop_comp)),
    comp_ok = case_when(
      prop_comp > 0.90 ~ "Excellent",
      prop_comp > 0.80 ~ "Okay",
      TRUE             ~ "Uh-oh"
    )
  )

```

```{r ph_surrogate}
valueBox(
  value = paste0(pct_surrogate_comp, "%"),
  caption = "fully completed surrogate questionnaires<br>(General, PASE, ADLs, LS, employment, AUDIT, IQCODE, BDI)",
  color = ifelse(
    pct_surrogate_comp < 80, mosaic_col("orange3"), mosaic_col("green3")
  ),
  icon = "ion-person-stalker"
)

```

### Surrogate/Caregiver Battery Completion

```{r surrogate_pctcomp_ind}
p_surr <- plot_asmts_comp(df = surrogate_pctcomp, ybreaks = seq(0, 1, 0.2))
ggplotly(p_surr, tooltip = "text")

```

Row{data-height=50%}
--------------------------------------------------------------------------------

### Prehospital Caregiver Battery Completion Rate{data-width=35%}

```{r ph_caregiver}
valueBox(
  value = paste0(pct_caregiver_comp, "%"),
  caption =
    "fully completed caregiver questionnaires<br>(Zarit, Memory & Behavior)",
  color = ifelse(
    pct_caregiver_comp < 80, mosaic_col("orange3"), mosaic_col("green3")
  ),
  icon = "ion-heart"
)

```

### Specimen Log Compliance (% of Patients Eligible)

```{r specimen_compliance}
## Add text for tooltips
specimen_df$htext <- glue::glue_data(
  specimen_df,
  "{Day}, {Color}: {scales::percent(Compliance)}"
)

specimen_plot <- ggplot(
  data = specimen_df,
  aes(group = Color, x = Day, y = Compliance, text = htext)
) +
  geom_bar(aes(fill = Color), position = "dodge", stat = "identity") +
  scale_y_continuous(limits = c(0, 1),
                     breaks = seq(0, 1, 0.5),
                     label = scales::percent) +
  scale_fill_manual(values = c(mosaic_col("blue3"), "#5F0395"), guide = FALSE) +
  scale_alpha_manual(values = c(0.65, 0.85)) +
  theme_minimal() +
  theme(legend.position = "none",
        axis.title = element_blank(),
        axis.text = element_text(size = 10),
        panel.background = element_rect(fill = NA, color = "gray80"),
        panel.spacing = unit(2, "lines"))

x <- y <- list(title = NULL)

specimen_plot %>%
  ggplotly(tooltip = "text") %>%
  layout(xaxis = x, yaxis = y)

```

### Current In-Hospital Status

```{r current_status}
## List of patients currently in hospital
pts_inhosp <- subset(all_enrolled, inhosp_status == "Still in hospital")$id
pts_inhosp_text <- ifelse(length(pts_inhosp) == 0, "None",
                          paste0(pts_inhosp, collapse = "; "))

tm_status <- treemap(
  dtf = status_count,
  index = c("inhosp_status"),
  vSize = "n_status",
  type = "index",
  title = "",
  algorithm = "squarified",
  palette = mosaic_pal[c("blue3", "red1", "orange1", "green2")],
  draw = FALSE
)

hc_tm_status <- hctreemap(
  tm_status,
  allowDrillToNode = TRUE,
  layoutAlgorithm = "squarified",
  levels = list(levelIsConstant = "false"),
  dataLabels = list(style = list(color = "white",
                                 textOutline = "0px contrast",
                                 fontSize = "12px"))
) %>%
  hc_subtitle(
    text = paste("Patients currently in hospital:", pts_inhosp_text),
    align = "left"
  )

hc_tm_status

```

Accelerometers{data-orientation=rows}
================================================================================

Row {data-height=50%}
--------------------------------------------------------------------------------

### Accelerometer Snapshot: Patient-Days{data-width=50%}

```{r accel_snapshot_days}
## -- Patient-days accelerometer was worn --------------------------------------
pct_accel_worn <- round((n_accel_days / n_hosp_days) * 100)

accel_text <- "days accelerometer worn<br> <br> "

valueBox(
  value = paste0(pct_accel_worn, "%"),
  caption = accel_text,
  color = ifelse(
    pct_accel_worn < 80, mosaic_col("orange3"), mosaic_col("green3")
  ),
  icon = "ion-watch"
)

```

### On Days Accelerometer Was Removed, How Many Times?

```{r times_accel_removed}
accel_rm_atleast1 <- accel_rm_df %>%
  filter(bed_device_num > 0) %>%
  rename(Times = bed_device_num)

accel_rm_hist <- ggplot(data = accel_rm_atleast1, aes(x = Times)) +
  geom_histogram(fill = mosaic_col("blue1"), alpha = 0.5, binwidth = 1) +
  scale_x_continuous(breaks = 1:8, labels = 1:8) +
  theme_minimal() +
  theme(axis.title = element_blank())

accel_rm_hist %>%
  ggplotly(tooltip = c("x", "y"))

```

Row {data-height=50%}
--------------------------------------------------------------------------------

### Accelerometer Snapshot: Patients{data-width=50%}

```{r accel_snapshot_pts}

## -- Pts for whom accel was permanently removed >1 day before discharge -------
pct_accel_permrm <- round((n_accel_permrm / n_enrolled) * 100)

valueBox(
  value = paste0(pct_accel_permrm, "%"),
  caption = "patients with accelerometer permanently removed<br>>1 day before discharge",
  color = ifelse(pct_accel_permrm > 20, mosaic_col("red4"),
          ifelse(pct_accel_permrm > 15, mosaic_col("orange3"),
                 mosaic_col("green3"))),
  icon = "ion-close-circle"
)

```

### Reasons for Accelerometer Removal

```{r reasons_removed}
sum_accel_rm %>%
  knitr::kable(
    format = "markdown",
    row.names = FALSE, col.names = c("Reason", "Patients")
  )

```

Follow-Up {data-orientation=rows}
================================================================================

Row {data-height=33%}
--------------------------------------------------------------------------------

```{r fu_prep}
prop_totals <- map_dbl(
  fu_totals %>% pull(prop_comp), ~ round(., 2)
) %>%
  set_names(fu_totals %>% pull(redcap_event_name))

fu_asmts <- fu_asmts %>%
  mutate(
    asmt_type = case_when(
      asmt_type %in% paste0(c("ph_", ""), "biadl_complete") ~ "ADL",
      asmt_type == "emp_complete"                           ~ "Emp.",
      asmt_type == "gq_complete"                            ~ "Gen.",
      asmt_type == "hand_complete"                          ~ "Hand.",
      asmt_type == "membehav_complete"                      ~ "M/B",
      asmt_type == "social_complete"                        ~ "Social",
      asmt_type == "trails_complete"                        ~ "Trails",
      asmt_type == "zarit_complete"                         ~ "Zarit",
      TRUE ~ toupper(str_remove(asmt_type, "\\_complete$"))
    ),
    htext = paste0(asmt_type, ": ", scales::percent(round(prop_comp, 2))),
    comp_ok = case_when(
      prop_comp > 0.90 ~ "Excellent",
      prop_comp > 0.80 ~ "Okay",
      TRUE             ~ "Uh-oh"
    )
  )

```

### 1-Month Follow-Up{data-width=20%}

```{r fu_total_1m}
valueBox(
  value = scales::percent(pluck(prop_totals, "1 Month Phone Call")),
  caption = "fully or partially completed,<br><b>1 month</b>",
  color = ifelse(
    pluck(prop_totals, "1 Month Phone Call") < 0.9,
    mosaic_col("orange3"),
    mosaic_col("green3")
  )
)

```

### Assessments {data-width=20%}

```{r fu_asmts_1m}
p_1m <- plot_asmts_comp(
  df = fu_asmts %>% filter(redcap_event_name == "1 Month Phone Call"),
  ybreaks = 0:1,
  order_desc = FALSE
)
ggplotly(p_1m + theme(axis.text.y = element_blank()), tooltip = "text")

```

### 3-Month Follow-Up{data-width=20%}

```{r fu_total_3m}
valueBox(
  value = scales::percent(pluck(prop_totals, "3 Month Assessment")),
  caption = "fully or partially completed,<br><b>3 months</b>",
  color = ifelse(
    pluck(prop_totals, "3 Month Assessment") < 0.9,
    mosaic_col("orange3"),
    mosaic_col("green3")
  )
)

```

### **3-Month Assessments** (Out of `r nrow(fu_long %>% filter(redcap_event_name == "3 Month Assessment" & fu_comp))` Completed Assessments)<br>*Not Yet Assessed*: `r paste(fu_long %>% filter(fu_elig, fu_status == "Eligible, but not yet assessed", redcap_event_name == "3 Month Assessment") %>% pull(id), collapse = "; ")`

```{r fu_asmts_3m}
p_3m <- plot_asmts_comp(
  df = fu_asmts %>% filter(redcap_event_name == "3 Month Assessment"),
  ybreaks = 0:1
)
ggplotly(p_3m, tooltip = "text")

```

Row {data-height=33%}
--------------------------------------------------------------------------------

### 2-Month Follow-Up{data-width=15%}

```{r fu_total_2m}
valueBox(
  value = scales::percent(pluck(prop_totals, "2 Month Phone Call")),
  caption = "fully or partially completed,<br><b>2 months</b>",
  color = ifelse(
    pluck(prop_totals, "2 Month Phone Call") < 0.9,
    mosaic_col("orange3"),
    mosaic_col("green3")
  )
)

```

### Assessments{data-width=20%}

```{r fu_asmts_2m}
p_2m <- plot_asmts_comp(
  df = fu_asmts %>% filter(redcap_event_name == "2 Month Phone Call"),
  ybreaks = 0:1,
  order_desc = FALSE
)
ggplotly(p_2m + theme(axis.text.y = element_blank()), tooltip = "text")

```

### 12-Month Follow-Up{data-width=20%}

```{r fu_total_12m}
valueBox(
  value = scales::percent(pluck(prop_totals, "12 Month Assessment")),
  caption = "fully or partially completed,<br><b>12 months</b>",
  color = ifelse(
    pluck(prop_totals, "12 Month Assessment") < 0.9,
    mosaic_col("orange3"),
    mosaic_col("green3")
  )
)

```

### **12-Month Assessments** (Out of `r nrow(fu_long %>% filter(redcap_event_name == "12 Month Assessment" & fu_comp))` Completed Assessments)<br>*Not Yet Assessed*: `r paste(fu_long %>% filter(fu_elig, fu_status == "Eligible, but not yet assessed", redcap_event_name == "12 Month Assessment") %>% pull(id), collapse = "; ")`

```{r fu_asmts_12m}
p_12m <- plot_asmts_comp(
  df = fu_asmts %>% filter(redcap_event_name == "12 Month Assessment"),
  ybreaks = 0:1
)
ggplotly(p_12m, tooltip = "text")

```

Row {data-height=33%}
--------------------------------------------------------------------------------

### 6-Month Follow-Up{data-width=15%}

```{r fu_total_6m}
valueBox(
  value = scales::percent(pluck(prop_totals, "6 Month Phone Call")),
  caption = "fully or partially completed,<br><b>6 months</b>",
  color = ifelse(
    pluck(prop_totals, "6 Month Phone Call") < 0.9,
    mosaic_col("orange3"),
    mosaic_col("green3")
  )
)

```

### Assessments{data-width=20%}

```{r fu_asmts_6m}
p_6m <- plot_asmts_comp(
  df = fu_asmts %>% filter(redcap_event_name == "6 Month Phone Call"),
  ybreaks = 0:1,
  order_desc = FALSE
)
ggplotly(p_6m + theme(axis.text.y = element_blank()), tooltip = "text")

```

### Patient Flow

```{r sankey}
## Create data.frame of nodes
## Possible states:
##  0) Enrolled
##  1) Discharged alive
##  2) Assessed, 3m
##  3) Not assessed, 3m
##  4) Not yet eligible, 3m
##  5) Assessed, 12m
##  6) Not assessed, 12m
##  7) Not yet eligible, 12m
##  8) Hospitalized
##  9) Withdrawn
## 10) Died
sankey_nodes <- data.frame(
  id = 0:10,
  label = c(
    "Enrolled", "Discharged", "Assessed, 3m", "Not assessed, 3m",
    "Not yet eligible, 3m", "Assessed, 12m", "Not assessed, 12m",
    "Not yet eligible, 12m", "Hospitalized", "Withdrew", "Died"
  )
)

## -- Sankey chart using plotly ------------------------------------------------
# ## Couldn't get this to actually show up, and caused issues with DT, other JS
# ##  widgets, I think due to spacing?
# 
# ## Convert edge labels to numeric values
# sankey_edges2 <- sankey_edges %>%
#   left_join(sankey_nodes, by = c("source" = "label")) %>%
#   left_join(sankey_nodes, by = c("target" = "label")) %>%
#   dplyr::select(-source, -target) %>%
#   set_names(c("weight", "source", "target"))
# 
# pt_flow <- plot_ly(
#   type = "sankey",
#   orientation = "h",
# 
#   node = list(
#     label = sankey_nodes %>% pull(label),
#     color = c(
#       mosaic_col("blue1"),   ## enrolled
#       mosaic_col("green4"),  ## discharged
#       mosaic_col("green4"),  ## assessed, 3m
#       mosaic_col("orange1"), ## not assessed, 3m
#       mosaic_col("cream"),   ## not yet eligible, 3m
#       mosaic_col("green4"),  ## assessed, 12m
#       mosaic_col("orange1"), ## not assessed, 12m
#       mosaic_col("cream"),   ## not yet eligible, 12m
#       mosaic_col("orange4"), ## still hospitalized
#       mosaic_col("red2"),    ## withdrew
#       mosaic_col("red4")     ## died
#     )
#   ),
# 
#   link = list(
#     source = sankey_edges2 %>% pull(source),
#     target = sankey_edges2 %>% pull(target),
#     value = sankey_edges2 %>% pull(weight),
#     
#     width = 500, height = 25
#   )
# ) %>%
#   layout(autosize = FALSE)

## -- Sankey chart using googleVis ---------------------------------------------
## Nodes need to be in correct order
sankey_edges2 <- sankey_edges %>%
  mutate(
    sort_source = case_when(
      source == "Died, 3m"              ~ 8,
      source == "Withdrew, 3m"          ~ 7,
      source == "Not yet eligible, 3m"  ~ 6,
      source == "Not assessed, 3m"      ~ 5,
      source == "Assessed, 3m"          ~ 4,
      source == "Died, hospital"        ~ 3,
      source == "Withdrew, hospital"    ~ 2,
      source == "Discharged"          ~ 1,
      source == "Enrolled"            ~ 0,
      TRUE ~ as.numeric(NA)
    ),
    sort_target = case_when(
      target == "Died, 12m"             ~ 13,
      target == "Withdrew, 12m"         ~ 12,
      target == "Not yet eligible, 12m" ~ 11,
      target == "Not assessed, 12m"     ~ 10,
      target == "Assessed, 12m"         ~ 9,
      target == "Died, 3m"              ~ 8,
      target == "Withdrew, 3m"          ~ 7,
      target == "Not yet eligible, 3m"  ~ 6,
      target == "Not assessed, 3m"      ~ 5,
      target == "Assessed, 3m"          ~ 4,
      target == "Died, hospital"        ~ 3,
      target == "Withdrew, hospital"    ~ 2,
      target == "Discharged"            ~ 1,
      target == "Hospitalized"          ~ 0,
      TRUE ~ as.numeric(NA)
    )
  ) %>%
  arrange(sort_source, sort_target) %>%
  ## Add Ns for total source, targets
  group_by(source) %>%
  add_tally(weight) %>%
  ungroup() %>%
  group_by(target) %>%
  add_tally(weight) %>%
  ungroup() %>%
  dplyr::select(-sort_source, -sort_target) %>%
  set_names(c("source", "target", "weight", "source_total", "target_total")) %>%
  mutate(
    to_from = paste0("<b>", source, " -> ", target, ":</b>"),
    flow.tooltip = case_when(
      ## Target nodes where 100% of patients came from same source:
      ## N + % (n) of source
      target %in% c(
        "Discharged", "Withdrew, hospital", "Died, hospital", "Hospitalized",
        "Assessed, 3m", "Not assessed, 3m", "Not yet eligible, 3m"
      ) ~ paste0(
        to_from,
        "<br>N = ", weight, "<br>", scales::percent(weight / source_total),
        " of ", source_total, " ", tolower(source)
      ),
      ## Source nodes where 100% of patients go to same target:
      ##  N + % (n) of target
      source %in% c(
        "Withdrew, hospital", "Died, hospital", "Died, 3m", "Withdrew, 3m"
      ) ~ paste0(
        to_from, "<br>N = ", weight, "<br>",
        scales::percent(weight / target_total), " of ",
        target_total, " ", tolower(target)
      ),
      ## Otherwise, add N, % (n) of source, and % (n) of target
      TRUE ~ paste0(
        to_from, "<br>N = ", weight, "<br>",
        scales::percent(weight / source_total), " of ", source_total, " ",
        tolower(source),
        "<br>", scales::percent(weight / target_total), " of ",
        target_total, " ", tolower(target)
      )
    )
  )

ptflow_gvis <- gvisSankey(
  sankey_edges2,
  from = "source",
  to = "target",
  weight = "weight",
  options = list(
    height = 200, width = 750,
    tooltip = "{isHtml:'True'}",
    sankey = "{link: { colorMode: 'gradient' },
               node: { colors: ['#283C72',
                                '#243E8B',
                                '#1A653E',
                                '#FA961F',
                                '#C0232C',
                                
                                '#1A653E',
                                '#E76A32',
                                '#24ADCD',
                                '#FA961F',
                                '#C0232C',
                                
                                '#1A653E',
                                '#E76A32',
                                '#24ADCD',
                                '#C0232C',
                                '#FA961F'],
                       label: { fontSize: 12, bold: true }
                      },
               iterations: 0 }"
  )
)

```

```{r print_sankey, results = "asis"}
## plotly: not showing up
# pt_flow

# ## networkD3: This isn't showing up, makes DT go away
# networkD3::sankeyNetwork(
#   Links = sankey_edges2, Nodes = sankey_nodes,
#   Source = "source", Target = "target", Value = "weight",
#   NodeID = "label",
#   fontSize = 16, unit = "Patients", height = 500, width = 750
# )

## Let's try googleVis
print(ptflow_gvis, tag = "chart")

```

Study & Technical Info
=====================================

MOSAIC is funded by the National Institutes of Health. Please see our listing on [clinicaltrials.gov](https://clinicaltrials.gov/ct2/show/NCT03115840).

This dashboard uses `r devtools::session_info()$platform$version`. Packages:

```{r}
DT::datatable(devtools::session_info()$packages)

```