Plot standard curve thumbnail (#183)

* reformat docs

* new function

* better visuals and switch in template

* add margin

* format code, indentation etc

* improve visuals

* listeners are working in other direction

* add synchronisation functionality and slightly refactor code

* format code to stay consistent

R/plots-standard_curve.R

@@ -4,7 +4,6 @@
 #' Plot standard curve samples of a plate of a given analyte.
 #'
 #' @param plate A 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 datatype as in the plate file. By default equals to `Net MFI`
 #' @param decreasing_rau_order If `TRUE` the RAU values are plotted in decreasing order, `TRUE` by default
@@ -130,6 +129,9 @@ plot_standard_curve_analyte <- function(plate,
 
 #' Plot standard curve of a certain analyte with fitted model
 #'
+#' @description
+#' Function plots the values of standard curve samples and the fitted model.
+#'
 #' @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`
@@ -145,10 +147,7 @@ plot_standard_curve_analyte <- function(plate,
 #' @param ... Additional arguments passed to the `predict` function
 #'
 #' @return a ggplot object with the plot
-#'
-#' @description
-#' Function plots the values of standard curve samples and the fitted model.
-#'
+#
 #'
 #' @import ggplot2
 #'
@@ -222,3 +221,64 @@ plot_standard_curve_analyte_with_model <- function(plate,
   )
   return(p)
 }
+
+
+#' @title Standard curve thumbnail for report
+#'
+#' @description
+#' Function generates a thumbnail of the standard curve for a given analyte.
+#' The thumbnail is used in the plate report. It doesn't have any additional
+#' parameters, because it is used only internally.
+#'
+#' @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`
+#'
+#' @return ggplot object with the plot
+#'
+#' @keywords internal
+plot_standard_curve_thumbnail <- function(plate, analyte_name, data_type = "Median") {
+  if (!inherits(plate, "Plate")) {
+    stop("plate object should be a Plate")
+  }
+  if (!(analyte_name %in% plate$analyte_names)) {
+    stop(analyte_name, " not found in the plate object")
+  }
+  plot_data <- data.frame(
+    MFI = plate$get_data(analyte_name, "STANDARD CURVE", data_type = data_type),
+    plate = plate$plate_name,
+    RAU = dilution_to_rau(plate$get_dilution_values("STANDARD CURVE"))
+  )
+  blank_mean <- mean(plate$get_data(analyte_name, "BLANK", data_type = data_type))
+  x_ticks <- c(plot_data$RAU, max(plot_data$RAU) + 1)
+  x_labels <- c(sprintf("%0.2f", plot_data$RAU), "")
+
+
+
+  p <- ggplot2::ggplot(plot_data, aes(x = .data$RAU, y = .data$MFI)) +
+    ggplot2::geom_point(aes(color = "Standard curve samples"), size = 9) +
+    ggplot2::geom_hline(
+      aes(yintercept = blank_mean, color = "Blank mean"),
+      linetype = "solid", linewidth = 1.8
+    ) +
+    ggplot2::labs(title = analyte_name, x = "", y = "") +
+    ggplot2::scale_x_continuous(
+      breaks = x_ticks, labels = x_labels,
+      trans = "log10"
+    ) +
+    #ggplot2::scale_y_continuous(trans = "log10") +
+    ggplot2::theme_minimal() +
+    ggplot2::theme(
+      axis.line = element_line(colour = "black", size = 2),
+      axis.text.x = element_text(size = 0),
+      axis.text.y = element_text(size = 0),
+      legend.position = "none",
+      plot.title = element_text(hjust = 0.5, size = 50),
+      panel.grid.minor = element_blank(),
+    ) +
+    ggplot2::coord_trans(x = "reverse") +
+    ggplot2::scale_color_manual(
+      values = c("Standard curve samples" = "blue", "Blank mean" = "red", "Min-max RAU bounds" = "gray")
+    )
+  p
+}

inst/templates/plate_report_template.Rmd

@@ -68,6 +68,7 @@ plot_layout(params$plate)
     display: grid;
     grid-template-columns: repeat(5, 1fr);
     gap: 5px; /* Space between the plots */
+    margin-top: 20px;
   }
 
   .plot-container {
@@ -89,31 +90,33 @@ plot_layout(params$plate)
 
 <script>
   document.addEventListener('DOMContentLoaded', function () {
-    var plotLinks = document.querySelectorAll('.plot-container a');
 
-    plotLinks.forEach(function (link) {
+    // Add event listeners to the standard curve thumbnails
+    var thumbnailsLinks = document.querySelectorAll('.plot-container a');
+    thumbnailsLinks[0].closest('.plot-container').classList.add('active');
+
+    thumbnailsLinks.forEach(function (link) {
       link.addEventListener('click', function (event) {
 
-        var plotContainer = this.closest('.plot-container');
-        var plots = document.querySelectorAll('.plot-container');
+        var selectedThumbnail = this.closest('.plot-container');
+        var thumbnails = document.querySelectorAll('.plot-container');
         var generated_tablist = document.querySelectorAll('.nav.nav-tabs li');
         var targetId = this.getAttribute('href').substring(1);
         var targetElement = document.getElementById(targetId);
 
-        // Remove 'active' class from all plots and add to the clicked one
-        plots.forEach(function (p) {
-          p.classList.remove('active');
-        });
-        generated_tablist.forEach(function (p) {
+        // Remove 'active' class from all thumbnails and add to the clicked one
+        thumbnails.forEach(function (p) {
           p.classList.remove('active');
         });
-        plotContainer.classList.add('active');
+        selectedThumbnail.classList.add('active');
 
-        // Find and add 'active' class to the corresponding tab item
+        // Find and add 'active' class to the corresponding tab item and remove from others
         generated_tablist.forEach(function (tabItem) {
           var tabLink = tabItem.querySelector('a');
           if (tabLink && tabLink.getAttribute('href').substring(1) === targetId) {
             tabItem.classList.add('active');
+          } else {
+            tabItem.classList.remove('active');
           }
         });
 
@@ -129,6 +132,25 @@ plot_layout(params$plate)
       });
     });
   });
+
+  // Add event listeners to the tabs in order to synchronize analyte selectors
+  setTimeout(function () {
+    var tabs = document.querySelectorAll('.nav.nav-tabs li');
+    tabs.forEach(function (tab) {
+      tab.addEventListener('click', function (event) {
+        var targetId = this.querySelector('a').getAttribute('href').substring(1);
+        var thumbnails = document.querySelectorAll('.plot-container');
+
+        thumbnails.forEach(function (thumb) {
+          if (thumb.querySelector('a').getAttribute('href').substring(1) === targetId) {
+            thumb.classList.add('active');
+          } else {
+            thumb.classList.remove('active');
+          }
+        });
+      });
+    });
+  }, 600);
 </script>
 
 
@@ -144,7 +166,8 @@ for (i in seq_along(params$plate$analyte_names)) {
              '<a href="#', tolower(params$plate$analyte_names[i]), '" role="tab" data-toggle="tab" aria-controls="', tolower(params$plate$analyte_names[i]), '" aria-expanded="false">'))
   # Generate the plot
   model <- create_standard_curve_model_analyte(params$plate, params$plate$analyte_names[i])
-  print(plot_standard_curve_analyte_with_model(params$plate, model, plot_legend = FALSE, plot_asymptote = FALSE, plot_rau_bounds = FALSE))
+  print(plot_standard_curve_thumbnail(params$plate, params$plate$analyte_names[i])) 
+#  print(plot_standard_curve_analyte_with_model(params$plate, model, plot_legend = FALSE, #plot_asymptote = FALSE, plot_rau_bounds = FALSE))
   cat('</a></div>')
 }
 # Close the grid

tests/testthat/test-helpers.R

@@ -39,7 +39,7 @@ test_that("Test is.scalar", {
 
 test_that("Test verbose cat", {
   expect_output(verbose_cat("a", "b"), "ab")
-  expect_null(verbose_cat("a", "b", verbose = F))
+  expect_null(verbose_cat("a", "b", verbose = FALSE))
 })
 
 test_that("Test clamp function", {