diff --git a/DESCRIPTION b/DESCRIPTION index 1e56686..2e1c1c5 100644 --- a/DESCRIPTION +++ b/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", diff --git a/R/1_home.R b/R/1_home.R index 22b13a3..6c9e8e3 100644 --- a/R/1_home.R +++ b/R/1_home.R @@ -6,7 +6,7 @@ abci_footer <- tags$footer( HTML(paste0( "
", "", - "", + "", "

2024 R.E.W Hancock Lab. The Hancock Lab at ", "", "UBC Vancouver acknowledges we are located on the traditional, ", diff --git a/R/2_upload.R b/R/2_upload.R index ec3a64c..1cf009e 100644 --- a/R/2_upload.R +++ b/R/2_upload.R @@ -898,11 +898,11 @@ server_upload <- function(id) { class = "mb-0", content = tagList( HTML(r"( -

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 - (first replicate only). Make sure everything looks OK before - proceeding via the button at the bottom of the sidebar.

+

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 (first replicate only). Make + sure everything looks OK before proceeding via the button at the + bottom of the sidebar.

)"), selectInput( inputId = ns("upload_input_names_selector"), diff --git a/R/3_results.R b/R/3_results.R index 79710a0..bcff2d4 100644 --- a/R/3_results.R +++ b/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, diff --git a/README.md b/README.md index ed518fe..e32b7d5 100644 --- a/README.md +++ b/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 diff --git a/app.R b/app.R index 5c7fcd0..3234479 100644 --- a/app.R +++ b/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) { diff --git a/www/help/help.html b/www/help/help.html index 8db88b0..395c9cb 100644 --- a/www/help/help.html +++ b/www/help/help.html @@ -112,14 +112,14 @@

3. Create plots from your results

inputs' name to see an explanatory tooltip.

- At the bottom of the sidebar there are buttons to Download a results - spreadsheet for your ABCI results (as an XLSX file), or Download - the plot currently displayed plot as a PNG, SVG, or TIFF image file. + At the bottom of the sidebar there are buttons to "Download a results + spreadsheet" for your ABCI results (as an XLSX file), or "Download + the plot" currently displayed plot as a PNG, SVG, or TIFF image file.

- Additional buttons can be used to Restore defaults,resetting all - the plot inputs to their original state, or to Analyze a new data - set. Note that the latter option will cause all results and plots to + Additional buttons can be used to "Restore defaults",resetting all + the plot inputs to their original state, or to "Analyze a new data + set". 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!

diff --git a/www/img/hancock_lab_logo_32.svg b/www/img/hancock_lab_logo.svg similarity index 100% rename from www/img/hancock_lab_logo_32.svg rename to www/img/hancock_lab_logo.svg diff --git a/www/img/hancock_lab_logo_16.svg b/www/img/hancock_lab_logo_16.svg deleted file mode 100644 index bd7614e..0000000 --- a/www/img/hancock_lab_logo_16.svg +++ /dev/null @@ -1,174 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - image/svg+xml - - - - - - - - - - -