R/volta-viz.R

In priscian/volta: For Flow Cytometers, Calculate Minimum per-Channel Voltage for Optimal Resolution Sensitivity

#' Plot Peak 2 CV vs. PMT voltages & find minimum "knee" voltage
#'
#'@description
#' Creates a plot of Peak 2 CV vs. PMT voltages for each channel for each instrument & finds minimum "knee" voltage for optimal resolution sensitivity. Optionally generates a summary report as an Excel workbook.
#'
#' @param x List object generated by [get_peak2_data]
#' @param report_dir \[Coming soon\]
#' @param image_dir ...
#' @param trans_fun ...
#' @param replace_with_na_condition ...
#' @param remove_empty_cols ...
#' @param save_png ...
#' @param plot_series... ...
#' @param create_smooth_variables... ...
#' @param plot_derivative ...
#' @param points... ...
#' @param debug ...
#' @param xlsx_expression ...
#'
#' @return
#'
#' @examples
#' \dontrun{
#' ## There will totally be code here soon.
#' }

#' @export
plot_voltration_data <- function(
  x, # Result from 'get_voltration_data()'
  report_path = NULL,
  image_dir = NULL,
  save_png = FALSE, # If TRUE, save PNG plots to report directory
  png... = list(),
  x_var_lab = c(PMT_voltage = "PMT Voltage"),
  ## N.B. 'names(y_var_lab)' will correctly extract "log10_CV":
  y_var_lab = c(log10_CV = expression(paste(log[10], " CV"))),
  plot_series... = list(),
  points... = list(),
  xlsx_expression = NULL,
  ## Noli me tangere; when TRUE, used for IRR checks:
  plot_individual_channels = FALSE
)
{
  volta_interactive_off <-
    !(is.null(getOption("volta_interactive_off")) || !getOption("volta_interactive_off"))

  if (missing(x) || is_invalid(x)) {
    x <- .volta$results
  }

  if (interactive() && !volta_interactive_off && is_invalid(report_path)) {
    msg <-
r"---{
Choose a directory & file name for the report spreadsheet, or click [cancel]
to plot the experiments' results directly to the graphics device.
}---"
    message(msg); utils::flush.console()

    defaultFileName <- sprintf("volta-report_%s.xlsx",
      keystone::make_current_timestamp(use_seconds = TRUE, seconds_sep = "+"))
    report_path <- svDialogs::dlg_save(default = defaultFileName, title = "Save volta report",
      filters = svDialogs::dlg_filters[c("xls"), ])$res
  }

  createReport <- FALSE
  if (!is_invalid(report_path) && is.character(report_path))
    createReport <- TRUE

  report_dir <- keystone::normalize_path(dirname(as.character(report_path)))
  if (is_invalid(image_dir)) {
    image_dir <- report_dir
    if (is_invalid(image_dir))
      image_dir <- "."
  }

  if (save_png && !dir.exists(image_dir))
    dir.create(image_dir, recursive = TRUE)

  if (createReport && !dir.exists(report_dir))
    dir.create(report_dir, recursive = TRUE)

  pngArgs <- list(
    #width = 12.5,
    width = 9.375,
    height = 7.3,
    units = "in",
    res = 600
  )
  pngArgs <- utils::modifyList(pngArgs, png..., keep.null = TRUE)

  x_var_lab <- head(x_var_lab, 1)
  if (is_invalid(names(x_var_lab)) || trimws(names(x_var_lab)) == "") names(x_var_lab) <- x_var_lab
  y_var_lab <- head(y_var_lab, 1)
  if (is_invalid(names(y_var_lab)) || trimws(names(y_var_lab)) == "") names(y_var_lab) <- y_var_lab

  ## Create plots
  grobs <- list()
  imagePaths <- sapply(seq_along(x),
    function(a)
    {
      plot_data <- attr(x[[a]], "plot_data")
      experiment_name <- attr(plot_data, "experiment_name")

      plot_seriesArgs <- list(
        x = plot_data$time_series,
        series = names(plot_data$time_series)[-1],
        x_var = names(plot_data$time_series)[1],
        log = "",
        xlab = x_var_lab, ylab = y_var_lab,
        main = experiment_name,
        dev.new... = list(width = 9.375, height = 7.3),
        col = attr(x[[a]], "color"), lwd = 4,
        trend = FALSE,
        segmented = FALSE, segmented... = list(breakpoints... = list(h = 3)),
        legend... = list(x = "topright")
      )
      plot_seriesArgs <-
        utils::modifyList(plot_seriesArgs, plot_series..., keep.null = TRUE)

      ## N.B. 'sprintf(0)' returns 0-length string for any NULL values; use 'format(NULL)' to output "NULL".
      filepath <- sprintf("%s/%03d - %s.png", format(image_dir), a, basename(experiment_name))
      pngArgsCopy <- utils::modifyList(pngArgs, list(filename = filepath), keep.null = TRUE)

      pointsArgs <- list(
        col = "black",
        pch = 4, cex = 1,
        lwd = 3
      )
      pointsArgs <- utils::modifyList(pointsArgs, points..., keep.null = TRUE)

      if (plot_individual_channels) {
        for (i in seq_along(plot_seriesArgs$series)) {
          plotArgsFlit <- rlang::duplicate(plot_seriesArgs, shallow = FALSE)

          pngArgsFlit <- rlang::duplicate(pngArgsCopy, shallow = FALSE)
          pngArgsFlit$filename <-
            sprintf("%s#%s.%s", tools::file_path_sans_ext(pngArgsFlit$filename),
              fs::path_sanitize(plotArgsFlit$series[i], replacement = ";"),
              tools::file_ext(pngArgsFlit$filename))

          plotArgsFlit$series <- plotArgsFlit$series[i]
          plotArgsFlit$col <- plotArgsFlit$col[i]

          if (save_png) do.call(grDevices::png, pngArgsFlit)

          do.call(keystone::plot_series, plotArgsFlit)

          changepoint_cv <- plot_data$inflection_points %>%
            dplyr::filter(channel == plotArgsFlit$series) %>% dplyr::select(-channel) %>%
            data.matrix
          do.call(points, pointsArgs %>% `[[<-`("x", changepoint_cv))

          if (save_png) dev.off()
          else grobs <<- append(grobs, list(grDevices::recordPlot()))
        }

        ## Don't create a report
        createReport <<- FALSE
      } else {
        if (save_png) do.call(grDevices::png, pngArgsCopy)

        do.call(keystone::plot_series, plot_seriesArgs)

        changepoints_cv <- plot_data$inflection_points %>%
          dplyr::select(-channel) %>% data.matrix
        do.call(points, pointsArgs %>% `[[<-`("x", changepoints_cv))

        if (save_png) dev.off()
      }

      return (filepath)
    }, simplify = TRUE)

  if (interactive() && !volta_interactive_off && save_png) {
    msg <- paste0(
r"---{
The volta summary images have been generated in directory:

}---",
    image_dir)
    message(msg); utils::flush.console()

    if (!createReport && !plot_individual_channels)
      return (invisible(image_dir))
  }

  ## Make voltration report.
  if (createReport) {
    rr <- sapply(x,
      function(a)
      {
        attr(a, "plot_data")$inflection_points %>%
          dplyr::rename(
            !!names(x_var_lab) := "inflection",
            !!names(y_var_lab) := "y"
          )
      }, simplify = FALSE)
    names(rr) <- stringr::str_trunc(basename(names(x)), 29, "center")

    duplicateNames <- names(rr) %>% intersect(.[duplicated(.)])
    for(i in duplicateNames) {
      dupIndex <- which(names(rr) == i)
      # Replace w/ sequential numbers:
      names(rr)[dupIndex] <-
        sapply(seq_along(dupIndex),
          function(j) sprintf("%s_%01d", names(rr)[dupIndex[j]], j))
    }

    fileName <- report_path
    rio::export(rr, fileName, rowNames = FALSE)

    wb <- xlsx::loadWorkbook(fileName)
    keystone::poly_eval(xlsx_expression)

    ## Add plots to report.
    if (save_png) {
      ss <- xlsx::getSheets(wb)
      # imageFiles <-
      #   list.files(image_dir, "^\\d{3} - .*?\\.png", full.names = TRUE, ignore.case = TRUE)
      imageFiles <- imagePaths

      plyr::l_ply(seq_along(ss),
        function(i) { xlsx::addPicture(imageFiles[i], ss[[i]], scale = 1, startRow = 1,
          startColumn = 4) })

      xlsx::saveWorkbook(wb, fileName)
    }

    if (interactive() && !volta_interactive_off) {
      msg <- paste0(
r"---{
The volta report has been generated & can be found here:

}---",
      fileName)
      message(msg); utils::flush.console()
    }

    return (invisible(fileName))
  }

  ## At this point, I could save 'grobs' & restore the plots later.
  # browser()
  # dev.new(width = 9.375, height = 7.3)
  # print(length(grobs))
  # grDevices::replayPlot(grobs[[1]])
  # saveRDS(grobs, file = "./data/volta-irr-grobs.rds")
  # g <- readRDS(file = "./data/volta-irr-grobs.rds")
  # grDevices::replayPlot(g[[1]])
  ## Collect the optimal voltages en masse:
  # sapply(r, function(a) a$table$PMT_voltage, simplify = FALSE) %>% unlist %>%
  #   keystone::dataframe(pmt_voltage = .) %>% `[`(1:60, , drop = FALSE)

  if (!is_invalid(image_dir))
    return (invisible(image_dir))
  else
    return (keystone::nop())
}


#' @export
plot.volta <- function(
  x,
  x_var_lab = c(PMT_voltage = "PMT Voltage"),
  ## N.B. 'names(y_var_lab)' will correctly extract "log10_CV":
  y_var_lab = c(log10_CV = expression(paste(log[10], " CV"))),
  points... = list(),
  ...
)
{
  plot_data <- attr(x, "plot_data")
  experiment_name <- attr(plot_data, "experiment_name")

  plot_seriesArgs <- list(
    x = plot_data$time_series,
    series = names(plot_data$time_series)[-1],
    x_var = names(plot_data$time_series)[1],
    log = "",
    xlab = x_var_lab, ylab = y_var_lab,
    main = experiment_name,
    dev.new... = list(width = 9.375, height = 7.3),
    col = attr(x, "color"), lwd = 4,
    trend = FALSE,
    segmented = FALSE, segmented... = list(breakpoints... = list(h = 3)),
    legend... = list(x = "topright")
  )

  pointsArgs <- list(
    col = "black",
    pch = 4, cex = 1,
    lwd = 3
  )
  pointsArgs <- utils::modifyList(pointsArgs, points..., keep.null = TRUE)

  plot_seriesArgs <-
    utils::modifyList(plot_seriesArgs, list(...), keep.null = TRUE)
  do.call(keystone::plot_series, plot_seriesArgs)

  changepoints_cv <- plot_data$inflection_points %>%
    dplyr::select(-channel) %>% data.matrix
  do.call(points, pointsArgs %>% `[[<-`("x", changepoints_cv))
}


#' @export
make_titration_plots <- function(

)
{

}