report.Rmd

---
output: 
  pdf_document:
    keep_md: true
classoption: a4paper
params:
  input: NA
  texttab: NA
  overall: NA
  ids: NA
header-includes:
  - \usepackage[T1]{fontenc}
  - \usepackage{lastpage}
  - \usepackage{fancyhdr}
  - \usepackage{float}
  - \usepackage{graphicx}
  - \usepackage{moresize}
  - \usepackage{longtable}
  - \usepackage{array}
  - \usepackage[default]{comfortaa}
  - \usepackage[T1]{fontenc}
  - \pagestyle{fancy}
  - \usepackage{hyperref}
  - \usepackage{lscape}
  - \usepackage{pdflscape}
---

```{r setup, include = FALSE}
options(Encoding="UTF-8")
library(gt)
library(dplyr)
library(magrittr)
library(tidyr)
library(xtable)
library(flextable)
set_flextable_defaults(fonts_ignore = TRUE, 
                       font.size = 9)
```


<!-- Document configuration -->

<!-- path to images -->
<!-- \graphicspath{ {./`r params$dir`} } -->

<!-- table interline -->
\renewcommand{\arraystretch}{1}
\renewcommand{\baselinestretch}{1.5}

<!-- table margins -->
<!-- \setlength{\LTleft}{0pt minus 1000pt} -->
<!-- \setlength{\LTright}{0pt minus 1000pt} -->

<!-- header/footer -->
\fancyhead[R]{Report date: `r Sys.time()`}
\fancyhead[L]{`r params$input$studyname`}
\cfoot[\fancyplain{}{}]{\fancyplain{}{}}
\rfoot{\thepage\ of \pageref{LastPage}}
\lfoot{Produced with \href{https://aghaynes.shinyapps.io/rbmc}{RBMSC}, V1.1}
\thispagestyle{fancy}

<!-- Report content -->

<!-- Title -->
\begin{minipage}{0.75\textwidth}
  \vspace*{1cm}
  \section{\huge{Risk Based Monitoring Score}}
  \vspace*{0.5cm}
  \subsection{Project: `r params$input$studyname`}
  \subsection{Author: `r params$input$au`}
\end{minipage}
\hfill
\begin{minipage}{0.2\textwidth}
  \begin{figure}[H]
    \includegraphics{logo.png}
  \end{figure}
\end{minipage}

## Summary

```{r inputs, echo = FALSE}
# inputs <- reactiveValuesToList(params$input)
inputs <- params$input
inputs <- inputs[!names(inputs) == "sidebarItemExpanded"]

mat <- tibble::tribble(~'Number of risks', ~'ClinO A', ~'ClinO B', ~'ClinO C',
                        'Less than 6 medium risks, no high risks', 'low', 'low', 'medium',
                        '6 to 12 medium risks or 1 high risk', 'low', 'medium', 'high',
                        'More than 12 medium risks, more than 1 high risk', 'medium', 'high', 'high'
                        ) 

txt <- mat[params$overall$row, paste("ClinO", params$input$clino_cat)]
# txtcol <- c("00ff11", "ffe100", "ffae00")[match(txt, c("low", "medium", "high"))]

```

Swiss risk category: `r inputs$clino_cat`

Based on the assumptions fed into the RBM score calculator, the study risk is `r txt` and we thus recommend applying the monitoring strategy for \textbf{`r txt`-risk trials}. 

```{r overall-table, echo = FALSE}
overall <- data.frame(Level = c("High", "Medium", "Low"),
           N = c(params$overall$High, params$overall$Medium, params$overall$Low))
names(overall)[2] <- "Number of risks"
overall %>% 
  flextable() %>% 
  flextable::align(j = 2, align = "center", part = "all")
```

The following risks are rated as high in this trial:

```{r high-risk, echo = FALSE}
tmp <- as.data.frame(inputs) %>%
  mutate(across(everything(), as.character)) %>%
  pivot_longer(cols = everything(), 
               names_to = c("i", "j"), 
               names_pattern = "(.*)_(imp|occ|det|tx|appl|note)$") %>%
  filter(!is.na(i)) %>%
  pivot_wider(id_cols = "i", names_from = "j", values_from = "value") %>%
  mutate(imp = factor(imp, c("Low", "Moderate", "High")),
         occ = factor(occ, c("Rare", "Occasional", "Frequent")),
         det = factor(det, c("Simple", "Moderate", "Difficult")),
         across(c("imp", "occ", "appl", "det"), as.numeric),
         across(c("imp", "occ", "det"), ~ case_when(appl == 0 ~ 0,
                                                  TRUE ~ .)),
         score = imp*occ*det,
         appl = case_when(grepl("other", .data$i) ~ 1,
                          TRUE ~ appl)) %>% 
  filter(grepl(paste0("other(", paste0(params$ids, collapse = "|"), ")"), .data$i) | !grepl("other", .data$i))
  

# browser()
tmp2 <- params$texttab %>%
  full_join(tmp, by = c("ref" = "i")) 

tmp2 %>% 
  filter(score > 9) %>% 
  select(category, Risk, note) %>% 
  rename(Category = category,
         Description = note) %>% 
  flextable() %>% 
  width(1, 2.5, unit = "cm") %>% 
  width(2, 4, unit = "cm") %>% 
  width(3, 9, unit = "cm")

```

The following risks are rated as medium in this trial:

```{r medium-risk, echo = FALSE}
tmp2 %>% 
  filter(score > 3 & score <= 9) %>% 
  select(category, Risk, note) %>% 
  rename(Category = category,
         Description = note) %>% 
  flextable() %>% 
  width(1, 2.5, unit = "cm") %>% 
  width(2, 4, unit = "cm") %>% 
  width(3, 9, unit = "cm")
```

\newpage
<!-- Table -->
\vspace{1cm}
\scriptsize

\begin{landscape}

```{r risk-tabs, echo = FALSE, eval = FALSE}


if("tx" %in% names(tmp)) tmp2 <- tmp2 %>% 
  mutate(Risk = case_when(!is.na(Risk) ~ Risk,
                          is.na(Risk) ~ tx))

tmp2 %>%
  mutate(category = case_when(!is.na(category) ~ category,
                              is.na(category) ~ "VII. Other Risks")) %>%
  select(category, Risk, imp, occ, det, score) %>%
  rename(Impact = imp,
         Occurance = occ,
         Detectability = det,
         Score = score,
         Category = category
         ) %>% 
  flextable() %>%
  bg(i = which(tmp2$score < 4), j = "Score", bg = "green") %>%
  bg(i = which(tmp2$score >= 4 & tmp2$score < 10), j = "Score", bg = "orange") %>%
  bg(i = which(tmp2$score > 10), j = "Score", bg = "red") %>% 
  width(1, 2.5, unit = "cm") %>% 
  width(2, 4, unit = "cm") %>% 
  width(3:6, 2, unit = "cm") %>% 
  flextable::align(j = 3:6, align = "center", part = "all")
  

```

```{r risk-tabs-gt, echo = FALSE, eval = FALSE}
if("tx" %in% names(tmp)) tmp2 <- tmp2 %>% 
  mutate(Risk = case_when(!is.na(Risk) ~ Risk,
                          is.na(Risk) ~ tx))

tmp2 %>%
  mutate(category = case_when(!is.na(category) ~ category,
                              is.na(category) ~ "VII. Other Risks")) %>%
  select(category, Risk, note, imp, occ, det, score) %>%
  rename(Impact = imp,
         Occurance = occ,
         Detectability = det,
         Score = score,
         Category = category,
         Note = note
         ) %>% 
  gt() %>% 
  cols_width(Note ~ px(100),
             Risk ~ px(100)) %>% 
  fmt_missing(columns = everything(), rows = everything(), missing_text = "") %>% 
  tab_style(
    style = cell_fill("red"),
    locations = cells_body(
      columns = "Score",
      rows = Score > 9
    ))

```


```{r risk-tabs-btable, echo = FALSE, eval = TRUE, results='asis', warning = FALSE}
if("tx" %in% names(tmp)) tmp2 <- tmp2 %>% 
  mutate(Risk = case_when(!is.na(Risk) ~ Risk,
                          is.na(Risk) ~ tx))

tmp2 %>%
  mutate(category = case_when(!is.na(category) ~ category,
                              is.na(category) ~ "VII. Other Risks")) %>%
  mutate(across(c("occ", "det", "imp", "score"), ~ sprintf("%1.0f", .), .names = "{.col}_s"),
         # score_s = case_when(score < 4 & score > 0 ~ paste0("\\cellcolor{green}", score_s),
         #                   score >= 4 & score < 10 ~ paste0("\\cellcolor{orange}", score_s),
         #                   score >= 10 ~ paste0("\\cellcolor{red}", score_s))
         ) %>% 
  rename(Impact = imp_s,
         Occurrence = occ_s,
         Detectability = det_s,
         Score = score_s,
         Category = category,
         Note = note,
         ) %>% 
  select(Category, Risk, Note, Impact, Occurrence, Detectability, Score) %>%
  mutate(
    across(everything(), as.character),
    across(everything(), function(x) case_when(x == "NA" ~ "", TRUE ~ x))) %>% 
  xtable(align = "p{1.1cm}p{3.5cm}p{5cm}p{6cm}cccc", digits = 0) %>% 
  print(tabular.environment = "longtable", include.rownames = FALSE, )
```


\end{landscape}

<!-- \pagebreak -->


```{r, echo = FALSE, eval = FALSE}

mat %>%
  flextable() %>% 
  bg(i = mat$`ClinO A` == "low", j = 2, bg = "green") %>% 
  bg(i = mat$`ClinO B` == "low", j = 3, bg = "green") %>% 
  bg(i = mat$`ClinO A` == "medium", j = 2, bg = "orange") %>% 
  bg(i = mat$`ClinO B` == "medium", j = 3, bg = "orange") %>% 
  bg(i = mat$`ClinO C` == "medium", j = 4, bg = "orange") %>% 
  bg(i = mat$`ClinO B` == "high", j = 3, bg = "red") %>% 
  bg(i = mat$`ClinO C` == "high", j = 4, bg = "red") %>% 
  flextable::align(align = "center", part = "all") %>% 
  # border(i = params$overall$row, j = paste("ClinO", params$input$clino_cat), border = officer::fp_border(width = 5)) %>% 
  fontsize(i = params$overall$row, j = paste("ClinO", params$input$clino_cat), size = 10) %>% 
  bold(i = params$overall$row, j = paste("ClinO", params$input$clino_cat)) %>% 
  italic(i = params$overall$row, j = paste("ClinO", params$input$clino_cat)) %>% 
  width(j = 1, 5, unit = "cm")

```