Stacked standard curves

DESCRIPTION

@@ -3,7 +3,7 @@ Type: Package
 Title: Reading, Quality Control and Preprocessing of MBA (Multiplex Bead Assay) Data 
 Description: Speeds up the process of loading raw data from MBA (Multiplex Bead Assay) examinations, performs quality control checks, and automatically normalises the data, preparing it for more advanced, downstream tasks. The main objective of the package is to create a simple environment for a user, who does not necessarily have experience with R language. The package is developed within the project of the same name - 'PvSTATEM', which is an international project aiming for malaria elimination.
 BugReports: https://github.com/mini-pw/PvSTATEM/issues
-Version: 0.1.2
+Version: 0.1.3
 License: BSD_3_clause + file LICENSE
 Encoding: UTF-8
 Authors@R: c(
@@ -33,6 +33,7 @@ Imports:
     lubridate,
     R.utils,
     svglite,
+    scales,
     fs
 Suggests:
     knitr,

NAMESPACE

@@ -14,11 +14,17 @@ export(plot_layout)
 export(plot_mfi_for_analyte)
 export(plot_standard_curve_analyte)
 export(plot_standard_curve_analyte_with_model)
+export(plot_standard_curve_stacked)
+export(process_dir)
+export(process_file)
 export(process_plate)
+export(read_layout_data)
 export(read_luminex_data)
+export(read_xponent_format)
 export(translate_sample_names_to_sample_types)
 import(R6)
 import(dplyr)
+import(fs)
 import(ggplot2)
 import(ggrepel)
 import(grid)
@@ -32,8 +38,10 @@ import(svglite)
 import(utils)
 importFrom(R.utils,isAbsolutePath)
 importFrom(R6,R6Class)
+importFrom(fs,file_exists)
 importFrom(fs,path_abs)
 importFrom(grDevices,dev.size)
 importFrom(stats,IQR)
 importFrom(stats,predict)
 importFrom(stats,quantile)
+importFrom(stringr,str_split)

NEWS.md

@@ -1,17 +1,26 @@
+PvSTATEM 0.1.3
+---------------------------------------------------------------
+* fixed an issue with writing into the home user's directory
+* fixed an issue with reading plate files containing empty wells in the middle of the layout
+* added a badge displaying coverage status 
+
+
 PvSTATEM 0.1.2
 ---------------------------------------------------------------
-* uploaded missing vignettes
+* uploaded missing vignettes that were removed in the previous release
+
 
 PvSTATEM 0.1.1
 ---------------------------------------------------------------
 * released the package to CRAN
 * fixed minor formatting issues
 
+
 PvSTATEM 0.1.0
 ---------------------------------------------------------------
 * enhanced and unified file saving for generate_plate_report and process_plate
 * reduced HTML report size and improved its structure
-* remove extraneous column from RAU output
+* removed extraneous column from RAU output
 * added notes field in the HTML report
 * made nplr warnings more informative
 * added vignette for generate_plate_report function
@@ -22,24 +31,24 @@ PvSTATEM 0.0.5
 ---------------------------------------------------------------
 * added function `generate_plate_report` generating the html report
 * added nMFI normalisation type
-* added an option to include raw MFI in the output of `process_plate` function
+* added an option to include raw MFI in the output of the `process_plate` function
 * renamed output of the model to RAU (Relative Antibody Unit), which should be more interpretable for human
 * simple censoring of the extrapolation
 
 
 PvSTATEM 0.0.4
 ---------------------------------------------------------------
 * met the CRAN policy
-* issue templates
-* the plate object view options
+* fixed the issue templates
+* added the plate object view options
 
 
 PvSTATEM 0.0.3
 ---------------------------------------------------------------
 * refactored the whole package structure to simplify the usage
-* new, much faster parser for the xPONENT and INTELLIFLEX files
+* added a new, much faster parser for the xPONENT and INTELLIFLEX files
 * model encapsulation for the standard curve fitting
-* new plots - MFI chart and layout plot
+* added new plots - MFI chart and layout plot
 * updated blank adjustment function
 * error fixes
 

R/config.R

@@ -0,0 +1,22 @@
+PvSTATEM.env <- new.env(parent = emptyenv())
+
+# MBA formats
+PvSTATEM.env$mba_formats <- c("xPONENT", "INTELLIFLEX")
+
+# String patterns for declared MBA formats
+PvSTATEM.env$xponent_pattern <- "xpontent|xponent"
+PvSTATEM.env$intelliflex_pattern <- "intelliflex"
+PvSTATEM.env$mba_pattern <- paste(
+  PvSTATEM.env$xponent_pattern,
+  PvSTATEM.env$intelliflex_pattern,
+  sep = "|"
+)
+
+# Normalisation types
+PvSTATEM.env$normalisation_types <- c("RAU", "nMFI")
+
+# String patterns for declared normalisation types
+PvSTATEM.env$normalisation_pattern <- paste0(
+  PvSTATEM.env$normalisation_types,
+  collapse = "|"
+)

R/helpers.R

@@ -302,3 +302,57 @@ validate_filepath_and_output_dir <- function(filename, output_dir, plate_name, s
 
   return(output_path)
 }
+
+#' @title
+#' Check if two paths are equal
+#'
+#' @description
+#' Function checks if two paths are equal after converting them to absolute paths.
+#'
+#' @param path1 (`character(1)`) The first path to be compared.
+#' @param path2 (`character(1)`) The second path to be compared.
+#'
+#' @return (`logical(1)`) `TRUE` if the paths are equal, `FALSE` otherwise.
+#'
+#' @keywords internal
+check_path_equal <- function(path1, path2) {
+  path1 <- fs::path_abs(path1)
+  path2 <- fs::path_abs(path2)
+  return(identical(path1, path2))
+}
+
+#' @title
+#' Check if a mba format is supported
+#'
+#' @description
+#' Check if a given format is supported.
+#'
+#'
+#' @param format (`character(1`) Format string
+#' @param allow_nullable (`logical(1)`) Set to `TRUE` if a format can be NULL
+#' Defaults to `FALSE`.
+#'
+#' @return (`logical(1)`) `TRUE` if the format is in the supported list, else `FALSE`
+#'
+#' @keywords internal
+is_mba_format <- function(format, allow_nullable = FALSE) {
+  if (is.null(format)) {
+    return(allow_nullable)
+  }
+  return(format %in% PvSTATEM.env$mba_formats)
+}
+
+#' @title
+#' Sort a flat list by value
+#'
+#' @param list_obj A list to sort
+#' @param value_f Function that expects a element of the list
+#' and returns a value to sort the list by.
+#' @param decreasing Should the sorting by decreasing or increasing
+#'
+sort_list_by <- function(list_obj, decreasing = FALSE, value_f = function(elem) elem) {
+  values <- lapply(list_obj, value_f)
+  values_order <- order(unlist(values), decreasing = decreasing)
+  sorted_names <- names(list_obj)[values_order]
+  list_obj[sorted_names]
+}

R/parser-layout.R

@@ -36,6 +36,8 @@ read_location_data_xlsx <- function(location_file_path, ...) {
 #'
 #' @import readxl
 #' @import utils
+#'
+#' @export
 read_layout_data <- function(layout_file_path, ...) {
   if (!file.exists(layout_file_path)) stop("Layout file '", layout_file_path, "' not found")
 

R/parser-xponent.R

@@ -510,6 +510,8 @@ crc32_parser <- function(separator) {
 #'
 #' @import stringr
 #' @import readr
+#'
+#' @export
 read_xponent_format <- function(path, exact_parse = FALSE, encoding = "utf-8", separator = ",", verbose = TRUE) {
   lines <- readr::read_lines(
     path,

R/plots-standard_curve.R

@@ -134,11 +134,15 @@ plot_standard_curve_analyte <- function(plate,
 #'
 #' @param plate Plate object
 #' @param model fitted `Model` object, which predictions we want to plot
-#' @param data_type Data type of the value we want to plot - the same datatype as in the plate file. By default equals to `Median`
-#' @param decreasing_rau_order If `TRUE` the RAU values are plotted in decreasing order, `TRUE` by default.
-#' @param log_scale Which elements on the plot should be displayed in log scale. By default `"all"`. If `NULL` or `c()` no log scale is used, if `"all"` or `c("RAU", "MFI")` all elements are displayed in log scale.
+#' @param data_type Data type of the value we want to plot - the same
+#' datatype as in the plate file. By default equals to `Median`
+#' @param decreasing_rau_order If `TRUE` the RAU values are plotted in
+#' decreasing order, `TRUE` by default.
+#' @param log_scale Which elements on the plot should be displayed in log scale.
+#' By default `"all"`. If `NULL` or `c()` no log scale is used,
+#' if `"all"` or `c("RAU", "MFI")` all elements are displayed in log scale.
 #' @param plot_asymptote If `TRUE` the asymptotes are plotted, `TRUE` by default
-#' @param plot_test_predictions If `TRUE` the predictions for the test samples are plotted, `TRUE` by default
+#' @param plot_test_predictions If `TRUE` the predictions for the test samples are plotted, `TRUE` by default.
 #' The predictions are obtained through extrapolation of the model
 #' @param plot_blank_mean If `TRUE` the mean of the blank samples is plotted, `TRUE` by default
 #' @param plot_rau_bounds If `TRUE` the RAU bounds are plotted, `TRUE` by default
@@ -232,12 +236,15 @@ plot_standard_curve_analyte_with_model <- function(plate,
 #'
 #' @param plate Plate object
 #' @param analyte_name Name of the analyte of which standard curve we want to plot.
-#' @param data_type Data type of the value we want to plot - the same types as in the plate file. By default equals to `median`
+#' @param data_type Data type of the value we want to plot - the same
+#' types as in the plate file. By default equals to `median`
 #'
 #' @return ggplot object with the plot
 #'
 #' @keywords internal
-plot_standard_curve_thumbnail <- function(plate, analyte_name, data_type = "Median") {
+plot_standard_curve_thumbnail <- function(plate,
+                                          analyte_name,
+                                          data_type = "Median") {
   if (!inherits(plate, "Plate")) {
     stop("plate object should be a Plate")
   }
@@ -282,3 +289,124 @@ plot_standard_curve_thumbnail <- function(plate, analyte_name, data_type = "Medi
     )
   p
 }
+
+#' @title Standard curve stacked plot for levey-jennings report
+#'
+#' @description
+#' Function generates a plot of stacked on top of each other standard curves
+#' for a given analyte form a list of plates. The plot is created with the
+#' levey-jennings report in mind, but it can be run by itself.
+#'
+#' @param list_of_plates list of Plate objects
+#' @param analyte_name Name of the analyte of which standard curves we want to plot.
+#' @param data_type Data type of the value we want to plot - the same
+#' datatype as in the plate file. By default equals to `Median`
+#' @param monochromatic If `TRUE` the color of standard curves changes
+#' from white (the olders) to blue (the newest) it helps to observe drift in
+#' calibration of device, otherwise more varied colors are used `TRUE` by default
+#' @param decreasing_dilution_order If `TRUE` the dilution values are
+#' plotted in decreasing order, `TRUE` by default
+#' @param log_scale Which elements on the plot should be displayed in log scale. 
+#' By default `"all"`. If `NULL` or `c()` no log scale is used,
+#' if `"all"` or `c("dilutions", "MFI")` all elements are displayed in log scale.
+#' @param verbose If `TRUE` prints messages, `TRUE` by default
+#'
+#' @return ggplot object with the plot
+#'
+#' @export
+plot_standard_curve_stacked <- function(list_of_plates,
+                                        analyte_name,
+                                        data_type = "Median",
+                                        decreasing_dilution_order = TRUE,
+                                        monochromatic = TRUE,
+                                        log_scale = c("all"),
+                                        verbose = TRUE) {
+
+  AVAILABLE_LOG_SCALE_VALUES <- c("all", "dilutions", "MFI")
+
+  if (!is.null(log_scale) && !all(log_scale %in% AVAILABLE_LOG_SCALE_VALUES)) {
+    stop("log_scale should be a character vector containing elements from set: ", paste(AVAILABLE_LOG_SCALE_VALUES, collapse = ", ", "\nInstead passed: ", log_scale))
+  }
+  if (!is.list(list_of_plates)) {
+    stop("list_of_plates should be a list of Plate objects, create it using `process_dir` function")
+  }
+  if (length(list_of_plates) == 0) {
+    stop("list_of_plates should contain at least one Plate object")
+  }
+  for (plate in list_of_plates) {
+    if (!inherits(plate, "Plate")) {
+      stop("list_of_plates should contain only a Plate objects, create it using `process_dir` function")
+    }
+    if (!(analyte_name %in% plate$analyte_names)) {
+      stop(analyte_name, " not found in one of the plate on list_of_plates")
+    }
+  }
+
+  plot_name <- paste0("Standard curves of: ", analyte_name)
+
+  # Scale x and y if needed
+  x_log_scale <- "dilutions" %in% log_scale || "all" %in% log_scale
+  y_log_scale <- "MFI" %in% log_scale || "all" %in% log_scale
+  x_trans <- ifelse(x_log_scale, "log10", "identity")
+  x_cords_trans <- ifelse(decreasing_dilution_order, "reverse", "identity")
+  y_trans <- ifelse(y_log_scale, "log10", "identity")
+
+  xlab <- ifelse(x_log_scale, "Dilutions (log scale)", "Dilutions")
+  x_ticks <- list_of_plates[[1]]$get_dilution_values("STANDARD CURVE")
+  x_labels <- list_of_plates[[1]]$get_dilution("STANDARD CURVE")
+
+  # Add the BLANK to the plot
+  x_ticks <- c(x_ticks, min(x_ticks) / 2)
+  x_labels <- c(x_labels, "B")
+  ylab <- ifelse(y_log_scale, paste("MFI ", data_type, "(log scale)"), paste("MFI ", data_type))
+
+  options(scipen = 30)
+  p <- ggplot2::ggplot()
+  p <- p + ggplot2::labs(title = plot_name, x = xlab, y = ylab) +
+    ggplot2::scale_x_continuous(
+      labels = x_labels,
+      breaks = x_ticks,
+      trans = x_trans
+    ) +
+    ggplot2::scale_y_continuous(trans = y_trans) +
+    ggplot2::coord_trans(x = x_cords_trans) +
+    ggplot2::theme_minimal() +
+    ggplot2::theme(
+      axis.line = element_line(colour = "black"),
+      axis.text.x = element_text(size = 9, angle = 45, hjust = 1, vjust = 1),
+      axis.text.y = element_text(size = 9),
+      legend.position = "none",
+      panel.grid.minor = element_line(color = scales::alpha("grey", .5), size = 0.1) # Make the minor grid lines less visible
+    )
+
+  number_of_colors <- length(list_of_plates)
+  counter <- 1
+  if (monochromatic) {
+    # I don't want white and next one to be colors since on white background it's not visible
+    number_of_colors <- number_of_colors + 2
+    counter <- counter + 2 # skip white and closest one to white
+
+    palette <- grDevices::colorRampPalette(c("white", "blue"))
+    colors <- palette(number_of_colors)
+  } else {
+    colors <- scales::hue_pal()(number_of_colors)
+  }
+
+  for  (plate in list_of_plates) {
+    blank_mean <- mean(plate$get_data(analyte_name, "BLANK", data_type = data_type))
+
+    plot_data <- data.frame(
+      MFI = c(plate$get_data(analyte_name, "STANDARD CURVE", data_type = data_type), blank_mean),
+      dilutions_value = c(plate$get_dilution_values("STANDARD CURVE"), min(plate$get_dilution_values("STANDARD CURVE")) / 2)
+    )
+
+    # Add standard curve samples to the plot
+    p <- p + ggplot2::geom_point(data = plot_data, aes(x = dilutions_value, y = MFI), color = colors[counter], size = 3) +
+      ggplot2::geom_line(data = plot_data, aes(x = dilutions_value, y = MFI), color = "black", linewidth = 1.5) +
+      ggplot2::geom_line(data = plot_data, aes(x = dilutions_value, y = MFI), color = colors[counter], linewidth = 1.1)
+
+    counter <- counter + 1
+  }
+
+  p
+}