In biodosimetry-uab/biodosetools: An R Shiny Application for Biological Dosimetry

library(dplyr)
library(ggplot2)

aberr_module <- params$aberr_module

parsed_title <- dplyr::case_when(
  aberr_module == "dicentrics" ~ "Dicentrics dose estimation report",
  aberr_module == "translocations" ~ "Translocation FISH dose estimation report",
  aberr_module == "micronuclei" ~ "Micronuclei dose estimation report"
)

title: `r parsed_title`

pander::panderOptions("table.style", "grid")
pander::panderOptions("table.split.table", Inf)
pander::panderOptions(
  "table.alignment.default",
  function(df) {
    ifelse(sapply(df, is.numeric), "center", "left")
  }
)

render_table <- function(x, ...) {
  pander::pander(x)
  # TODO: handle alignments via justify parameter
}

# General parameters
assessment <- params$est_results_list[["assessment"]]

est_doses_whole <- params$est_results_list[["est_doses_whole"]]

est_doses_partial <- params$est_results_list[["est_doses_partial"]]
est_frac_partial <- params$est_results_list[["est_frac_partial"]]

est_mixing_prop_hetero <- params$est_results_list[["est_mixing_prop_hetero"]]
est_yields_hetero <- params$est_results_list[["est_yields_hetero"]]
est_doses_hetero <- params$est_results_list[["est_doses_hetero"]]
est_frac_hetero <- params$est_results_list[["est_frac_hetero"]]

AIC_whole <- params$est_results_list[["AIC_whole"]]
AIC_partial <- params$est_results_list[["AIC_partial"]]
AIC_hetero <- params$est_results_list[["AIC_hetero"]]

fit_coeffs <- params$est_results_list[["fit_coeffs"]]
fit_formula_tex <- params$est_results_list[["fit_formula_tex"]]
protraction <- params$est_results_list[["protraction"]]

case_data <- params$est_results_list[["case_data"]]
case_description <- params$est_results_list[["case_description"]]
results_comments <- params$est_results_list[["results_comments"]]
gg_curve <- params$est_results_list[["gg_curve"]]

# Translocations
genome_factor <- params$est_results_list[["genome_factor"]]
chromosome_table <- params$est_results_list[["chromosome_table"]]
trans_sex <- params$est_results_list[["trans_sex"]]
confounders <- params$est_results_list[["confounders"]]

Curve used

Fit formula

r paste0("$$", fit_formula_tex, if (protraction[1]) "G(x)", "$$")

r if (protraction[1]) { paste( "where $G(x)$ is a time-dependent correction that takes into account protracted and fractionated exposures:", "$$", "G(x) = \\frac{2}{x^{2}} \\left(x - 1 - e^{-x} \\right), \\quad x = \\frac{t}{t_{0}}", "$$" ) }

r if (protraction[1]) { paste0( "The protraction times used for the dose estimation were ", paste0("$", "t =", protraction[2]), "\\, \\textrm{h}", "$", " and ", paste0("$", "t_{0} =", protraction[3]), "\\, \\textrm{h}", "$", "." ) }

r if (aberr_module == "translocations") {"## Full genome coefficients"} else {"## Coefficients"}

fit_coeffs %>%
  formatC(format = "e", digits = 3) %>%
  as.data.frame() %>%
  biodosetools:::fix_coeff_names(type = "rows", output = "kable") %>%
  render_table(align = "c")

r if (aberr_module == "translocations") {"# Case chromosome data"}

r if (aberr_module == "translocations") { paste("The analysed blood sample comes from a", trans_sex, "individual.") }

if (aberr_module == "translocations") {
  num_cols <- as.numeric(ncol(chromosome_table))

  chromosome_table %>%
    dplyr::mutate(
      dplyr::across(
        .cols = dplyr::everything(),
        .fns = function(x) {
          x <- ifelse(is.na(x) | x == "FALSE", "", x)
          x <- ifelse(x == "TRUE", "$\\checkmark$", x)
          return(x)
        }
      )
    ) %>%
    render_table(align = "c")
}

r if (aberr_module == "translocations") { if (num_cols == 1) { "where each chromosome was stained using M-FISH." } }

r if (aberr_module == "translocations") {"## Genomic conversion factor"}

r if (aberr_module == "translocations") { paste0("The genomic conversion factor to full genome is ", as.character(round(genome_factor, 3)), ".") }

Case data analyzed

data <- case_data %>%
  as.matrix() %>%
  formatC(format = "f", digits = 3) %>%
  as.data.frame() %>%
  dplyr::mutate(
    dplyr::across(
      .cols = c("N", "X", dplyr::starts_with("C")),
      .fns = as.integer
    )
  ) %>%
  biodosetools:::fix_count_data_names(type = "case", output = "kable")

data$`$u$` <- kableExtra::cell_spec(
  x = data$`$u$`,
  background = ifelse(data$`$u$` > 1.96, "#ffc0cb", "white")
)

data %>%
  render_table(align = "c")

r if (aberr_module == "translocations") {"## Confounders"}

r if (aberr_module == "translocations") { if (is.null(confounders)) { paste("No confounders were selected.") } else if (!is.null(confounders) & length(confounders) == 1) { paste0("To account for confounders, the following translocation frequency per cell was manually input: ", confounders, ".") } else if (!is.null(confounders) & length(confounders) > 1) { paste("The following confounders were selected:") } }

if (aberr_module == "translocations") {
  if (!is.null(confounders) & length(confounders) > 1) {
    confounders %>%
      as.matrix() %>%
      t() %>%
      as.data.frame() %>%
      mutate(
        sex_bool = with(., case_when(
          (sex_bool == TRUE) ~ "Used",
          (sex_bool == FALSE) ~ "Not used"
        )),
        smoker_bool = with(., case_when(
          (smoker_bool == TRUE) ~ "Yes",
          (smoker_bool == FALSE) ~ "No"
        )),
        ethnicity_value = with(., case_when(
          (ethnicity_value == "white") ~ "White",
          (ethnicity_value == "asian") ~ "Asian",
          (ethnicity_value == "black") ~ "Black",
          (ethnicity_value == "other") ~ "Others",
          TRUE ~ "Not specified"
        )),
        region_value = with(., case_when(
          (region_value == "n-america") ~ "North America",
          (region_value == "w-europe") ~ "Western Europe",
          (region_value == "c-europe") ~ "Central Europe",
          (region_value == "e-europe") ~ "Eastern Europe",
          (region_value == "asia") ~ "Asia",
          TRUE ~ "Not specified"
        ))
      ) %>%
      `colnames<-`(c("Age", "Sex", "Smoker", "Ethnicity", "Lab region")) %>%
      render_table(align = "c")
  }
}

Case description

r case_description

Dose estimation results

r if (TRUE) {"## Whole-body exposure results"}

r if (TRUE) {"### Whole-body exposure estimation {-}"}

if (TRUE) {
  est_doses_whole %>%
    dplyr::select(yield) %>%
    t() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    # Convert to hot and format table
    render_table(align = "c")
}

if (TRUE) {
  est_doses_whole %>%
    dplyr::select(`dose (Gy)` = dose) %>%
    t() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    # Convert to hot and format table
    render_table(align = "c")
}

r if (assessment == "partial-body") {"## Partial-body exposure results"}

r if (assessment == "partial-body") {"### Partial-body exposure estimation {-}"}

if (assessment == "partial-body") {
  est_doses_partial %>%
    dplyr::select(yield) %>%
    t() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    # Fix possible NA values
    dplyr::mutate_if(is.logical, as.double) %>%
    `colnames<-`(c("lower", "estimate", "upper")) %>%
    `row.names<-`("yield") %>%
    # Convert to hot and format table
    render_table(align = "c")
}

if (assessment == "partial-body") {
  est_doses_partial %>%
    dplyr::select(dose) %>%
    t() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    # Fix possible NA values
    dplyr::mutate_if(is.logical, as.double) %>%
    `colnames<-`(c("lower", "estimate", "upper")) %>%
    `row.names<-`("dose (Gy)") %>%
    # Convert to hot and format table
    render_table(align = "c")
}

r if (assessment == "partial-body") {"### Initial fraction of irradiated cells {-}"}

if (assessment == "partial-body") {
  est_frac_partial %>%
    t() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    # Fix possible NA values
    dplyr::mutate_if(is.logical, as.double) %>%
    `colnames<-`(c("lower", "estimate", "upper")) %>%
    `row.names<-`("fraction") %>%
    # Convert to hot and format table
    render_table(align = "c")
}

r if (assessment == "hetero") {"## Heterogeneous exposure results"}

r if (assessment == "hetero") {"### Observed fraction of irradiated cells and its yield {-}"}

if (assessment == "hetero") {
  est_mixing_prop_hetero %>%
    as.matrix() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    # Fix possible NA values
    dplyr::mutate_if(is.logical, as.double) %>%
    `colnames<-`(c("yield", "yield.err", "frac", "frac.err")) %>%
    `row.names<-`(c("dose1", "dose2")) %>%
    # Convert to hot and format table
    render_table(align = "c")
}

r if (assessment == "hetero") {"### Heterogeneous exposure estimation {-}"}

if (assessment == "hetero") {
  est_yields_hetero %>%
    t() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    # Fix possible NA values
    dplyr::mutate_if(is.logical, as.double) %>%
    `colnames<-`(c("lower", "estimate", "upper")) %>%
    `row.names<-`(c("yield1", "yield2")) %>%
    # Convert to hot and format table
    render_table(align = "c")
}

if (assessment == "hetero") {
  est_doses_hetero %>%
    t() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    # Fix possible NA values
    dplyr::mutate_if(is.logical, as.double) %>%
    `colnames<-`(c("lower", "estimate", "upper")) %>%
    `row.names<-`(c("dose1 (Gy)", "dose2 (Gy)")) %>%
    # Convert to hot and format table
    render_table(align = "c")
}

r if (assessment == "hetero") {"### Initial fraction of irradiated cells {-}"}

if (assessment == "hetero") {
  est_frac_hetero %>%
    # Fix possible NA values
    as.matrix() %>%
    formatC(format = "f", digits = 3) %>%
    as.data.frame() %>%
    dplyr::mutate_if(is.logical, as.double) %>%
    `colnames<-`(c("estimate", "std.err")) %>%
    `row.names<-`(c("dose1", "dose2")) %>%
    # Convert to hot and format table
    render_table(align = "c")
}