In calabrialab/ISAnalytics: Analyze gene therapy vector insertion sites data identified from genomics next generation sequencing reads for clonal tracking studies

knitr::opts_chunk$set(echo = FALSE, warning = FALSE)
options(DT.warn.size = FALSE)
library(flexdashboard)
library(DT)
ok_color <- "#77d983"
ko_color <- "#e36868"

.section {
  margin-top: 0rem !important;
}

Pre-processing info {data-orientation=columns}

Col1

# Total samples
total_samples <- params$flag_df |>
  dplyr::distinct(dplyr::across(dplyr::all_of(params$dyn_vars$pcr_id))) |>
  nrow()

# Absolute number of unprocessed reads
abs_unprocessed_reads <- nrow(
  params$flag_df |>
    dplyr::filter(.data$processed == FALSE)
  )
# Percentage of unprocessed samples on total
perc_unprocessed_reads <- round(
  (abs_unprocessed_reads / nrow(params$flag_df)) * 100, 2
)
# Summary table
unprocessed_perc_diff <- tibble::tibble(
        abs = c(nrow(params$removed_nas)),
        perc_on_unprocessed = round(c(nrow(params$removed_nas) /
            abs_unprocessed_reads) * 100, 2),
        perc_on_total = round(c(nrow(params$removed_nas) / 
                                  nrow(params$flag_df)) * 100, 2),
        reason = c("NAs in key")
    )
if (params$log2_req) {
        unprocessed_perc_diff <- unprocessed_perc_diff |>
            tibble::add_row(
                abs = c(nrow(params$removed_zeros)),
                perc_on_unprocessed = round(c(nrow(params$removed_zeros) /
                    abs_unprocessed_reads) * 100, 2),
                perc_on_total = round(
                  c(nrow(params$removed_zeros) / 
                      nrow(params$flag_df)) * 100, 2),
                reason = c("Values <= 0")
            )
}
unprocessed_perc_diff <- unprocessed_perc_diff |>
        tibble::add_row(
            abs = c(abs_unprocessed_reads -
                sum(unprocessed_perc_diff$abs)),
            perc_on_unprocessed = round(c((abs_unprocessed_reads -
                sum(unprocessed_perc_diff$abs)) /
                abs_unprocessed_reads), 2) * 100,
            perc_on_total = round(c((abs_unprocessed_reads -
                sum(unprocessed_perc_diff$abs)) / nrow(params$flag_df)) * 100,
                2),
            reason = c("Pool samples < min samples")
)

Total samples

valueBox(total_samples, icon = "fa-vials", color = "info")

Number of unprocessed samples

valueBox(abs_unprocessed_reads, icon = "fa-filter", color = ifelse(abs_unprocessed_reads == 0, "success", "danger"))

Percentage of unprocessed samples

gauge(round(perc_unprocessed_reads, digits = 2),
      min = 0, max = 100, symbol = "%", 
      sectors = gaugeSectors(success = c(0,0), danger = c(0.01, 100)))

Unprocessed samples summary

datatable(
  unprocessed_perc_diff,
  rownames = FALSE, 
  options = list(dom = 't'),
  colnames = c("Absolute", "% on unprocessed", "% on total", "Reason")
)

Col2 {.tabset .tabset-fade}

Parameter choice and settings

pool_opt <- if (params$by_pool) {
        "* The test was run for each pool"
    } else {
        "* The test was <u>NOT</u> run for each pool"
    }
norm_test <- if (params$norm_test) {
        "* Calculations performed only if data follows normal distribution"
    } else {
        "* Normality test not performed"
    }
key <- paste("* Calculations performed on columns:",
             paste0(params$key, collapse = ", ")
    )
thresh <- paste("* Outlier p-value threshold:", params$outlier_thresh)
logic <- if (length(params$key) > 1) {
        base_flag <- purrr::map_chr(params$key, function(k) {
            paste0(
                "(tdist_", k, " < ", params$outlier_thresh,
                " & zscore_", k, " < 0)"
            )
        })
        if (length(params$flag_logic) == 1) {
            flag_logic <- rep_len(x = params$flag_logic, length(params$key) - 1)
        } else {
            flag_logic <- params$flag_logic
        }
        combined <- rbind(base_flag, c(flag_logic, ""))
        paste(
            "* Key length > 1, flagging formula used: ",
            paste0(combined, collapse = " ")
        )
    } else {
        base_flag <- paste0(
            "(tdist_", params$key, " < ", params$outlier_thresh,
            " & zscore_", params$key, " < 0)"
        )
        paste(
            "* Flagging formula used: ",
            paste0(base_flag)
        )
    }
log2 <- if (params$log2_req) {
        "* Log2 transformation prior to calculations"
    } else {
        ""
    }
choice_msg <- paste0(c(pool_opt, norm_test, key, thresh, logic, log2), collapse = "\n")
cat("#### Parameters and options chosen\n\n", choice_msg)

NAs in key columns

na_df <- params$removed_nas |>
            dplyr::select(
                dplyr::all_of(c(params$pool_col,
                                params$dyn_vars$pcr_id,
                                params$key
                                ))
            )
datatable(
  na_df,
  rownames = FALSE
)

cat("*Nothing to report*")

Negative or zero values (log2 transformation)

datatable(
  params$removed_zeros,
  rownames = FALSE
)

cat("*Nothing to report*")

Unprocessed samples (per pool test)

datatable(
  params$non_proc_pools,
  rownames = FALSE
)

cat("*Nothing to report*")

Post-processing info {data-orientation=rows}

Row1

flagged_abs <- nrow(params$flag_df |>
            dplyr::filter(.data$to_remove == TRUE))
flagged_perc <- round((flagged_abs / total_samples) * 100, 2)

Total flagged samples

valueBox(flagged_abs, icon = "fa-flag")

Flagged samples on total

gauge(round(flagged_perc, digits = 2), min = 0, max = 100, symbol = "%",
      sectors = gaugeSectors(success = c(0,10), warning = c(10.01, 20), danger = c(20.01, 100)))

Row2

Flagged samples details

cols_to_factor <- c(params$pool_col, params$dyn_vars$project_id)
datatable(
  params$flag_df |>
    dplyr::mutate(dplyr::across(dplyr::all_of(cols_to_factor),
                                as.factor)),
  rownames = FALSE,
  filter = 'top',
  options = list(
            order = list(list(1, 'desc'))
          )
) |> 
  formatStyle(columns = "processed", 
              color = styleEqual(
                levels = c(TRUE, FALSE),
                values = c(ok_color, ko_color)
              ), fontWeight = "bold", textTransform = "uppercase") |>
  formatStyle(columns = "to_remove", 
              color = styleEqual(
                levels = c(TRUE, FALSE),
                values = c(ko_color, "black")
              ), fontWeight = "bold", textTransform = "uppercase")

Reproducibility {data-orientation=rows}

Row1 {data-height=600}

Session info {style="width: 95% !important"}

sessionInfo()

calabrialab/ISAnalytics documentation built on Nov. 2, 2023, 8:57 p.m.