icaria_progress_report.Rmd

---
output: 
  html_document: 
    css: style.css
---

```{r parameters, include=FALSE}

source("icaria_progress.R")
source("tokens.R")

# Define Excel progress report file name
kExcelReportFilename <- "icaria_progress_report"
kExcelVersionFormat <- "%Y%m%d"
kExcelExtension <- ".xlsx"

Sys.setlocale(locale = "en_US.UTF-8")
report.date <- Sys.time()
report.date.format <- formatReportDate(report.date)
excel.report.filename <- paste0(
  kExcelReportFilename, 
  "_", 
  format(report.date, format = kExcelVersionFormat), 
  kExcelExtension
)

# Define report meta-data
report.metadata <- list(
  name        = "ICARIA Progress Report",
  description = "Progress indicators for the ICARIA Clinical Trial and ancillary studies",
  ##############################################################################
  # v1.1 - Fixed a problem that didn't count MRV2 visits in COHORT. Added a new
  #        column in the COHORT table: After MRV2.
  # v1.2 - Fixed a bug with the screening log vars in the HF time series. The
  #        report_date column was being used rather than the screening_date.
  #
  version     = "1.2",
  ##############################################################################
  date        = report.date.format,
  filename    = excel.report.filename,
  author      = "Máximo Ramírez Robles",
  link        = "https://github.com/maxramirez84/r_icaria_progress_report"
)

# Define project characteristics
sample.size <- 20560
monthly.target <- 500
weeks.per.month <- 4.2857
recruitment.start <- as.Date("2021-03-17")
recruitment.end <- as.Date("2024-08-01")

# Define set of health facilities
hfs <- data.frame(
  code     = c("HF01", "HF02", "HF03", "HF04", "HF05", "HF06", "HF07", "HF08", 
               "HF09", "HF10", "HF11", "HF12", "HF13", "HF14", "HF15", "HF16",
               "HF17"),
  
  name     = c("Lungi Under Fives CHP", "Lunsar CHC", "Mahera CHC", 
               "Masiaka CHC", "Port Loko U5 CHP", "Rogbere Junction CHC",
               "Mange CHC", "Magburaka Under Fives Clinic", "Masingbi CHC", 
               "Matotoka CHC", "Loreto Clinic", "Red Cross (Makeni City) CHP", 
               "Stocco CHP", "Binkolo CHC", "Makama CHP", 
               "Makeni Government Hospital", "Masuba CHC"),
  
  district = c("Port Loko", "Port Loko", "Port Loko", "Port Loko", "Port Loko",
               "Port Loko", "Port Loko", "Tonkolili", "Tonkolili", "Tonkolili", 
               "Bombali", "Bombali", "Bombali", "Bombali", "Bombali", "Bombali",
               "Bombali"),
  
  trial          = c(T, T, T, T, T, T, F, T, F, T, T, T, T, F, T, T, T),
  
  cohort         = c(T, T, T, T, T, T, F, T, T, T, T, F, T, F, F, T, F),
  
  comments_trial = NA,
  
  comments_cohort = c(NA, NA, NA, NA, NA, NA, NA, NA,
                      "This HF has been dropped out from the study. 30 extra participants have been recruited.",
                      NA, NA, NA, NA, NA, NA, NA, NA),
  
  trial_highlighted  = c(F, F, F, F, F, F, F, F, F, F, F, F, F, F, F, F, F),
  
  cohort_highlighted = c(F, F, F, F, F, F, F, F, T, F, F, F, F, F, F, F, F),
  
  recruitment_start = c('2021-05-18', '2021-04-29', '2021-05-19', '2021-06-16',
                        '2021-05-10', '2021-06-16', NA          , '2021-03-17',
                        NA          , '2021-04-28', '2021-04-19', '2021-03-29',
                        '2021-04-23', NA          , '2021-03-19', '2021-06-03',
                        '2021-07-14'),
  
  weekly_target = c(13, 11, 5, 6, 6, 5, NA, 16, NA, 5, 6, 7, 6, NA, 5, 23, 5)
)
row.names(hfs) <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17)

# TODO: Implement the possibility to get the report for a concrete date
filter.by.date <- T
date.filter <- "2021-04-29 10:19:27"
```

---
title: "ICARIA Progress Dashboard"
author: "`r report.metadata$author`"
date: "`r paste('Reporting date:', report.metadata$date)`"
---

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

# Export data from all REDCap projects (one project by health facility)
data <- ExportDataAllHealthFacilities(kRedcapAPIURL, kRedcapTokens)

  # Export data from trial profile (data recorded on the screening log)
profile <- ExportDataTrialProfile(kRedcapAPIURL, kRedcapTokens)

# Export data from the COHORT project (ancillary study)
cohort <- ExportDataCohort(kRedcapAPIURL, kRedcapTokens)

# Produce data set with progress indicators by ICARIA Health Facility
trial.progress <- SummarizeData(
  hf.list = row.names(hfs[which(hfs$trial), ]),
  profile = profile, 
  data    = data
)


# Produce one data set by ICARIA Health Facility with the progress time series
time.series <- list()
for (hf.id in row.names(hfs[which(hfs$trial), ])) {
  hf <- as.character(hfs[hf.id, 'code'])
  print(paste("Computing progress time series of", hf))
  time.series[[hf.id]] <- GetHealthFacilityTimeSeries(
    hf.id       = hf.id, 
    hf.data     = data[which(data$hf == hf), ],
    report.date = report.date,
    profile     = profile
  )
}

# Produce data set with progress indicators for the COHORT ancillary study
cohort.progress <- SummarizeCohortData(
  hf.list = row.names(hfs[which(hfs$cohort), ]), 
  data    = cohort
)

# Produce Excel report
CreateExcelReport(
  metadata          = report.metadata,
  general.progress  = trial.progress,
  cohort.progress   = cohort.progress, 
  time.series       = time.series, 
  health.facilities = hfs
)

# Follo-up of Non-compliants
# View(data[which(startsWith(data$child_fu_status, 'NC@')), c('hf', 'study_number', 'child_fu_status')])
```

```{r out.width="30px", echo=FALSE}
knitr::include_graphics("github_icon.png")
```
[Report GitHub Repository](https://github.com/maxramirez84/r_icaria_progress_report)

---
```{r overal.figures, include=FALSE}
enroled <- sum(trial.progress$n_random)
progress <- round((sum(trial.progress$n_random) / sample.size) * 100)

weekly.target <- round(monthly.target / weeks.per.month)

dashboard <- time.series[[1]][c('date', 'n_random')]
for (i in 2:length(time.series)) {
  dashboard <- merge(
    x   = dashboard, 
    y   = time.series[[i]][c('date', 'n_random')], 
    by  = 'date', 
    all = T,
    suffixes = c(i-1, i)
  )
}
colnames(dashboard)[2:ncol(dashboard)] <- hfs$code[which(hfs$trial)]

dashboard$enroled <- rowSums(dashboard[2:ncol(dashboard)], na.rm = T)

points <- nrow(dashboard)
dashboard$by.week <- NA
dashboard$by.week[1] <- dashboard$enroled[1]
dashboard$by.week[2:points] <- dashboard$enroled[2:points] - 
  dashboard$enroled[1:(points - 1)]

dashboard$avg.4w <- NA
for (i in 4:points) {
  dashboard$avg.4w[i] <- round(mean(dashboard$by.week[i:(i-3)]))
}

dashboard$expected <- sapply(
  X   = dashboard$date, 
  FUN = function(x) { 
    expectedAtDate(
      date        = x, 
      weekly.rate = round(monthly.target / weeks.per.month), 
      start       = recruitment.start
    )
  }
)

for (hf in hfs$code[which(hfs$trial)]) {
  expected.at.hf <- sapply(
    X   = dashboard$date[which(!is.na(dashboard[hf]))],
    FUN = function(x) {
      filter <- which(hfs$code == hf)
      expectedAtDate(
        date        = x,
        weekly.rate = hfs$weekly_target[filter],
        start       = hfs$recruitment_start[filter]
      )
    }
  )
  
  column.name <- paste("exp", hf, sep = ".")
  to.be.merged <- data.frame(
    date    = names(expected.at.hf), 
    exp = expected.at.hf
  )
  colnames(to.be.merged) <- c("date", column.name)
  dashboard <- merge(dashboard, to.be.merged, by = "date", all = T)
}

dashboard$N <- sample.size

dashboard$format.date <- sapply(
  X   = as.Date(dashboard$date),
  FUN = function(x) {
    y <- formatReportDate(x)
    substr(y, 1, nchar(y) - 5)
  }
)

dashboard$gap <- dashboard$expected - dashboard$enroled

recruit.rate <- dashboard$avg.4w[points]
rate.diff <- recruit.rate - dashboard$avg.4w[points - 1]

rate.diff.style <- ""
rate.diff.trend <- "Same Rate"
if (rate.diff < 0) {
  rate.diff.style <- "decrease"
  rate.diff.trend <- "less"
} else if (rate.diff > 0) {
  rate.diff.style <- "green-target"
  rate.diff.trend <- "more"
}
rate.diff.word <- ""
if (rate.diff != 0) {
  rate.diff.word <- str_to_title(as.english(abs(rate.diff)))
}

expected.end <- as.Date(report.date) + ((sample.size - enroled) / recruit.rate) * 7
expected.end.string <- formatReportDate(expected.end)
```
<div class="report-block">
<div class="col-1-3 text-left">
  <div class="big-number">`r  progress`%</div>
  <div class="small-number">`r format(enroled, big.mark = '.')` / `r format(sample.size, big.mark = '.')`</div>
  <div class="fig-title">Total Enroled</div>
</div>

<div class="col-1-3 text-center">
  <div class="medium-number">`r  weekly.target`</div>
  <div class="fig-title">Weekly Target</div>
  <div class="fig-subtitle green-target">`r paste(monthly.target, 'month')`</div>
</div>

<div class="col-1-2 text-right">
  <div><span class="small-number `r rate.diff.style`">`r  if (rate.diff != 0) rate.diff`</span><span class="medium-number">`r  recruit.rate`</span></div>
  <div class="fig-title">Enroled/Week</div>
  <div>Average Rate last 4 weeks</div>
  <div class="`r rate.diff.style`">`r paste(rate.diff.word, rate.diff.trend, 'than the previous period')`</div>
  <div>Considering this rate, we'll finish on <span class="expected-end">`r expected.end.string`</span></div>
</div>
</div>

```{r progress.bar, include=FALSE}
progress.icon.path <- "path://M43.52,0c9.46,0,17.13,7.67,17.13,17.13c0,9.46-7.67,17.13-17.13,17.13c-9.46,0-17.13-7.67-17.13-17.13 C26.39,7.67,34.06,0,43.52,0L43.52,0z M25.36,77.83l13.61,13.79l-10.03,10.03l8.04,8.25l2.74,2.81c4.69,6.2-2.34,13.56-8.45,8.45 l-17.84-18.21c-2.7-3.74-3.5-7.8-0.74-12.45L25.36,77.83L25.36,77.83z M61.67,77.83L48.07,91.63l10.03,10.03l-8.04,8.25l-2.74,2.81 c-4.69,6.2,2.34,13.56,8.45,8.45l17.84-18.21c2.7-3.74,3.5-7.8,0.74-12.45L61.67,77.83L61.67,77.83z M84.26,73.29L84.26,73.29 c-2.79,2.01-6.35,1.08-8.72-1.41L61.87,57.55v13.04H25.13v-13L11.5,71.88c-2.37,2.49-5.94,3.42-8.72,1.41l0,0 c-2.79-2.01-3.87-6.33-1.41-8.72l17.95-17.44c2.92-2.84,8.54-9.56,12.33-9.56H55.7c3.55,0,9.05,6.67,12.01,9.56l17.95,17.44 C88.13,66.96,87.04,71.28,84.26,73.29L84.26,73.29z"

expected <- expectedAtDate(
  date        = report.date, 
  weekly.rate = round(monthly.target / weeks.per.month), 
  start       = recruitment.start
)
progress.df <- data.frame(
  'x' = c('Progress'), 
  'y' = c(enroled), 
  'z' = c(expected),
  'w' = c(sample.size),
  'p' = c(progress.icon.path)
)

kOrange <- "#FCC000"
kGreen <- "#70AD47"
kNIcons <- 20
kIconSize <- c(35, 60)

progress.df |>
  e_chart(x, width = "770px", height = "100px") |>
  e_x_axis(show = F) |>
  e_y_axis(show = F, max = sample.size) |>
  e_grid(left = 0, right = 0, top = 0, bottom = 0) |>
  e_color(color = c(kOrange, kGreen, 'black')) |>
  e_pictorial(
    serie              = y, 
    symbol             = p, 
    symbolRepeat       = kNIcons, 
    symbolBoundingData = sample.size, 
    symbolSize         = kIconSize, 
    symbolClip         = T
  ) |>
  e_pictorial(
    serie              = z, 
    symbol             = p, 
    symbolRepeat       = kNIcons, 
    symbolBoundingData = sample.size, 
    symbolSize         = kIconSize, 
    symbolClip         = T, 
    z                  = -1
  ) |>
  e_pictorial(
    serie              = w, 
    symbol             = p, 
    symbolRepeat       = kNIcons, 
    symbolBoundingData = sample.size, 
    symbolSize         = kIconSize, 
    z                  = -2
  ) |>
  e_legend(show = F) |> 
  e_flip_coords() -> progress.pic.plot

recruitment.start.string <- formatReportDate(recruitment.start)
recruitment.end.string <- formatReportDate(recruitment.end)

dashboard |>
  e_chart(format.date) |>
  e_y_axis(max = sample.size) |>
  e_grid(left = 60, right = 40, top = 10, bottom = 50) |>
  e_color(color = c(kGreen, kOrange, 'black', 'red')) |>
  e_line(expected, endLabel = list(show = T, color = kGreen)) |>
  e_line(enroled, endLabel = list(show = T, color = kOrange)) |>
  e_line(gap, lineStyle = list(width = 0), symbol = 'none') |>
  e_line(
    serie     = N, 
    symbol    = 'none', 
    lineStyle = list(type = 'dashed', width = 1)
  ) |>
  e_tooltip(trigger = 'axis') |>
  e_legend(bottom = 0) -> progress.line.plot
```
<div class="grey-background">
<div class="report-block">
<div class="col-2-5 text-right"><p><b>Real:</b><br/> `r recruitment.start.string`</p></div>
<div class="col-2-1">`r progress.pic.plot`</div>
<div class="col-2-5 text-left"><p><b>Plan:</b><br/> `r recruitment.end.string`</p></div>
</div>

<div class="report-block">
<p class="chart-title">Overall Enrolment Progress</p>
<p class="char-subtitle">All ICARIA Health Facilities (14)</p>
`r progress.line.plot`
</div>
</div>

<div>
<p class="legend-title">GENERAL LEGEND</p>
<ul class="legend-list">
<li class="green-target">Expected enroled children by week (based on the defined monthly target: 500 enroled/month).</li>
<li class="orange-enroled">Enroled children; i.e. randomized children with study number (Source ICARIA eCRF).</li>
</ul>
</div>

```{r hfs.progress.bars, include=FALSE}
hfs.plots <-list()
for (hf in hfs$code[which(hfs$trial)]) {
  filter <- which(!is.na(dashboard[hf]))
  hfs.plots[[hf]] <- buildHFProgressBar(data.frame(
    date     = dashboard$format.date[filter],
    expected = dashboard[filter, paste('exp', hf, sep = '.')],
    enroled  = dashboard[filter, hf]
  ))
}

subtitle.label <- "Weekly Target:"
```
<!-- Port Loko Health Facilities -->
<div class="grey-background">
<div class="col-3-1">
<div class="report-block">
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[1], hfs$name[1])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[1])`</p>
`r hfs.plots[['HF01']]`
</div>
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[2], hfs$name[2])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[2])`</p>
`r hfs.plots[['HF02']]`
</div>
</div>

<div class="report-block">
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[3], hfs$name[3])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[3])`</p>
`r hfs.plots[['HF03']]`
</div>
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[4], hfs$name[4])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[4])`</p>
`r hfs.plots[['HF04']]`
</div>
</div>

<div class="report-block">
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[5], hfs$name[5])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[5])`</p>
`r hfs.plots[['HF05']]`
</div>
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[6], hfs$name[6])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[6])`</p>
`r hfs.plots[['HF06']]`
</div>
</div>
</div>
<div class="col-3-5"><p class="district-label">PORT LOKO</p></div>
</div>

<!-- Tonkolili Health Facilities -->
<div>
<div class="col-3-1">
<div class="report-block">
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[8], hfs$name[8])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[8])`</p>
`r hfs.plots[['HF08']]`
</div>
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[10], hfs$name[10])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[10])`</p>
`r hfs.plots[['HF10']]`
</div>
</div>
</div>
<div class="col-3-5-2"><p class="district-label">TONKOLILI</p></div>
</div>

<!-- Bombali Health Facilities -->
<div class="grey-background">
<div class="col-3-1">
<div class="report-block">
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[11], hfs$name[11])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[11])`</p>
`r hfs.plots[['HF11']]`
</div>
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[12], hfs$name[12])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[12])`</p>
`r hfs.plots[['HF12']]`
</div>
</div>

<div class="report-block">
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[13], hfs$name[13])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[13])`</p>
`r hfs.plots[['HF13']]`
</div>
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[15], hfs$name[15])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[15])`</p>
`r hfs.plots[['HF15']]`
</div>
</div>

<div class="report-block">
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[16], hfs$name[16])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[16])`</p>
`r hfs.plots[['HF16']]`
</div>
<div class="col-3-2">
<p class="chart-title">`r paste(hfs$code[17], hfs$name[17])`</p>
<p class="char-subtitle">`r paste(subtitle.label, hfs$weekly_target[17])`</p>
`r hfs.plots[['HF17']]`
</div>
</div>
</div>
<div class="col-3-5"><p class="district-label">BOMBALI</p></div>
</div>

```{r recruit.rate.evol, include=FALSE}
# Average (4 weeks) recruitment rate evolution line chart
dashboard$week.target <- 117
dashboard |> 
  e_chart(format.date) |>
  e_grid(left = 60, right = 40, top = 10, bottom = 50) |>
  e_color(color = c(kOrange, kGreen)) |>
  e_line(
    serie     = avg.4w, 
    name      = "enrolment rate", 
    endLabel  = list(show = T, color = kOrange)) |> 
  e_line(
    serie     = week.target,
    name      = "weekly target",
    symbol    = 'none', 
    lineStyle = list(type = 'dashed', width = 1),
    endLabel  = list(show = T, color = kGreen)
  ) |>
  e_tooltip(trigger = 'axis') |>
  e_legend(bottom = 0) -> avg.recruit.rate.evol
```

<div class="report-block">
<p class="chart-title">Enrolment Rate Evolution</p>
<p class="char-subtitle">Enroled/Week: Average Rate last 4 weeks</p>
`r avg.recruit.rate.evol`
</div>
</div>