bug fixes #16, #24 (#32)

* simple README with overview and installation (#7) * website for docs (#8) * add sample vignette and artificial dataset * pkgdown workflow --------- Co-authored-by: Fersoil <Fersoil> * bug: standard curve sample type (#13) * simple README with overview and installation (#7) * website for docs (#8) * add sample vignette and artificial dataset * pkgdown workflow --------- Co-authored-by: Fersoil <Fersoil> * added STANDARD CURVE type, added option to reverse the xaxis of MFI plot, plots in ggplot2, log scales * docs * plate name detection based on filepath * changed the default log scale into `all` --------- Co-authored-by: Fersoil <Fersoil> * Add tests and setup GHA (#18) * simple README with overview and installation (#7) * website for docs (#8) * add sample vignette and artificial dataset * pkgdown workflow --------- Co-authored-by: Fersoil <Fersoil> * Add .gitignore * Add sample files and adequate tests * Setup package workflow * Style code (GHA) * Export remaining objects * Move dots down * Add missing usage description * Disable lint error * Fix missing import ggplot2 --------- Co-authored-by: Tymoteusz Kwieciński <[email protected]> Co-authored-by: ZetrextJG <[email protected]> * Add dev to GHA for R check and test coverage (#19) * fixed sample type recognition; added standard curve to summary * updated example script with Covid OISE dataset * updated example script --------- Co-authored-by: Jakub Grzywaczewski <[email protected]> Co-authored-by: ZetrextJG <[email protected]> Co-authored-by: Fersoil <Fersoil>
mini-pw · Jul 16, 2024 · d076c36 · d076c36
1 parent 995102c
commit d076c36
Show file tree

Hide file tree

Showing 4 changed files with 71 additions and 95 deletions.
diff --git a/R/classes.R b/R/classes.R
@@ -408,10 +408,10 @@ SampleType$validate_dilution_factor <- function(sample_type, dilution_factor) {
 #' Parses the sample type based on the sample name and dilution factor
 #'
 #' It parses the names as follows:
-#' If `sample_name` or `sample_name_loc` equals to `BLANK`, `B` or starts with letter `B`, then SampleType equals to `BLANK`
-#' If `sample_name` or `sample_name_loc` equals to `STANDARD CURVE`, `SC`, `S` or equals to `1/\d+`, `S_1/d+`, `S 1\d+` or `S1\d+` then SampleType equals to `STANDARD CURVE`
-#' If `sample_name` or `sample_name_loc` equals to `NEGATIVE CONTROL`, `N`, or starts with `N` or `NEG`, then SampleType equals to `NEGATIVE CONTROL`
-#' If `sample_name` or `sample_name_loc` contains substring `1/\d+` SampleType equals to `POSITIVE CONTROL`
+#' If `sample_name` or `sample_name_loc` equals to `BLANK`, `BACKGROUND` or `B` , then SampleType equals to `BLANK`
+#' If `sample_name` or `sample_name_loc` equals to `STANDARD CURVE`, `SC`, `S` or contains substring `1/\d+` and has prefix ` `, `S_`, `S `, `S` or `CP3` then SampleType equals to `STANDARD CURVE`
+#' If `sample_name` or `sample_name_loc` equals to `NEGATIVE CONTROL`, `N`, or contains substring `NEG`, then SampleType equals to `NEGATIVE CONTROL`
+#' If `sample_name` or `sample_name_loc` starts with `P` following by whitespace, `POS` following by whitespace, `B770` or `10/190`   contains substring `1/\d+` SampleType equals to `POSITIVE CONTROL`
 #' otherwise, the returned SampleType is `TEST`
 #'
 #'
@@ -433,20 +433,41 @@ SampleType$parse_sample_type <- function(sample_name,
   }
 
   blank_types <- c("BLANK", "BACKGROUND", "B")
-  blank_pattern <- "^B..$"
 
   if (sample_name %in% blank_types ||
-    grepl(blank_pattern, sample_name) ||
-    grepl(blank_pattern, sample_name_loc)) {
+      sample_name_loc %in% blank_types) {
     return(SampleType$new("BLANK"))
   }
 
+  sample_type <- "TEST"
+
+  positive_control_pattern <- c("^(P.|POS.+|B770.+|10/198.+)(1/\\d+)$")
+  if (grepl(positive_control_pattern, sample_name) ||
+      grepl(positive_control_pattern, sample_name_loc)) {
+    sample_type <- "POSITIVE CONTROL"
+  }
+
+  negative_types <- c("NEGATIVE CONTROL", "N")
+  negative_pattern <-
+    "^(N..|.*\\bNEG\\b)" # check if it starts with N or contains NEG string
+
+  if (sample_name %in% negative_types ||
+      grepl(negative_pattern, sample_name) ||
+      grepl(negative_pattern, sample_name_loc)) {
+    sample_type <- "NEGATIVE CONTROL"
+  }
+
+
   standard_curve_types <- c("STANDARD CURVE", "SC", "S") # CP3 - tanzania, PRISM - uganda, Brefet - gambia, NIBSC 10/198
-  standard_curve_pattern <- "^(S_|S|S\\s|)(1/\\d+)$"
+  standard_curve_pattern <- "^(S_|S|S\\s|CP.+)(1/\\d+)$"
   standard_curve_loc_pattern <- "(1/\\d+)"
   if (sample_name %in% standard_curve_types ||
-    grepl(standard_curve_pattern, sample_name) ||
-    grepl(standard_curve_loc_pattern, sample_name_loc)) {
+      grepl(standard_curve_pattern, sample_name) ||
+      grepl(standard_curve_loc_pattern, sample_name_loc)) {
+    sample_type <- "STANDARD CURVE"
+  }
+
+  if (sample_type %in% c("STANDARD CURVE", "POSITIVE CONTROL", "NEGATIVE CONTROL")) {
     dilution_factor_pattern <- "1/\\d+"
     match <- ""
     if (!is.null(sample_name_loc) && sample_name_loc != "" || !is.na(sample_name_loc) && sample_name_loc != "") {
@@ -490,10 +511,9 @@ SampleType$parse_sample_type <- function(sample_name,
     if (is.null(dilution_factor)) {
       dilution_factor <- NA # this value needs to be updated later
     }
-    return(SampleType$new("POSITIVE CONTROL", dilution_factor = dilution_factor, validate_dilution = FALSE))
-  }
-
 
+    return(SampleType$new(sample_type, dilution_factor = dilution_factor, validate_dilution = FALSE))
+  }
 
   return(SampleType$new("TEST"))
 }
@@ -721,22 +741,32 @@ Plate <- R6Class(
     summary = function(..., include_names = FALSE) {
       positive_control_samples_list <- self$get_sample_by_type("POSITIVE CONTROL")
       negative_control_samples_list <- self$get_sample_by_type("NEGATIVE CONTROL")
+      standard_curve_samples_list <- self$get_sample_by_type("STANDARD CURVE")
 
       blank_samples_num <-
         length(self$get_sample_by_type("BLANK"))
       positive_control_num <- length(positive_control_samples_list)
       negative_control_num <- length(negative_control_samples_list)
-
+      standard_curve_num <- length(standard_curve_samples_list)
 
       positive_control_names <- ""
       negative_control_names <- ""
+      standard_curve_names <- ""
 
       if (include_names) {
-        positive_control_names <- paste(sapply(positive_control_samples_list, function(sample) paste0("'", sample$sample_name, "'")), collapse = ", ")
-        negative_control_names <- paste(sapply(negative_control_samples_list, function(sample) paste0("'", sample$sample_name, "'")), collapse = ", ")
+        if (positive_control_num > 0) {
+          positive_control_names <- paste(sapply(positive_control_samples_list, function(sample) paste0("'", sample$sample_name, "'")), collapse = ", ")
+          positive_control_names <- paste0("\nSample names: ", positive_control_names)
+        }
 
-        positive_control_names <- paste0("\nSample names: ", positive_control_names)
-        negative_control_names <- paste0("\nSample names: ", negative_control_names)
+        if (negative_control_num > 0) {
+          negative_control_names <- paste(sapply(negative_control_samples_list, function(sample) paste0("'", sample$sample_name, "'")), collapse = ", ")
+          negative_control_names <- paste0("\nSample names: ", negative_control_names)
+        }
+        if (standard_curve_num > 0) {
+          standard_curve_names <- paste(sapply(standard_curve_samples_list, function(sample) paste0("'", sample$sample_name, "'")), collapse = ", ")
+          standard_curve_names <- paste0("\nSample names: ", standard_curve_names)
+        }
       }
 
       cat(
@@ -748,6 +778,9 @@ Plate <- R6Class(
         "Number of blank samples: ",
         blank_samples_num,
         "\n",
+        "Number of standard curve samples: ",
+        standard_curve_num,
+        standard_curve_names, "\n",
         "Number of positive control samples: ",
         positive_control_num,
         positive_control_names, "\n",

diff --git a/R/read_data.R b/R/read_data.R
@@ -81,17 +81,17 @@ read_data <- function(file_path,
       "Running consistency checks...\n",
       verbose = verbose
     )
-    if (!results_plate$check_analyte_consistency()) {
-      verbose_cat(
-        "(",
-        color_codes$red_start,
-        "WARNING",
-        color_codes$red_end,
-        ")",
-        "\nInconsistent analytes in the plate - there are data of analytes undefined in the file\n",
-        verbose = verbose
-      )
-    }
+    # if (!results_plate$check_analyte_consistency()) {
+    #  verbose_cat(
+    #    "(",
+    #    color_codes$red_start,
+    #    "WARNING",
+    #    color_codes$red_end,
+    #    ")",
+    #    "\nInconsistent analytes in the plate - there are data of analytes undefined in the file\n",
+    #    verbose = verbose
+    #  )
+    #}
 
     if (!results_plate$check_beads_number()) {
       verbose_cat(
@@ -117,6 +117,7 @@ read_data <- function(file_path,
 read_layout_data <- function(layout_file_path,
                              results_plate,
                              check_plate = TRUE,
+                             replace_names = TRUE,
                              ...,
                              verbose = TRUE) {
   # function modifies the results_plate object by adding the location information from the layout file
@@ -138,6 +139,9 @@ read_layout_data <- function(layout_file_path,
     sample_name <- sample$sample_name
     sample$sample_type <-
       SampleType$parse_sample_type(sample_name, sample_name_loc = sample_name_loc)
+    if (replace_names) {
+      sample$sample_name <- sample_name_loc
+    }
   }
 
   return(results_plate)

diff --git a/inst/extdata/artificial_plate.csv b/inst/extdata/artificial_plate.csv
diff --git a/vignettes/example_script.Rmd b/vignettes/example_script.Rmd
@@ -36,15 +36,16 @@ After the plate is successfully loaded, we can look into some basic information
 ```{r}
 plate$summary()
 
+plate$summary(include_names = TRUE) # more detailed summary - names of the types
+
 plate$get_sample(1)
-plate$get_sample_by_type("POSITIVE CONTROL")[[1]]
+plate$get_sample_by_type("STANDARD CURVE")[[1]]
 
 plate$sample_names
 plate$analyte_names
 ```
 
 
-
 ## Warnings
 Our scripts are designed to catch potential errors in the data. If there are any warnings, they will be stored in the `warnings` field of the plate object. The warnings can be accessed by the `$warnings` field of the plate object or by the `$warnings` field of the sample object.
 
@@ -53,11 +54,11 @@ Our scripts are designed to catch potential errors in the data. If there are any
 
 plate$warnings
 
-plate$get_sample(1)$warnings
+plate$get_sample(5)$warnings
 
 plate$get(analyte = "AMA1", sample = 1)
 
-plate$get_sample_by_type("POSITIVE CONTROL")[[1]]$warnings
+plate$get_sample_by_type("STANDARD CURVE")[[1]]$warnings
 ```