Levey jennings report

NAMESPACE

@@ -5,6 +5,7 @@ S3method(predict,Model)
 S3method(summary,Plate)
 export(PlateBuilder)
 export(create_standard_curve_model_analyte)
+export(generate_levey_jennings_report)
 export(generate_plate_report)
 export(get_nmfi)
 export(is_valid_data_type)

R/classes-plate.R

@@ -424,7 +424,7 @@ Plate <- R6::R6Class(
     #' @param threshold The method used to calculate the background value for each analyte.
     #' Every value below this threshold will be clamped to the threshold value.
     #' By default `max`. Available methods are: `min`, `max`, `mean`, `median`.
-    #' @param inplace Whether the method should produce new plate with adjusted
+    #' @param in_place Whether the method should produce new plate with adjusted
     #' values or not, By default `TRUE` - operates on the current plate.
     blank_adjustment = function(threshold = "max", in_place = TRUE) {
       if (self$blank_adjusted) {

R/classes-plate_builder.R

@@ -280,6 +280,8 @@ PlateBuilder <- R6::R6Class(
     #' @description
     #' Set the plate name for the plate.
     #' The plate name is extracted from the filepath
+    #'
+    #' @param file_path a character value representing the path to the file
     set_plate_name = function(file_path) {
       stopifnot(is.character(file_path) && is.scalar(file_path))
       file_name_without_extension <-

R/generate_report.R

@@ -101,26 +101,59 @@ generate_plate_report <-
   }
 
 
-#' Generate a report with Levey-Jennings plots.
+#' Generate a Levey-Jennings Report for Multiple Plates.
 #'
-#' This function generates a report with Levey-Jennings plots.
+#' @description
+#' This function generates a Levey-Jennings report for a list of plates. The report includes layout plot, levey jennings plot, for each analyte and selected dilutions.
+#' The report also includes stacked standard curves plot in both monochromatic and color versions for each analyte.
 #' The report is generated using the `levey_jennings_report_template.Rmd` template.
 #'
 #' @param list_of_plates A list of plate objects.
-#' @param filename (`character(1)`) The name of the output file. If not
-#' provided, the filename will be created based on the plate name
-#' with the suffix '_report.html'.
-#' @param output_dir (`character(1)`) The directory where the report
-#' should be saved. Default is 'reports'.
+#' @param report_title (`character(1)`) The title of the report.
+#' @param dilutions (`character`) A character vector specifying the dilutions to be included in the report. Default is `c("1/100", "1/400")`.
+#' @param filename (`character(1)`) The name of the output HTML report file.
+#' If not provided or set to `NULL`, the filename will be based on the first plate name, formatted as `{plate_name}_levey_jennings.html`.
+#' If the filename does not contain the `.html` extension, it will be automatically added.
+#' Absolute file paths in `filename` will override `output_dir`.
+#' Existing files at the specified path will be overwritten.
 #'
+#' @param output_dir (`character(1)`) The directory where the report will be saved. Defaults to 'reports'.
+#' If `NULL`, the current working directory will be used. Necessary directories will be created if they do not exist.
 #'
-#' @return A report.
-#' @keywords internal
+#' @param additional_notes (`character(1)`) Additional notes to be included in the report. Markdown formatting is supported. If not provided, the section will be omitted.
+#'
+#' @return A Levey-Jennings report in HTML format.
+#'
+#' @import svglite
+#'
+#' @examples
+#' output_dir <- tempdir(check = TRUE)
+#'
+#' dir_with_luminex_files <- system.file("extdata", "multiplate_reallife_reduced",
+#'   package = "PvSTATEM", mustWork = TRUE
+#' )
+#' list_of_plates <- process_dir(dir_with_luminex_files,
+#'   return_plates = TRUE, format = "xPONENT", output_dir = output_dir
+#' )
+#' note <- "This is a Levey-Jennings report.\n**Author**: Jane Doe \n**Tester**: John Doe"
+#'
+#' generate_levey_jennings_report(
+#'   list_of_plates = list_of_plates,
+#'   report_title = "QC Report",
+#'   dilutions = c("1/100", "1/200"),
+#'   output_dir = tempdir(),
+#'   additional_notes = note
+#' )
+#'
+#' @export
 generate_levey_jennings_report <-
   function(list_of_plates,
+           report_title,
+           dilutions = c("1/100", "1/400"),
            filename = NULL,
-           output_dir = "reports") {
-    message("Generating report... This will take approximately 30 seconds.")
+           output_dir = "reports",
+           additional_notes = NULL) {
+    message("Generating report... For large reports with more than 30 plates, this will take a few minutes.")
 
     plate <- list_of_plates[[1]]
     output_path <- validate_filepath_and_output_dir(filename, output_dir, plate$plate_name, "levey_jennings", "html")
@@ -137,11 +170,28 @@ generate_levey_jennings_report <-
         mustWork = TRUE
       )
 
+    # markdown does not support single line breaks, so we need to replace them with two spaces and a line break
+    if (!is.null(additional_notes)) {
+      additional_notes <-
+        gsub(
+          pattern = "\n",
+          replacement = "  \n",
+          x = additional_notes
+        )
+    }
+
     rmarkdown::render(
       template_path,
-      params = list(list_of_plates = list_of_plates),
+      params = list(
+        list_of_plates = list_of_plates,
+        report_title = report_title,
+        dilutions = dilutions,
+        additional_notes = additional_notes
+      ),
       output_file = filename,
       output_dir = output_dir,
+      knit_root_dir = output_dir,
+      intermediates_dir = output_dir,
       quiet = TRUE
     )
     message(paste0(

inst/templates/levey_jennings_report_template.Rmd

@@ -1,10 +1,133 @@
 ---
-title: "TEST"
+title: "Levey-Jennings Raport: `r paste0('*', params$report_title, '*')`"
 output: html_document
 params:
   list_of_plates: !r NULL
+  report_title: !r NULL
+  dilutions: !r NULL
+  additional_notes: !r NULL
 ---
+
+```{r param-check, echo=FALSE}
+if (is.null(params$list_of_plates)) {
+  stop("The `list_of_plates` must be provided when rendering the document.")
+}
+if (!is.list(params$list_of_plates)) {
+  stop("The `list_of_plates` must be a list of `Plate` instances.")
+}
+if (length(params$list_of_plates) == 0) {
+  stop("The `list_of_plates` must contain at least one `Plate` instance.")
+}
+if (length(params$list_of_plates) < 10) {
+  warning("The `list_of_plates` should contain at least 10 `Plate` instances to generate a comprehensive report.")
+}
+if (!all(sapply(params$list_of_plates, inherits, "Plate"))) {
+  stop("The list_of_plates contains objects that are not of class Plate.")
+}
+if (is.null(params$report_title)) {
+  stop("The `report_title` must be provided when rendering the document.")
+}
+if (!is(params$report_title, "character")) {
+  stop("The `report_title` must be a character value.")
+}
+if (is.null(params$dilutions)) {
+  stop("The `dilutions` must be provided when rendering the document.")
+}
+if (!is.character(params$dilutions)) {
+  stop("The `dilutions` must be a character value.")
+}
+if (!all(grepl("(^1\\s*)\\/(\\s*\\d+$)", params$dilutions))) {
+  stop("The `dilutions` must be in the format '1/digit'.")
+}
+for (dilution in params$dilutions) {
+  if (!all(sapply(params$list_of_plates, function(plate) dilution %in% plate$get_dilution("STANDARD CURVE")))) {
+    plate_where_dilution_is_missing <- which(sapply(list_of_plates, function(plate) !(dilution %in% plate$get_dilution("STANDARD CURVE"))))
+    stop("The dilution", dilution, "is not present in plates ", paste(plate_where_dilution_is_missing, collapse = ", "))
+  }
+}
+analyte_names <- params$list_of_plates[[1]]$analyte_names
+for (plate in params$list_of_plates) {
+  if (!identical(plate$analyte_names, analyte_names)) {
+    stop("The plates do not contain the same analytes.")
+  }
+}
+if (!is.null(params$additional_notes) && !is(params$additional_notes, "character")) {
+  stop("The `additional_notes` must be a character value.")
+}
+
+date_of_first_plate <- min(sapply(params$list_of_plates, function(plate) plate$plate_datetime))
+date_of_last_plate <- max(sapply(params$list_of_plates, function(plate) plate$plate_datetime))
+
+# i need to add this trick otherwise i get error in format function
+# Error in prettyNum(.Internal(format(x, trim, digits, nsmall, width, 3L,  :
+#  invalid 'trim' argument
+# it may cause some problems with timezones but few hours difference is not a big deal
+date_of_first_plate <- as.POSIXct(date_of_first_plate, origin = "1970-01-01", tz = "UTC")
+date_of_last_plate <- as.POSIXct(date_of_last_plate, origin = "1970-01-01", tz = "UTC")
+time_span <- difftime(date_of_last_plate, date_of_first_plate, units = "days")
+```
+
 Report generated on:  `r format(Sys.time(), "%d-%m-%Y %H:%M:%S")`.  
+First plate was run on: `r if(!is.null(date_of_first_plate)) format(date_of_first_plate, "%d-%m-%Y %H:%M") else "Date of running plate was not found in Luminex file"`.  
+Last plate was run on: `r if(!is.null(date_of_last_plate)) format(date_of_last_plate, "%d-%m-%Y %H:%M") else "Date of running plate was not found in Luminex file"`.  
+Time span: `r if(!is.null(time_span)) paste0(round(time_span, 2), " days") else "Dates were not found in Luminex file"`.  
+Number of plates used in report: `r length(params$list_of_plates)`.  
+Plates have `r paste0(length(analyte_names), " analytes")`.  
+Standard curve sample dilutions: `r format_dilutions(params$list_of_plates[[1]]$dilutions, params$list_of_plates[[1]]$dilution_values, params$list_of_plates[[1]]$sample_types)`.
+
+------------------
+
+`r if(!is.null(params$additional_notes)) "### Additional notes \n" `  
+
+`r if(!is.null(params$additional_notes)) params$additional_notes `  
+
+`r if(!is.null(params$additional_notes)) "\n -------------------" ` 
+
+### Plates used in this report
+
+<details open>
+  <summary>Click to show/hide list</summary>
+```{r list-of-plates, echo=FALSE, results='asis'}
+for (plate in params$list_of_plates) {
+  cat(paste0("- ", plate$plate_name, "\n"))
+}
+```
+</details>
+
+### Plate layout
+
+<details open>
+  <summary>Click to show/hide layout</summary>
+```{r plate-layout, fig.width=7, fig.height=4, fig.align='center', dev='jpeg', echo=FALSE, dpi=72}
+plot_layout(params$list_of_plates[[1]])
+```
+</details>
+
+------------------
+
+### Details for given analyte {.tabset .tabset-fade}
+
+```{r quality-control, results='asis', echo=FALSE, message=FALSE, out.width="50%", out.height="325", dev='svglite', dpi=72, warning=FALSE}
+# Code used to create dynamic tabs based on the number of analytes
+for (i in seq_along(analyte_names)) {
+  cat(paste0("#### ", analyte_names[i], "\n"))
+
+  # Plot stacked curves monochromatic
+  print(plot_standard_curve_stacked(params$list_of_plates, analyte_names[i]))
+
+  # Plot stacked curves colored
+  print(plot_standard_curve_stacked(params$list_of_plates, analyte_names[i], monochromatic = FALSE))
+
+  for (dilution in params$dilutions) {
+
+    # Plot levey-jennings
+    print(plot_levey_jennings(params$list_of_plates, analyte_names[i], dilution))
+  }
+
+  cat("\n\n")
+}
+```
+
 ------------------
 
 ### &nbsp;

pkgdown/_pkgdown.yml

@@ -15,8 +15,9 @@ reference:
     - process_file
     - process_dir
     - generate_plate_report
+    - generate_levey_jennings_report
   - title: Plate and Model classes
-    desc: Instances of the Plate and Model classes and additional functions for predictions and normalisation. These methods are used to store the data and the model and faciliate the analysis.
+    desc: Instances of the Plate and Model classes and additional functions for predictions and normalisation. These methods are used to store the data and the model and facilitate the analysis.
     contents:
     - Model
     - Plate