From b74d80f67e07c6df8711c3dc6876fefce722c5e6 Mon Sep 17 00:00:00 2001 From: Kate Isaac <41767733+kweav@users.noreply.github.com> Date: Thu, 13 Jun 2024 15:53:54 -0400 Subject: [PATCH 01/10] add args for filter target cols and implement for one --- R/01-qc.R | 8 ++++++- R/02-filter.R | 32 +++++++++++++++++++++++----- R/plots-qc.R | 41 ++++++++++++++++++++++++++++++------ inst/rmd/gimapQCTemplate.Rmd | 3 +++ 4 files changed, 72 insertions(+), 12 deletions(-) diff --git a/R/01-qc.R b/R/01-qc.R index 9fb6ca8..d2b538c 100644 --- a/R/01-qc.R +++ b/R/01-qc.R @@ -19,6 +19,9 @@ run_qc <- function(gimap_dataset, output_file = "./gimap_QC_Report.Rmd", plots_dir = "./qc_plots", overwrite = FALSE, + filter_zerocount_target_col = NULL, + filter_plasmid_target_col = NULL, + filter_replicates_target_col = NULL, ...) { if (!("gimap_dataset" %in% class(gimap_dataset))) stop("This function only works with gimap_dataset objects which can be made with the setup_data() function.") @@ -56,7 +59,10 @@ run_qc <- function(gimap_dataset, rmarkdown::render(output_file, params = list( dataset = gimap_dataset, - plots_dir = plots_dir + plots_dir = plots_dir, + filter_zerocount_target_col = filter_zerocount_target_col, + filter_plasmid_target_col = filter_zerocount_target_col, + filter_replicates_target_col = filter_zerocount_target_col, ), ... ) diff --git a/R/02-filter.R b/R/02-filter.R index b16a0e9..7378022 100644 --- a/R/02-filter.R +++ b/R/02-filter.R @@ -44,6 +44,7 @@ gimap_filter <- function(.data = NULL, #' @importFrom dplyr mutate #' @return a named list with the filter `filter` specifying which pgRNA have a count zero for at least one sample/time point and a report df `reportdf` for the number and percent of pgRNA which have a count zero for at least one sample/time point #' @examples \dontrun{ +#' gimap_dataset <- get_example_data("gimap") #' qc_filter_zerocounts(gimap_dataset) #' } #' @@ -61,29 +62,50 @@ qc_filter_zerocounts <- function(gimap_dataset){ } #' Create a filter for pgRNAs which have a low log2 CPM value for the plasmid/Day 0 sample/time point -#' @description This function flags and reports which and how many pgRNAs have low log2 CPM values for the plasmid/Day 0 sample/time point +#' @description This function flags and reports which and how many pgRNAs have low log2 CPM values for the plasmid/Day 0 sample/time point. If more than one column is specified as the plasmid sample, +#' we take the average of those columns and apply the filter by comparing the cutoff to the average value #' @param gimap_dataset The special gimap_dataset from the `setup_data` function which contains the log2 CPM transformed data +#' @param filter_plasmid_target_col default is NULL, and if NULL, will select the first column only; this parameter specifically should be used to specify the plasmid column(s) that will be selected #' @importFrom magrittr %>% #' @importFrom dplyr mutate #' @return a named list with the filter `plasmid_filter` specifying which pgRNAs have low plasmid log2 CPM and a report df `plasmid_filter_report` for the number and percent of pgRNA which have a low plasmid log2 CPM #' @examples \dontrun{ +#' gimap_dataset <- get_example_data("gimap") +#' #' qc_filter_plasmid(gimap_dataset) #' +#' #or to specify a cutoff value to be used in the filter rather than the lower outlier default #' qc_filter_plasmid(gimap_dataset, cutoff=2) +#' +#' #or to specify a different column (or set of columns to select) +#' qc_filter_plasmid(gimap_dataset, filter_plasmid_target_col = c(1,2)) +#' +#' # or to specify a cutoff value that will be used in the filter rather than the lower outlier default as well as to specify a different column (or set of columns) to select +#' qc_filter_plasmid(gimap_dataset, cutoff=1.75, filter_plasmid_target_col=c(1,2)) +#' #' } #' -qc_filter_plasmid <- function(gimap_dataset, cutoff = NULL){ - plasmid_data <- data.frame(gimap_dataset$transformed_data$log2_cpm[, 1]) %>% `colnames<-`(c("log2_cpm")) +qc_filter_plasmid <- function(gimap_dataset, cutoff = NULL, filter_plasmid_target_col){ + + if (is.null(filter_plasmid_target_col)) {filter_plasmid_target_col <- c(1)} + + plasmid_data <- data.frame(gimap_dataset$transformed_data$log2_cpm[, filter_plasmid_target_col]) %>% `colnames<-`(rep(c("plasmid_log2_cpm"), length(filter_plasmid_target_col))) %>% clean_names() + + if (length(filter_plasmid_target_col >1)){ #if more than one column was selected, average the values so the filter will be done on the average + plasmid_data <- plasmid_data %>% + mutate(meanVal = rowMeans(.)) %>% + select(meanVal) %>% `colnames<-`(c("plasmid_log2_cpm")) + } if (is.null(cutoff)) { # if cutoff is null, use lower outlier - quantile_info <- quantile(plasmid_data$log2_cpm) + quantile_info <- quantile(plasmid_data$plasmid_log2_cpm) cutoff <- quantile_info["25%"] - (1.5 * (quantile_info["75%"] - quantile_info["25%"])) #later step make a function for this in utils since it's used more than once } - plasmid_cpm_filter <- unlist(lapply(1:nrow(plasmid_data), function(x) plasmid_data$log2_cpm[x] < cutoff)) + plasmid_cpm_filter <- plasmid_data$plasmid_log2_cpm < cutoff plasmid_filter_df <- data.frame("Plasmid_log2cpmBelowCutoff" = c(FALSE, TRUE), n = c(sum(!plasmid_cpm_filter), sum(plasmid_cpm_filter))) %>% mutate(percent = round(((n / sum(n)) * 100), 2)) #later step make a function for this in utils since it's used more than once diff --git a/R/plots-qc.R b/R/plots-qc.R index 9eaec8d..3353bdc 100644 --- a/R/plots-qc.R +++ b/R/plots-qc.R @@ -7,6 +7,9 @@ #' @importFrom ggplot2 ggplot labs #' @return counts_cdf a ggplot #' @examples \dontrun{ +#' +#' gimap_dataset <- get_example_data("gimap") +#' qc_cdf(gimap_dataset) #' #' } #' @@ -40,7 +43,8 @@ qc_cdf <- function(gimap_dataset, wide_ar = 0.75) { #' @import ggplot2 #' @return sample_cpm_histogram a ggplot #' @examples \dontrun{ -#' +#' gimap_dataset <- get_example_data("gimap") +#' qc_sample_hist(gimap_dataset) #' } #' qc_sample_hist <- function(gimap_dataset, wide_ar = 0.75) { @@ -146,7 +150,8 @@ qc_constructs_countzero_bar <- function(gimap_dataset, wide_ar = 0.75){ #' @importFrom pheatmap pheatmap #' @return `sample_cor_heatmap` a pheatmap #' @examples \dontrun{ -#' +#' gimap_dataset <- get_example_data("gimap") +#' qc_cor_heatmap(gimap_dataset) #' } #' qc_cor_heatmap <- function(gimap_dataset) { @@ -173,21 +178,45 @@ qc_cor_heatmap <- function(gimap_dataset) { #' method to tell, especially if there are reps? #' @param gimap_dataset The special gimap_dataset from the `setup_data` function which contains the transformed data #' @param cutoff default is NULL, the cutoff for low log2 CPM values for the plasmid time period; if not specified, The lower outlier (defined by taking the difference of the lower quartile and 1.5 * interquartile range) is used +#' @param filter_plasmid_target_col default is NULL, and if NULL, will select the first column only; this parameter specifically should be used to specify the plasmid column(s) that will be selected #' @param wide_ar aspect ratio, default is 0.75 #' @importFrom magrittr %>% #' @import ggplot2 #' @return a ggplot histogram +#' @examples \dontrun{ +#' +#' gimap_dataset <- get_example_data("gimap") +#' +#' qc_plasmid_histogram(gimap_dataset) +#' +#' # or to specify a "cutoff" value that will be displayed as a dashed vertical line +#' qc_plasmid_histogram(gimap_dataset, cutoff=1.75) +#' +#' # or to specify a different column (or set of columns) to select +#' qc_plasmid_histogram(gimap_dataset, filter_plasmid_target_col=c(1,2)) +#' +#' # or to specify a "cutoff" value that will be displayed as a dashed vertical line as well as to specify a different column (or set of columns) to select +#' qc_plasmid_histogram(gimap_dataset, cutoff=2, filter_plasmid_target_col=c(1,2)) +#' } +#' -qc_plasmid_histogram <- function(gimap_dataset, cutoff = NULL, wide_ar = 0.75) { - to_plot <- data.frame(gimap_dataset$transformed_data$log2_cpm[, 1]) %>% `colnames<-`(c("log2_cpm")) +qc_plasmid_histogram <- function(gimap_dataset, cutoff = NULL, filter_plasmid_target_col = NULL, wide_ar = 0.75) { + + if (is.null(filter_plasmid_target_col)) {filter_plasmid_target_col <- c(1)} + + to_plot <- data.frame(gimap_dataset$transformed_data$log2_cpm[, filter_plasmid_target_col]) %>% `colnames<-`(rep(c("plasmid_log2_cpm"), length(filter_plasmid_target_col))) %>% clean_names() + + if (length(filter_plasmid_target_col >1)){ #if more than one column was selected, collapse all of the columns into the same vector and store in a df to plot + to_plot <- data.frame(unlist(to_plot %>% select(starts_with("plasmid_log2_cpm")), use.names = FALSE)) %>% `colnames<-`(c("plasmid_log2_cpm")) + } - quantile_info <- quantile(to_plot$log2_cpm) + quantile_info <- quantile(to_plot$plasmid_log2_cpm) if (is.null(cutoff)) { cutoff <- quantile_info["25%"] - (1.5 * (quantile_info["75%"] - quantile_info["25%"]))} # if cutoff is null, suggest a cutoff and plot with suggested return( - ggplot(to_plot, aes(x = log2_cpm)) + + ggplot(to_plot, aes(x = plasmid_log2_cpm)) + geom_histogram(binwidth = 0.2, color = "black", fill = "gray60") + plot_options() + plot_theme() + diff --git a/inst/rmd/gimapQCTemplate.Rmd b/inst/rmd/gimapQCTemplate.Rmd index 1376dda..1bb8ae7 100644 --- a/inst/rmd/gimapQCTemplate.Rmd +++ b/inst/rmd/gimapQCTemplate.Rmd @@ -5,6 +5,9 @@ author: "`r paste0('gimap (v', utils::packageVersion('gimap'), ')')`" params: dataset: NULL plots_dir: ./plots + filter_zerocount_target_col: NULL + filter_plasmid_target_col: NULL + filter_replicates_target_col: NULL output: html_document: theme: spacelab From 7b2f649666ca8a9ab03ea54441b1776f0593b946 Mon Sep 17 00:00:00 2001 From: Kate Isaac <41767733+kweav@users.noreply.github.com> Date: Thu, 13 Jun 2024 15:59:56 -0400 Subject: [PATCH 02/10] update headers a bit more --- R/01-qc.R | 3 +++ R/02-filter.R | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/01-qc.R b/R/01-qc.R index d2b538c..58ddfa3 100644 --- a/R/01-qc.R +++ b/R/01-qc.R @@ -4,6 +4,9 @@ #' @param plots_dir default is `./qc_plots`; directory to save plots created with this function, if it doesn't exist already it will be created #' @param overwrite default is FALSE; whether to overwrite the QC Report file #' @param output_file default is `QC_Report`; name of the output QC report file +#' @param filter_zerocount_target_col default is NULL; Which sample column(s) should be used to check for counts of 0? If NULL and not specified, downstream analysis will select all sample columns +#' @param filter_plasmid_target_col default is NULL; Which sample columns(s) should be used to look at log2 CPM expression for plasmid pgRNA constructs? If NULL and not specified, downstream analysis will select the first sample column only +#' @param filter_replicates_target_col default is NULL; Which sample columns are replicates whose variation you'd like to analyze; If NULL, the last 3 sample columns are used #' @param ... additional parameters are sent to `rmarkdown::render()` #' @returns a QC report saved locally #' @export diff --git a/R/02-filter.R b/R/02-filter.R index 7378022..0aef9e1 100644 --- a/R/02-filter.R +++ b/R/02-filter.R @@ -86,7 +86,7 @@ qc_filter_zerocounts <- function(gimap_dataset){ #' } #' -qc_filter_plasmid <- function(gimap_dataset, cutoff = NULL, filter_plasmid_target_col){ +qc_filter_plasmid <- function(gimap_dataset, cutoff = NULL, filter_plasmid_target_col = NULL){ if (is.null(filter_plasmid_target_col)) {filter_plasmid_target_col <- c(1)} From 283c72df8b66ad70eba1393239c1dc1dea7c689f Mon Sep 17 00:00:00 2001 From: Kate Isaac <41767733+kweav@users.noreply.github.com> Date: Mon, 24 Jun 2024 15:49:41 -0400 Subject: [PATCH 03/10] some updates --- R/02-filter.R | 1 + R/plots-qc.R | 1 + 2 files changed, 2 insertions(+) diff --git a/R/02-filter.R b/R/02-filter.R index 0aef9e1..f04ed5c 100644 --- a/R/02-filter.R +++ b/R/02-filter.R @@ -68,6 +68,7 @@ qc_filter_zerocounts <- function(gimap_dataset){ #' @param filter_plasmid_target_col default is NULL, and if NULL, will select the first column only; this parameter specifically should be used to specify the plasmid column(s) that will be selected #' @importFrom magrittr %>% #' @importFrom dplyr mutate +#' @importFrom janitor clean_names #' @return a named list with the filter `plasmid_filter` specifying which pgRNAs have low plasmid log2 CPM and a report df `plasmid_filter_report` for the number and percent of pgRNA which have a low plasmid log2 CPM #' @examples \dontrun{ #' gimap_dataset <- get_example_data("gimap") diff --git a/R/plots-qc.R b/R/plots-qc.R index 3353bdc..55ce9a8 100644 --- a/R/plots-qc.R +++ b/R/plots-qc.R @@ -181,6 +181,7 @@ qc_cor_heatmap <- function(gimap_dataset) { #' @param filter_plasmid_target_col default is NULL, and if NULL, will select the first column only; this parameter specifically should be used to specify the plasmid column(s) that will be selected #' @param wide_ar aspect ratio, default is 0.75 #' @importFrom magrittr %>% +#' @importFrom janitor clean_names #' @import ggplot2 #' @return a ggplot histogram #' @examples \dontrun{ From fa4bf8df727e0f2d2bb9c47302a9a3ed1c117191 Mon Sep 17 00:00:00 2001 From: Kate Isaac <41767733+kweav@users.noreply.github.com> Date: Mon, 24 Jun 2024 16:58:07 -0400 Subject: [PATCH 04/10] finish edits to pool not avg --- R/02-filter.R | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/R/02-filter.R b/R/02-filter.R index f04ed5c..4047583 100644 --- a/R/02-filter.R +++ b/R/02-filter.R @@ -63,13 +63,13 @@ qc_filter_zerocounts <- function(gimap_dataset){ #' Create a filter for pgRNAs which have a low log2 CPM value for the plasmid/Day 0 sample/time point #' @description This function flags and reports which and how many pgRNAs have low log2 CPM values for the plasmid/Day 0 sample/time point. If more than one column is specified as the plasmid sample, -#' we take the average of those columns and apply the filter by comparing the cutoff to the average value +#' we pool all the replicate samples to find the lower outlier and flag constructs for which any plasmid replicate has a log2 CPM value below the cutoff #' @param gimap_dataset The special gimap_dataset from the `setup_data` function which contains the log2 CPM transformed data #' @param filter_plasmid_target_col default is NULL, and if NULL, will select the first column only; this parameter specifically should be used to specify the plasmid column(s) that will be selected #' @importFrom magrittr %>% #' @importFrom dplyr mutate #' @importFrom janitor clean_names -#' @return a named list with the filter `plasmid_filter` specifying which pgRNAs have low plasmid log2 CPM and a report df `plasmid_filter_report` for the number and percent of pgRNA which have a low plasmid log2 CPM +#' @return a named list with the filter `plasmid_filter` specifying which pgRNAs have low plasmid log2 CPM (column of interest is `plasmid_cpm_filter`) and a report df `plasmid_filter_report` for the number and percent of pgRNA which have a low plasmid log2 CPM #' @examples \dontrun{ #' gimap_dataset <- get_example_data("gimap") #' @@ -93,10 +93,11 @@ qc_filter_plasmid <- function(gimap_dataset, cutoff = NULL, filter_plasmid_targe plasmid_data <- data.frame(gimap_dataset$transformed_data$log2_cpm[, filter_plasmid_target_col]) %>% `colnames<-`(rep(c("plasmid_log2_cpm"), length(filter_plasmid_target_col))) %>% clean_names() - if (length(filter_plasmid_target_col >1)){ #if more than one column was selected, average the values so the filter will be done on the average - plasmid_data <- plasmid_data %>% - mutate(meanVal = rowMeans(.)) %>% - select(meanVal) %>% `colnames<-`(c("plasmid_log2_cpm")) + if (length(filter_plasmid_target_col >1)){ #if more than one column was selected, collapse all of the columns into the same vector using pivot_longer to store in a df with the name of the rep and number for row/construct + plasmid_data <- plasmid_data %>% mutate(construct = rownames(plasmid_data)) %>% + pivot_longer(starts_with("plasmid_log2_cpm"), + values_to = "plasmid_log2_cpm", + names_to = "rep") } if (is.null(cutoff)) { @@ -106,8 +107,23 @@ qc_filter_plasmid <- function(gimap_dataset, cutoff = NULL, filter_plasmid_targe cutoff <- quantile_info["25%"] - (1.5 * (quantile_info["75%"] - quantile_info["25%"])) #later step make a function for this in utils since it's used more than once } - plasmid_cpm_filter <- plasmid_data$plasmid_log2_cpm < cutoff + if (length(filter_plasmid_target_col >1)){ #if more than one column was selected, take collapsed/pooled data and compare it to the cutoff + #then pivot_wider so that the constructs are in the same row and we can use if_any to report if any of the replicates were flagged by the cutoff + #return just that summary column (reporting if any are TRUE) as the filter + plasmid_data <- plasmid_data %>% + mutate(filterFlag = plasmid_log2_cpm < cutoff) %>% + pivot_wider(id_cols = construct, names_from = rep, values_from = filterFlag) + plasmid_cpm_filter <- plasmid_data %>% + mutate(plasmid_cpm_filter= if_any(.cols = starts_with('plasmid_log2_cpm'))) %>% + select(plasmid_cpm_filter) + + } else { + + plasmid_cpm_filter <- as.data.frame(plasmid_data$plasmid_log2_cpm < cutoff) %>%`colnames<-`("plasmid_cpm_filter") + } + + plasmid_filter_df <- data.frame("Plasmid_log2cpmBelowCutoff" = c(FALSE, TRUE), n = c(sum(!plasmid_cpm_filter), sum(plasmid_cpm_filter))) %>% mutate(percent = round(((n / sum(n)) * 100), 2)) #later step make a function for this in utils since it's used more than once From 668907bbcca3c053d46a7020a76c3c7835603637 Mon Sep 17 00:00:00 2001 From: Kate Isaac <41767733+kweav@users.noreply.github.com> Date: Mon, 24 Jun 2024 17:06:54 -0400 Subject: [PATCH 05/10] ran document and load_all because of package imports --- DESCRIPTION | 2 +- NAMESPACE | 6 ++++++ R/02-filter.R | 3 ++- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0e00fe7..65ae402 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,6 +30,6 @@ Suggests: roxygen2, Config/testthat/edition: 3 Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 LazyData: true VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 7ff14c7..2ff9bfc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,8 +10,14 @@ export(run_qc) export(setup_data) import(ggplot2) import(kableExtra) +importFrom(dplyr,across) +importFrom(dplyr,if_any) +importFrom(dplyr,mutate) importFrom(ggplot2,ggplot) importFrom(ggplot2,labs) +importFrom(janitor,clean_names) importFrom(magrittr,"%>%") importFrom(pheatmap,pheatmap) importFrom(tidyr,pivot_longer) +importFrom(tidyr,pivot_wider) +importFrom(tidyr,unite) diff --git a/R/02-filter.R b/R/02-filter.R index 4047583..f3c59ec 100644 --- a/R/02-filter.R +++ b/R/02-filter.R @@ -67,7 +67,8 @@ qc_filter_zerocounts <- function(gimap_dataset){ #' @param gimap_dataset The special gimap_dataset from the `setup_data` function which contains the log2 CPM transformed data #' @param filter_plasmid_target_col default is NULL, and if NULL, will select the first column only; this parameter specifically should be used to specify the plasmid column(s) that will be selected #' @importFrom magrittr %>% -#' @importFrom dplyr mutate +#' @importFrom dplyr mutate across if_any +#' @importFrom tidyr pivot_wider pivot_longer #' @importFrom janitor clean_names #' @return a named list with the filter `plasmid_filter` specifying which pgRNAs have low plasmid log2 CPM (column of interest is `plasmid_cpm_filter`) and a report df `plasmid_filter_report` for the number and percent of pgRNA which have a low plasmid log2 CPM #' @examples \dontrun{ From f01383973213e2a72fd117636c91f75a36a40cdc Mon Sep 17 00:00:00 2001 From: Kate Isaac <41767733+kweav@users.noreply.github.com> Date: Tue, 25 Jun 2024 15:27:09 -0400 Subject: [PATCH 06/10] add arguments to QC Report --- inst/rmd/gimapQCTemplate.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/rmd/gimapQCTemplate.Rmd b/inst/rmd/gimapQCTemplate.Rmd index 1bb8ae7..b0f9639 100644 --- a/inst/rmd/gimapQCTemplate.Rmd +++ b/inst/rmd/gimapQCTemplate.Rmd @@ -65,7 +65,7 @@ qc_variance_hist(gimap_dataset) ## Plasmid expression (log 2 cpm values for Day 0 sample/time point) ```{r} -qc_plasmid_histogram(gimap_dataset) +qc_plasmid_histogram(gimap_dataset, filter_plasmid_target_col = filter_plasmid_target_col) ``` # Applying potential filters @@ -89,7 +89,7 @@ qc_filter_zerocounts(gimap_dataset)$reportdf If this filter is applied, this is the number of pgRNAs that would be filtered out ```{r} -qc_filter_plasmid(gimap_dataset)$plasmid_filter_report +qc_filter_plasmid(gimap_dataset, filter_plasmid_target_col = filter_plasmid_target_col)$plasmid_filter_report ``` # Session Info From e3a22d3fd8485f47b27231964b3f6b6412ec6be2 Mon Sep 17 00:00:00 2001 From: Candace Savonen Date: Fri, 28 Jun 2024 08:34:37 -0400 Subject: [PATCH 07/10] Adding janitor to Imports: in DESCRIPTION --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index b28b5ba..ce36b7c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,6 +32,7 @@ Imports: kableExtra, pheatmap, purrr, + Janitor, Suggests: testthat (>= 3.0.0), roxygen2, From c2085eb309a5b1617a4242dfc701abc9f2c491f0 Mon Sep 17 00:00:00 2001 From: Candace Savonen Date: Fri, 28 Jun 2024 08:37:32 -0400 Subject: [PATCH 08/10] My stupid autocorrect capitalized Janitor without me knowing :/ --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index ce36b7c..80f38d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,7 +32,7 @@ Imports: kableExtra, pheatmap, purrr, - Janitor, + janitor, Suggests: testthat (>= 3.0.0), roxygen2, From 03f571614ccabb9ac3806abfa9f414bf83c58cd3 Mon Sep 17 00:00:00 2001 From: Candace Savonen Date: Fri, 28 Jun 2024 08:46:31 -0400 Subject: [PATCH 09/10] Delete stray comma --- R/01-qc.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/01-qc.R b/R/01-qc.R index 58ddfa3..d7cc758 100644 --- a/R/01-qc.R +++ b/R/01-qc.R @@ -65,7 +65,7 @@ run_qc <- function(gimap_dataset, plots_dir = plots_dir, filter_zerocount_target_col = filter_zerocount_target_col, filter_plasmid_target_col = filter_zerocount_target_col, - filter_replicates_target_col = filter_zerocount_target_col, + filter_replicates_target_col = filter_zerocount_target_col ), ... ) From 076c3ac76c16d0e3b10d1148b3cb2bdea71fe148 Mon Sep 17 00:00:00 2001 From: Kate Isaac <41767733+kweav@users.noreply.github.com> Date: Fri, 28 Jun 2024 09:21:47 -0400 Subject: [PATCH 10/10] Update R/02-filter.R Co-authored-by: Candace Savonen --- R/02-filter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/02-filter.R b/R/02-filter.R index 7081339..c8461e5 100644 --- a/R/02-filter.R +++ b/R/02-filter.R @@ -80,7 +80,7 @@ qc_filter_zerocounts <- function(gimap_dataset){ #' qc_filter_plasmid(gimap_dataset, cutoff=2) #' #' #or to specify a different column (or set of columns to select) -#' qc_filter_plasmid(gimap_dataset, filter_plasmid_target_col = c(1,2)) +#' qc_filter_plasmid(gimap_dataset, filter_plasmid_target_col = 1:2) #' #' # or to specify a cutoff value that will be used in the filter rather than the lower outlier default as well as to specify a different column (or set of columns) to select #' qc_filter_plasmid(gimap_dataset, cutoff=1.75, filter_plasmid_target_col=c(1,2))