Merge pull request #30 from hancockinformatics/devel

Merge Devel 0.99.528

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ABCindex
 Title: A Shiny app to calculate ABCI for checkerboard assays
-Version: 0.99.520
+Version: 0.99.528
 Authors@R:
   person(given = "Travis",
          family = "Blimkie",

R/1_home.R

@@ -6,7 +6,7 @@ abci_footer <- tags$footer(
   HTML(paste0(
     "<div class='border-top pt-3 d-flex align-items-center justify-content-center'>",
     "<a target='_blank' rel='noopener noreferrer' href='http://cmdr.ubc.ca/bobh/'>",
-    "<img class='pe-1' src='img/hancock_lab_logo_32.svg'></a>",
+    "<img class='pe-1' src='img/hancock_lab_logo.svg'></a>",
     "<p class='mb-0'><small>2024 R.E.W Hancock Lab. The Hancock Lab at ",
     "<a target='_blank' rel='noopener noreferrer' href='https://www.ubc.ca/'>",
     "UBC Vancouver</a> acknowledges we are located on the traditional, ",

R/2_upload.R

@@ -898,11 +898,11 @@ server_upload <- function(id) {
         class = "mb-0",
         content = tagList(
           HTML(r"(
-            <p>Use the dropdown to choose an experiment to preview; the card to
-            the right displays information gathered from the selected
-            experiment, while the table below shows the corresponding data
-            (<b>first replicate only</b>). Make sure everything looks OK before
-            proceeding via the button at the bottom of the sidebar.</p>
+            <p>Use the dropdown to choose an experiment to preview. The card to
+            the right displays information for the selected experiment, while
+            the table below shows the data (<b>first replicate only</b>). Make
+            sure everything looks OK before proceeding via the button at the
+            bottom of the sidebar.</p>
           )"),
           selectInput(
             inputId = ns("upload_input_names_selector"),

R/3_results.R

@@ -241,6 +241,7 @@ plot_legends <- list(
 #' @param x.drug Character; Column name of concentrations of the first drug
 #' @param y.drug Character; Column name of concentrations of the second drug
 #' @param col.data Character; Column name which contains the measured value
+#' @param col.rep Character; Column name containing replicates
 #' @param threshold Numeric; cutoff for determining MIC. Defaults to 0.5.
 #' @param zero If `TRUE` (default), the index/position is returned as-is. When
 #'   `FALSE`, subtract one from the value, used when making plots without zero
@@ -257,6 +258,7 @@ find_mic <- function(
     x.drug,
     y.drug,
     col.data,
+    col.rep,
     threshold = 0.5,
     zero = TRUE
 ) {
@@ -271,39 +273,82 @@ find_mic <- function(
     "Column given by 'y.drug' must be a factor" = is.factor(data[[y.drug]])
   )
 
-  x_mic <- data %>%
-    filter(.data[[y.drug]] == "0") %>%
-    mutate(x.new = as.numeric(as.character(.data[[x.drug]]))) %>%
-    select(x.new, all_of(c(col.data))) %>%
-    arrange(desc(x.new)) %>%
-    tibble::deframe() %>%
-    purrr::head_while(~.x < threshold) %>%
-    names() %>%
-    last()
-
-  x_lab <- ifelse(
-    test = x_mic %in% levels(droplevels(data[[x.drug]])),
-    yes = which(levels(droplevels(data[[x.drug]])) == x_mic),
-    no = NA_integer_
-  )
+  n_reps <- length(unique(data[[col.rep]]))
+
+  data_split <- split(x = data, f = data[col.rep])
+
+  x_mic_per_rep <- lapply(data_split, function(r) {
+    filter(r, .data[[y.drug]] == "0") %>%
+      mutate(x.new = as.numeric(as.character(.data[[x.drug]]))) %>%
+      select(x.new, all_of(c(col.data))) %>%
+      arrange(desc(x.new)) %>%
+      tibble::deframe() %>%
+      purrr::head_while(~.x > threshold) %>%
+      names() %>%
+      last()
+  }) %>% as.character()
+
+  x_mic_unique <- unique(x_mic_per_rep)
+
+  x_mic <-
+    if (length(x_mic_unique) == 1) {
+      x_mic_unique
+    } else if (n_reps == 2) {
+      min(x_mic_unique)
+    } else if (length(x_mic_unique) >= 4) {
+      NA_character_
+    } else {
+      find_mode(x_mic_per_rep)
+    }
 
-  y_mic <- data %>%
-    filter(.data[[x.drug]] == "0") %>%
-    mutate(y.new = as.numeric(as.character(.data[[y.drug]]))) %>%
-    select(y.new, all_of(c(col.data))) %>%
-    arrange(desc(y.new)) %>%
-    tibble::deframe() %>%
-    purrr::head_while(~.x < threshold) %>%
-    names() %>%
-    last()
-
-  y_lab <- ifelse(
-    test = y_mic %in% levels(droplevels(data[[y.drug]])),
-    yes = which(levels(droplevels(data[[y.drug]])) == y_mic),
-    no = NA_integer_
-  )
+  x_mic_clean <-
+    if (is.na(x_mic)) {
+      as.character(max(as.numeric(levels(data[[x.drug]]))))
+    } else {
+      x_mic
+    }
+
+  x_lab <- which(levels(droplevels(data[[x.drug]])) == x_mic_clean)
+
+  y_mic_per_rep <- lapply(data_split, function(r) {
+    filter(r, .data[[x.drug]] == "0") %>%
+      mutate(y.new = as.numeric(as.character(.data[[y.drug]]))) %>%
+      select(y.new, all_of(c(col.data))) %>%
+      arrange(desc(y.new)) %>%
+      tibble::deframe() %>%
+      purrr::head_while(~.x > threshold) %>%
+      names() %>%
+      last()
+  }) %>% as.character()
+
+  y_mic_unique <- unique(y_mic_per_rep)
+
+  y_mic <-
+    if (length(y_mic_unique) == 1) {
+      y_mic_unique
+    } else if (n_reps == 2) {
+      min(y_mic_unique)
+    } else if (length(y_mic_unique) >= 4) {
+      NA_character_
+    } else {
+      find_mode(y_mic_per_rep)
+    }
+
+  y_mic_clean <-
+    if (is.na(y_mic)) {
+      as.character(max(as.numeric(levels(data[[y.drug]]))))
+    } else {
+      y_mic
+    }
 
-  mic_table <- tibble(XMIC = x_mic, YMIC = y_mic, XLAB = x_lab, YLAB = y_lab)
+  y_lab <- which(levels(droplevels(data[[y.drug]])) == y_mic_clean)
+
+  mic_table <- tibble(
+    XMIC = x_mic_clean,
+    YMIC = y_mic_clean,
+    XLAB = x_lab,
+    YLAB = y_lab
+  )
 
   if (!zero) {
     mic_table <- mic_table %>%
@@ -315,6 +360,26 @@ find_mic <- function(
 }
 
 
+#' find_mode
+#'
+#' @param x Vector of input values
+#' @param na.rm Should NA values be discarded? Defaults TRUE.
+#'
+#' @return The mode of input `x`
+#'
+find_mode <- function(x, na.rm = FALSE) {
+  # Using `sort()` and `table()` means it only returns a single mode when there
+  # are multiple, choosing the minimum; e.g. `find_mode(c(1, 1, 2, 2))` will
+  # return 1.
+  names(
+    sort(
+      table(x, useNA = ifelse(na.rm, "no", "ifany")),
+      decreasing = TRUE
+    )
+  )[1]
+}
+
+
 #' get_dims
 #'
 #' @param type Type of plot (dot, dot_split, tile, tile_split, line)
@@ -462,6 +527,7 @@ plot_dot <- function(
         x.drug = x.drug,
         y.drug = y.drug,
         col.data = col.mic,
+        col.rep = "replicate",
         threshold = mic.threshold,
         zero = TRUE
       )
@@ -476,6 +542,7 @@ plot_dot <- function(
           x.drug = x.drug,
           y.drug = y.drug,
           col.data = col.mic,
+          col.rep = "replicate",
           threshold = mic.threshold,
           zero = TRUE
         )
@@ -701,6 +768,7 @@ plot_dot_split <- function(
         x.drug = x.drug,
         y.drug = y.drug,
         col.data = col.mic,
+        col.rep = "replicate",
         threshold = mic.threshold,
         zero = TRUE
       )
@@ -715,6 +783,7 @@ plot_dot_split <- function(
           x.drug = x.drug,
           y.drug = y.drug,
           col.data = col.mic,
+          col.rep = "replicate",
           threshold = mic.threshold,
           zero = TRUE
         )
@@ -894,6 +963,7 @@ plot_dot_split <- function(
 #' @param plot.type Type of graph, either "replicates", "mean", or "mean_sd"
 #' @param jitter.x Logical; Should points have jitter along the x axis? Defaults
 #'   to TRUE.
+#' @param col.mic Character; Column name to use for calculating MIC
 #' @param x.mic.line Logical; should a line be drawn to indicate MIC of the
 #'   compound on the x-axis? Defaults to FALSE.
 #' @param mic.threshold Threshold for determining MIC; defaults to 0.5
@@ -921,6 +991,7 @@ plot_line <- function(
     line.include = "all",
     plot.type = "mean_sd",
     jitter.x = TRUE,
+    col.mic = NULL,
     x.mic.line = FALSE,
     mic.threshold = 0.5,
     colour.palette = "Accent",
@@ -995,7 +1066,8 @@ plot_line <- function(
         data = data,
         x.drug = x.drug,
         y.drug = line.drug,
-        col.data = col.data,
+        col.data = col.mic,
+        col.rep = "replicate",
         threshold = mic.threshold,
         zero = TRUE
       )
@@ -1009,7 +1081,8 @@ plot_line <- function(
           data = d,
           x.drug = x.drug,
           y.drug = line.drug,
-          col.data = col.data,
+          col.data = col.mic,
+          col.rep = col.rep,
           threshold = mic.threshold,
           zero = TRUE
         )
@@ -1211,6 +1284,7 @@ plot_tile <- function(
         x.drug = x.drug,
         y.drug = y.drug,
         col.data = col.mic,
+        col.rep = "replicate",
         threshold = mic.threshold,
         zero = FALSE
       )
@@ -1225,6 +1299,7 @@ plot_tile <- function(
           x.drug = x.drug,
           y.drug = y.drug,
           col.data = col.mic,
+          col.rep = "replicate",
           threshold = mic.threshold,
           zero = FALSE
         )
@@ -1377,6 +1452,7 @@ plot_tile_split <- function(
         x.drug = x.drug,
         y.drug = y.drug,
         col.data = col.mic,
+        col.rep = "replicate",
         threshold = mic.threshold,
         zero = FALSE
       )
@@ -1391,6 +1467,7 @@ plot_tile_split <- function(
           x.drug = x.drug,
           y.drug = y.drug,
           col.data = col.mic,
+          col.rep = "replicate",
           threshold = mic.threshold,
           zero = FALSE
         )
@@ -3095,7 +3172,7 @@ server_results <- function(id, data) {
               large.effect = input$plot_dot_large_toggle,
               large.effect.val = input$plot_dot_large_value,
               abci.val = input$plot_dot_large_abci,
-              col.mic = "bio_normal",
+              col.mic = "effect",
               colour.palette = input$plot_dot_colour_palette
             ) +
               {if (abci_plot_dims()[[2]] == 1) {
@@ -3127,7 +3204,7 @@ server_results <- function(id, data) {
               large.effect = input$plot_dot_split_large_toggle,
               large.effect.val = input$plot_dot_split_large_value,
               abci.val = input$plot_dot_split_large_abci,
-              col.mic = "bio_normal",
+              col.mic = "effect",
               colour.palette = input$plot_dot_split_colour_palette
             ) +
               {if (abci_plot_dims()[[2]] == 1) {
@@ -3151,7 +3228,7 @@ server_results <- function(id, data) {
               x.mic.line = ("X" %in% input$plot_tile_mic_lines),
               y.mic.line = ("Y" %in% input$plot_tile_mic_lines),
               mic.threshold = input$plot_tile_mic_threshold,
-              col.mic = "bio_normal",
+              col.mic = "effect",
               low.effect = input$plot_tile_low_toggle,
               low.effect.val = input$plot_tile_low_value,
               large.effect = input$plot_tile_large_toggle,
@@ -3178,7 +3255,7 @@ server_results <- function(id, data) {
               x.mic.line = ("X" %in% input$plot_tile_split_mic_lines),
               y.mic.line = ("Y" %in% input$plot_tile_split_mic_lines),
               mic.threshold = input$plot_tile_split_mic_threshold,
-              col.mic = "bio_normal",
+              col.mic = "effect",
               low.effect = input$plot_tile_split_low_toggle,
               low.effect.val = input$plot_tile_split_low_value,
               large.effect = input$plot_tile_split_large_toggle,
@@ -3205,6 +3282,7 @@ server_results <- function(id, data) {
               x.text = input$plot_line_x_text,
               y.text = input$plot_line_y_text,
               line.text = input$plot_line_line_text,
+              col.mic = "effect",
               x.mic.line = ("X" %in% input$plot_line_mic_lines),
               mic.threshold = input$plot_line_mic_threshold,
               jitter.x = input$plot_line_jitter_x,

README.md

@@ -16,14 +16,15 @@ challenges when evaluating antibiofilm activity.
 
 ## Availability
 
-It is currently available at: 
+ABCindex is under active development, and is currently available at: 
 https://travis-m-blimkie.shinyapps.io/ABCindex/
 
 
 ## Contributors
 
-ABCindex was developed by Travis Blimkie and Lucas Pedraz at the Hancock Lab. A 
-big thanks to all the testers, including Evan Haney and Noushin Akhoundsadegh.
+ABCindex was developed by Travis Blimkie and Lucas Pedraz at the 
+[CMDR Hancock Lab](http://cmdr.ubc.ca/bobh/). A big thanks to all the testers, 
+especially Noushin Akhoundsadegh and Evan Haney.
 
 
 ## Dependencies

app.R

@@ -42,7 +42,7 @@ abci_ui <- page_navbar(
   header = tags$head(
     useShinyjs(),
     tags$link(rel = "stylesheet", href = "css/custom.css"),
-    tags$link(rel = "icon", href = "img/hancock_lab_logo_32.svg"),
+    tags$link(rel = "icon", href = "img/ABCindex_icon.svg"),
     tags$script(HTML(r"(
       window.onbeforeunload = () => {
         if (document.getElementById('shiny-disconnected-overlay') === null) {

www/help/help.html

@@ -112,14 +112,14 @@ <h3 class="mt-4">3. Create plots from your results</h3>
       inputs' name to see an explanatory tooltip.
     </p>
     <p>
-      At the bottom of the sidebar there are buttons to <b>Download a results
-      spreadsheet</b> for your ABCI results (as an XLSX file), or <b>Download
-      the plot</b> currently displayed plot as a PNG, SVG, or TIFF image file.
+      At the bottom of the sidebar there are buttons to <b>"Download a results
+      spreadsheet"</b> for your ABCI results (as an XLSX file), or <b>"Download
+      the plot"</b> currently displayed plot as a PNG, SVG, or TIFF image file.
     </p>
     <p>
-      Additional buttons can be used to <b>Restore defaults</b>,resetting all
-      the  plot inputs to their original state, or to <b>Analyze a new data
-      set</b>. Note that the latter option will cause all results and plots to
+      Additional buttons can be used to <b>"Restore defaults"</b>,resetting all
+      the  plot inputs to their original state, or to <b>"Analyze a new data
+      set"</b>. Note that the latter option will cause all results and plots to
       be lost, so be sure to save anything you want to keep first!
     </p>