From 86f7524879fe1eedad46b5aa46e4f15b509685e2 Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 10:51:31 +0100 Subject: [PATCH 01/13] Run rworkflows on all branches except gh-pages --- .github/workflows/rworkflows.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/rworkflows.yml b/.github/workflows/rworkflows.yml index e845542..323fb1f 100644 --- a/.github/workflows/rworkflows.yml +++ b/.github/workflows/rworkflows.yml @@ -6,12 +6,16 @@ name: rworkflows - main - devel - RELEASE_** + - '*' + - '!gh-pages' pull_request: branches: - master - main - devel - RELEASE_** + - '*' + - '!gh-pages' jobs: rworkflows: permissions: write-all From 647711b75d93680b30443da32ced046ad9ce3076 Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 11:00:22 +0100 Subject: [PATCH 02/13] Replace `magrittr` import by `dplyr::%>%` --- R/utils_pipe.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/utils_pipe.R b/R/utils_pipe.R index 4bb07bf..d6d4fbb 100644 --- a/R/utils_pipe.R +++ b/R/utils_pipe.R @@ -2,13 +2,14 @@ #' #' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. #' -#' Generated by \code{\link[usethis]{use_pipe}}. +#' Generated by \code{\link[usethis]{use_pipe}}. Modified to import from +#' \code{dplyr} instead of \code{magrittr}. #' #' @name %>% #' @rdname pipe #' @keywords internal #' @export -#' @importFrom magrittr %>% +#' @importFrom dplyr %>% #' @usage lhs \%>\% rhs #' @param lhs A value or the magrittr placeholder. #' @param rhs A function call using the magrittr semantics. @@ -17,4 +18,6 @@ #' seq_len(10) %>% sum #' #' @return The result of calling `rhs(lhs)`. +#' +#' @keywords internal NULL From e37f4a78c71338ae822da55b29e9c1c4d30ee17e Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 11:27:10 +0100 Subject: [PATCH 03/13] Internalise some functions and move utility functions to utilities.R --- DESCRIPTION | 3 +- NAMESPACE | 13 +- NEWS.md | 9 ++ R/bpapply.R | 2 +- R/check_ENCODE.R | 2 +- R/check_dep.R | 25 ---- R/check_duplicates.R | 16 --- R/confirm_meme_install.R | 24 ---- R/format_exptype.R | 44 ------ R/get_df_enrichment.R | 2 +- R/messager.R | 29 ---- R/plot_enrichment_individual.R | 2 +- R/pretty_number.R | 27 ---- R/report_command.R | 3 +- R/report_header.R | 2 +- R/segregate_seqs.R | 2 +- R/to_plotly.R | 2 +- R/trim_seqs.R | 2 +- R/use_cache.R | 22 --- R/utilities.R | 217 ++++++++++++++++++++++++++++++ R/utils_pipe.R | 23 ---- README.md | 28 ++-- inst/markdown/MotifPeeker.Rmd | 42 +++--- man/bpapply.Rd | 1 + man/check_ENCODE.Rd | 1 + man/check_dep.Rd | 2 +- man/check_duplicates.Rd | 2 +- man/confirm_meme_install.Rd | 2 +- man/format_exptype.Rd | 3 +- man/get_df_enrichment.Rd | 1 + man/messager.Rd | 2 +- man/pipe.Rd | 5 +- man/plot_enrichment_individual.Rd | 1 + man/pretty_number.Rd | 3 +- man/report_command.Rd | 2 +- man/report_header.Rd | 1 + man/segregate_seqs.Rd | 1 + man/to_plotly.Rd | 1 + man/trim_seqs.Rd | 1 + man/use_cache.Rd | 2 +- 40 files changed, 293 insertions(+), 279 deletions(-) delete mode 100644 R/check_dep.R delete mode 100644 R/check_duplicates.R delete mode 100644 R/confirm_meme_install.R delete mode 100644 R/format_exptype.R delete mode 100644 R/messager.R delete mode 100644 R/pretty_number.R delete mode 100644 R/use_cache.R create mode 100644 R/utilities.R delete mode 100644 R/utils_pipe.R diff --git a/DESCRIPTION b/DESCRIPTION index d769cf3..885b1b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: MotifPeeker Title: Benchmarking Epigenomic Profiling Methods Using Motif Enrichment -Version: 0.99.4 +Version: 0.99.5 Authors@R: c( person(given = "Hiranyamaya", family = "Dash", @@ -57,7 +57,6 @@ Imports: BSgenome, memes, S4Vectors, - magrittr, dplyr, purrr, tidyr, diff --git a/NAMESPACE b/NAMESPACE index d1d79f3..193002b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,31 +2,20 @@ export("%>%") export(MotifPeeker) -export(bpapply) export(calc_frip) -export(check_ENCODE) export(check_JASPAR) export(check_genome_build) export(denovo_motifs) export(find_motifs) -export(format_exptype) export(get_JASPARCORE) export(get_df_distances) -export(get_df_enrichment) export(motif_enrichment) export(motif_similarity) -export(plot_enrichment_individual) export(plot_enrichment_overall) -export(pretty_number) export(read_motif_file) export(read_peak_file) -export(report_command) -export(report_header) export(save_peak_file) -export(segregate_seqs) export(summit_to_motif) -export(to_plotly) -export(trim_seqs) import(BiocParallel) import(dplyr) import(ggplot2) @@ -55,10 +44,10 @@ importFrom(Rsamtools,countBam) importFrom(S4Vectors,queryHits) importFrom(S4Vectors,subjectHits) importFrom(SummarizedExperiment,assay) +importFrom(dplyr,"%>%") importFrom(heatmaply,heatmaply) importFrom(htmltools,tagList) importFrom(htmlwidgets,JS) -importFrom(magrittr,"%>%") importFrom(memes,meme_is_installed) importFrom(memes,runAme) importFrom(memes,runFimo) diff --git a/NEWS.md b/NEWS.md index 6a754c0..a75e928 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,12 @@ +# MotifPeeker 0.99.5 + +## Miscellaneous + +* Replace `magrittr` import by `dplyr::%>%`. +* Reduce the number of exported functions. +* Move utility functions to 'utilities.R'. + + # MotifPeeker 0.99.4 ## Miscellaneous diff --git a/R/bpapply.R b/R/bpapply.R index ece2700..8686a49 100644 --- a/R/bpapply.R +++ b/R/bpapply.R @@ -22,7 +22,7 @@ #' res <- bpapply(x, half_it, workers = 2) #' print(res) #' -#' @export +#' @keywords internal bpapply <- function( X, FUN, diff --git a/R/check_ENCODE.R b/R/check_ENCODE.R index ae1426b..f4156c2 100644 --- a/R/check_ENCODE.R +++ b/R/check_ENCODE.R @@ -18,7 +18,7 @@ #' check_ENCODE("ENCFF920TXI", expect_format = c("bed", "gz")) #' } #' -#' @export +#' @keywords internal check_ENCODE <- function(encode_id, expect_format, verbose = FALSE) { if (!all(is.character(encode_id))) return(encode_id) ### Validate ENCODE ID ### diff --git a/R/check_dep.R b/R/check_dep.R deleted file mode 100644 index d0bed15..0000000 --- a/R/check_dep.R +++ /dev/null @@ -1,25 +0,0 @@ -#' Check attached dependency -#' -#' Stop execution if a package is not attached. -#' -#' @param pkg a character string of the package name -#' @param fatal a logical value indicating whether to stop execution if the -#' package is not attached. -#' @param custom_msg a custom message to display if the package is not attached. -#' -#' @return Null -#' -#' @keywords internal -check_dep <- function(pkg, fatal = TRUE, custom_msg = NULL){ - if (is.null(custom_msg)) { - custom_msg <- paste("Package", shQuote(pkg), "is required to run this", - "function.") - } - if (!requireNamespace(pkg, quietly = TRUE)) { - if (fatal) { - stopper(custom_msg) - } else { - warning(custom_msg) - } - } -} diff --git a/R/check_duplicates.R b/R/check_duplicates.R deleted file mode 100644 index 56d19f9..0000000 --- a/R/check_duplicates.R +++ /dev/null @@ -1,16 +0,0 @@ -#' Check for duplicates -#' -#' Checks for duplicated items in a vector or list and throw an error if found. -#' -#' @param x A vector or list. -#' -#' @returns Null -#' -#' @keywords internal -check_duplicates <- function(x) { - stp_msg <- paste("Duplicated items found in the label list. Please input", - "unique experiment and motif labels.") - if (any(duplicated(x))) { - stopper(stp_msg) - } -} diff --git a/R/confirm_meme_install.R b/R/confirm_meme_install.R deleted file mode 100644 index 18c5bd9..0000000 --- a/R/confirm_meme_install.R +++ /dev/null @@ -1,24 +0,0 @@ -#' Stop if MEME suite is not installed -#' -#' @inheritParams memes::runFimo -#' -#' @importFrom memes meme_is_installed -#' -#' @returns Null -#' -#' @seealso \code{\link[memes]{check_meme_install}} -#' -#' @keywords internal -confirm_meme_install <- function(meme_path = NULL) { - stp_msg <- paste( - "Cannot find MEME suite installation. If installed, try setting the", - "path", shQuote("MEME_BIN"), "environment varaible, or use the", - shQuote("meme_path"), "parameter in the MotifPeeker function call.", - "\nFor more information, see the memes pacakge documention-", - "\nhttps://github.com/snystrom/memes#detecting-the-meme-suite" - ) - - if (!memes::meme_is_installed(meme_path)) { - stopper(stp_msg) - } -} diff --git a/R/format_exptype.R b/R/format_exptype.R deleted file mode 100644 index 3650c94..0000000 --- a/R/format_exptype.R +++ /dev/null @@ -1,44 +0,0 @@ -#' Format exp_type -#' -#' Format input exp_type to look pretty. -#' -#' @param exp_type A character depicting the type of experiment. -#' Supported experimental types are: -#' \itemize{ -#' \item \code{chipseq}: ChIP-seq data -#' \item \code{tipseq}: TIP-seq data -#' \item \code{cuttag}: CUT&Tag data -#' \item \code{cutrun}: CUT&Run data -#' \item \code{other}: Other experiment type data -#' \item \code{unknown}: Unknown experiment type data -#' } -#' Any item not mentioned above will be returned as-is. -#' -#' @return A character vector of formatted exp_type. -#' -#' @examples -#' format_exptype("chipseq") -#' -#' @export -format_exptype <- function(exp_type) { - if (is.na(exp_type)) { - exp_type <- "unknown" - } - - exp_type <- tolower(exp_type) - exp_types <- c( - "tipseq" = "TIP-Seq", - "chipseq" = "ChIP-Seq", - "cutrun" = "CUT&RUN", - "cuttag" = "CUT&Tag", - "other" = "Other", - "unknown" = "Unknown" - ) - - if (!exp_type %in% names(exp_types)) { - return(exp_type) - } - - exp_type <- exp_types[[exp_type]] - return(exp_type) -} diff --git a/R/get_df_enrichment.R b/R/get_df_enrichment.R index e72f8f6..5669430 100644 --- a/R/get_df_enrichment.R +++ b/R/get_df_enrichment.R @@ -58,7 +58,7 @@ #' #' @family generate data.frames #' -#' @export +#' @keywords internal get_df_enrichment <- function(result, segregated_peaks, user_motifs, diff --git a/R/messager.R b/R/messager.R deleted file mode 100644 index c55e80d..0000000 --- a/R/messager.R +++ /dev/null @@ -1,29 +0,0 @@ -#' Print messages -#' -#' Conditionally print messages. -#' Allows developers to easily control verbosity of functions, -#' and meet Bioconductor requirements that dictate the message -#' must first be stored to a variable before passing to \link[base]{message}. -#' -#' -#' @param v Whether to print messages or not. -#' @param parallel Whether to enable message print when wrapped -#' in parallelised functions. -#' -#' @return Null -#' -#' @keywords internal -messager <- function(..., - v = Sys.getenv("VERBOSE") != "FALSE", - parallel = TRUE) { - msg <- paste(...) - - message_parallel <- function(...) { - system2("echo", args = paste0(..., collpase = "")) - } - if(isTRUE(parallel)){ - if(v) try({message_parallel(msg)}) - } else { - if (v) try({message(msg)}) - } -} diff --git a/R/plot_enrichment_individual.R b/R/plot_enrichment_individual.R index b71e39d..c23b561 100644 --- a/R/plot_enrichment_individual.R +++ b/R/plot_enrichment_individual.R @@ -61,7 +61,7 @@ #' #' @family plot functions #' -#' @export +#' @keywords internal plot_enrichment_individual <- function(result, enrichment_df, comparison_i, diff --git a/R/pretty_number.R b/R/pretty_number.R deleted file mode 100644 index f50caf7..0000000 --- a/R/pretty_number.R +++ /dev/null @@ -1,27 +0,0 @@ -#' Convert numbers to more readable strings -#' -#' Format raw numbers to more readable strings. For example, 1000 will be -#' converted to "1K". Supported suffixes are "K", "M", and "B". -#' -#' @param x A number. -#' @param decimal_digits Number of decimal digits to round to. -#' -#' @return A character string of the formatted number. \code{NA} is returned as -#' "NA". -#' -#' @examples -#' print(pretty_number(134999)) -#' -#' @export -pretty_number <- function(x, decimal_digits = 2) { - if (is.na(x)) return("NA") - if (x < 1e3) { - return(as.character(round(x, decimal_digits))) - } else if (x < 1e6) { - return(paste0(round(x / 1e3, decimal_digits), "K")) - } else if (x < 1e9) { - return(paste0(round(x / 1e6, decimal_digits), "M")) - } else { - return(paste0(round(x / 1e9, decimal_digits), "B")) - } -} diff --git a/R/report_command.R b/R/report_command.R index dc0cece..78674d7 100644 --- a/R/report_command.R +++ b/R/report_command.R @@ -14,8 +14,7 @@ #' exp_labels = c("exp1", "exp2"), #' genome_build = "hg19")) #' -#' -#' @export +#' @keywords internal report_command <- function(params) { tab_spaces <- paste(rep(" ", nchar("MotifPeeker)")), collapse = "") diff --git a/R/report_header.R b/R/report_header.R index 1f79293..bcbd08d 100644 --- a/R/report_header.R +++ b/R/report_header.R @@ -9,7 +9,7 @@ #' @examples #' report_header() #' -#' @export +#' @keywords internal report_header <- function() { paste0( "
", diff --git a/R/segregate_seqs.R b/R/segregate_seqs.R index 43f866d..a4c56f6 100644 --- a/R/segregate_seqs.R +++ b/R/segregate_seqs.R @@ -37,7 +37,7 @@ #' #' @seealso \link[GenomicRanges]{findOverlaps} #' -#' @export +#' @keywords internal segregate_seqs <- function(seqs1, seqs2) { common_seqs_ranges <- GenomicRanges::findOverlaps(seqs1, seqs2, type = "any") diff --git a/R/to_plotly.R b/R/to_plotly.R index d7e9eab..b301ffb 100644 --- a/R/to_plotly.R +++ b/R/to_plotly.R @@ -18,7 +18,7 @@ #' #' @seealso \link[plotly]{ggplotly} #' -#' @export +#' @keywords internal to_plotly <- function(p, html_tags = TRUE, tooltip = "text", ...) { pltly <- plotly::ggplotly(p, tooltip = tooltip, ...) diff --git a/R/trim_seqs.R b/R/trim_seqs.R index b288f31..f2aaaa9 100644 --- a/R/trim_seqs.R +++ b/R/trim_seqs.R @@ -26,7 +26,7 @@ #' genome_build = genome_build) #' summary(GenomicRanges::width(trimmed_seqs)) #' -#' @export +#' @keywords internal trim_seqs <- function(peaks, peak_width, genome_build, respect_bounds = TRUE) { peak_width <- round(peak_width / 2, 0) max_len <- GenomeInfoDb::seqlengths(genome_build)[as.character( diff --git a/R/use_cache.R b/R/use_cache.R deleted file mode 100644 index a3f93a2..0000000 --- a/R/use_cache.R +++ /dev/null @@ -1,22 +0,0 @@ -#' Check, add and access files in cache -#' -#' Query local BiocFileCache to get cached version of a file and add them if -#' they do not exist. -#' -#' @param url A character string specifying the URL of the file to check for. -#' @inheritParams MotifPeeker -#' -#' @importFrom BiocFileCache BiocFileCache bfcinfo bfcrpath -#' -#' @returns A character string specifying the path to the cached file. -#' -#' @keywords internal -use_cache <- function(url, verbose = FALSE) { - bfc <- BiocFileCache::BiocFileCache(ask = FALSE) - cached_files <- BiocFileCache::bfcinfo(bfc)$rname - - if (!url %in% cached_files) { - messager("Adding file to cache: ", url, v = verbose) - } - return(BiocFileCache::bfcrpath(bfc, url)) -} diff --git a/R/utilities.R b/R/utilities.R new file mode 100644 index 0000000..bb4fdf1 --- /dev/null +++ b/R/utilities.R @@ -0,0 +1,217 @@ +#' Convert numbers to more readable strings +#' +#' Format raw numbers to more readable strings. For example, 1000 will be +#' converted to "1K". Supported suffixes are "K", "M", and "B". +#' +#' @param x A number. +#' @param decimal_digits Number of decimal digits to round to. +#' +#' @return A character string of the formatted number. \code{NA} is returned as +#' "NA". +#' +#' @examples +#' print(pretty_number(134999)) +#' +#' @keywords internal +pretty_number <- function(x, decimal_digits = 2) { + if (is.na(x)) return("NA") + if (x < 1e3) { + return(as.character(round(x, decimal_digits))) + } else if (x < 1e6) { + return(paste0(round(x / 1e3, decimal_digits), "K")) + } else if (x < 1e9) { + return(paste0(round(x / 1e6, decimal_digits), "M")) + } else { + return(paste0(round(x / 1e9, decimal_digits), "B")) + } +} + +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +#' +#' Generated by \code{\link[usethis]{use_pipe}}. Modified to import from +#' \code{dplyr} instead of \code{magrittr}. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom dplyr %>% +#' @usage lhs \%>\% rhs +#' @param lhs A value or the magrittr placeholder. +#' @param rhs A function call using the magrittr semantics. +#' +#' @examples +#' seq_len(10) %>% sum +#' +#' @return The result of calling `rhs(lhs)`. +#' +#' @keywords internal +NULL + +#' Format exp_type +#' +#' Format input exp_type to look pretty. +#' +#' @param exp_type A character depicting the type of experiment. +#' Supported experimental types are: +#' \itemize{ +#' \item \code{chipseq}: ChIP-seq data +#' \item \code{tipseq}: TIP-seq data +#' \item \code{cuttag}: CUT&Tag data +#' \item \code{cutrun}: CUT&Run data +#' \item \code{other}: Other experiment type data +#' \item \code{unknown}: Unknown experiment type data +#' } +#' Any item not mentioned above will be returned as-is. +#' +#' @return A character vector of formatted exp_type. +#' +#' @examples +#' format_exptype("chipseq") +#' +#' @keywords internal +format_exptype <- function(exp_type) { + if (is.na(exp_type)) { + exp_type <- "unknown" + } + + exp_type <- tolower(exp_type) + exp_types <- c( + "tipseq" = "TIP-Seq", + "chipseq" = "ChIP-Seq", + "cutrun" = "CUT&RUN", + "cuttag" = "CUT&Tag", + "other" = "Other", + "unknown" = "Unknown" + ) + + if (!exp_type %in% names(exp_types)) { + return(exp_type) + } + + exp_type <- exp_types[[exp_type]] + return(exp_type) +} + +#' Print messages +#' +#' Conditionally print messages. +#' Allows developers to easily control verbosity of functions, +#' and meet Bioconductor requirements that dictate the message +#' must first be stored to a variable before passing to \link[base]{message}. +#' +#' +#' @param v Whether to print messages or not. +#' @param parallel Whether to enable message print when wrapped +#' in parallelised functions. +#' +#' @return Null +#' +#' @keywords internal +messager <- function(..., + v = Sys.getenv("VERBOSE") != "FALSE", + parallel = TRUE) { + msg <- paste(...) + + message_parallel <- function(...) { + system2("echo", args = paste0(..., collpase = "")) + } + if(isTRUE(parallel)){ + if(v) try({message_parallel(msg)}) + } else { + if (v) try({message(msg)}) + } +} + +#' Check, add and access files in cache +#' +#' Query local BiocFileCache to get cached version of a file and add them if +#' they do not exist. +#' +#' @param url A character string specifying the URL of the file to check for. +#' @inheritParams MotifPeeker +#' +#' @importFrom BiocFileCache BiocFileCache bfcinfo bfcrpath +#' +#' @returns A character string specifying the path to the cached file. +#' +#' @keywords internal +use_cache <- function(url, verbose = FALSE) { + bfc <- BiocFileCache::BiocFileCache(ask = FALSE) + cached_files <- BiocFileCache::bfcinfo(bfc)$rname + + if (!url %in% cached_files) { + messager("Adding file to cache: ", url, v = verbose) + } + return(BiocFileCache::bfcrpath(bfc, url)) +} + +#' Check for duplicates +#' +#' Checks for duplicated items in a vector or list and throw an error if found. +#' +#' @param x A vector or list. +#' +#' @returns Null +#' +#' @keywords internal +check_duplicates <- function(x) { + stp_msg <- paste("Duplicated items found in the label list. Please input", + "unique experiment and motif labels.") + if (any(duplicated(x))) { + stopper(stp_msg) + } +} + +#' Check attached dependency +#' +#' Stop execution if a package is not attached. +#' +#' @param pkg a character string of the package name +#' @param fatal a logical value indicating whether to stop execution if the +#' package is not attached. +#' @param custom_msg a custom message to display if the package is not attached. +#' +#' @return Null +#' +#' @keywords internal +check_dep <- function(pkg, fatal = TRUE, custom_msg = NULL){ + if (is.null(custom_msg)) { + custom_msg <- paste("Package", shQuote(pkg), "is required to run this", + "function.") + } + if (!requireNamespace(pkg, quietly = TRUE)) { + if (fatal) { + stopper(custom_msg) + } else { + warning(custom_msg) + } + } +} + +#' Stop if MEME suite is not installed +#' +#' @inheritParams memes::runFimo +#' +#' @importFrom memes meme_is_installed +#' +#' @returns Null +#' +#' @seealso \code{\link[memes]{check_meme_install}} +#' +#' @keywords internal +confirm_meme_install <- function(meme_path = NULL) { + stp_msg <- paste( + "Cannot find MEME suite installation. If installed, try setting the", + "path", shQuote("MEME_BIN"), "environment varaible, or use the", + shQuote("meme_path"), "parameter in the MotifPeeker function call.", + "\nFor more information, see the memes pacakge documention-", + "\nhttps://github.com/snystrom/memes#detecting-the-meme-suite" + ) + + if (!memes::meme_is_installed(meme_path)) { + stopper(stp_msg) + } +} diff --git a/R/utils_pipe.R b/R/utils_pipe.R deleted file mode 100644 index d6d4fbb..0000000 --- a/R/utils_pipe.R +++ /dev/null @@ -1,23 +0,0 @@ -#' Pipe operator -#' -#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. -#' -#' Generated by \code{\link[usethis]{use_pipe}}. Modified to import from -#' \code{dplyr} instead of \code{magrittr}. -#' -#' @name %>% -#' @rdname pipe -#' @keywords internal -#' @export -#' @importFrom dplyr %>% -#' @usage lhs \%>\% rhs -#' @param lhs A value or the magrittr placeholder. -#' @param rhs A function call using the magrittr semantics. -#' -#' @examples -#' seq_len(10) %>% sum -#' -#' @return The result of calling `rhs(lhs)`. -#' -#' @keywords internal -NULL diff --git a/README.md b/README.md index c0c23f8..6cb9f22 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ style="height: 300px !important;" /> [![License: GPL (\>= 3)](https://img.shields.io/badge/license-GPL%20(%3E=%203)-blue.svg)](https://cran.r-project.org/web/licenses/GPL%20(%3E=%203)) -[![](https://img.shields.io/badge/devel%20version-0.99.4-black.svg)](https://github.com/neurogenomics/MotifPeeker) +[![](https://img.shields.io/badge/devel%20version-0.99.5-black.svg)](https://github.com/neurogenomics/MotifPeeker) [![](https://img.shields.io/github/languages/code-size/neurogenomics/MotifPeeker.svg)](https://github.com/neurogenomics/MotifPeeker) [![](https://img.shields.io/github/last-commit/neurogenomics/MotifPeeker.svg)](https://github.com/neurogenomics/MotifPeeker/commits/master)
[![R build @@ -18,7 +18,7 @@ status](https://github.com/neurogenomics/MotifPeeker/workflows/rworkflows/badge. **Authors:** ***Hiranyamaya (Hiru) Dash, Thomas Roberts, Nathan Skene*** -**Updated:** ***Aug-10-2024*** +**Updated:** ***Oct-21-2024*** ## Introduction @@ -355,7 +355,7 @@ utils::sessionInfo() ## R version 4.4.1 (2024-06-14) ## Platform: aarch64-apple-darwin20 - ## Running under: macOS Sonoma 14.5 + ## Running under: macOS 15.0.1 ## ## Matrix products: default ## BLAS: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib @@ -371,21 +371,21 @@ utils::sessionInfo() ## [1] stats graphics grDevices utils datasets methods base ## ## loaded via a namespace (and not attached): - ## [1] gtable_0.3.5 jsonlite_1.8.8 renv_1.0.7 - ## [4] dplyr_1.1.4 compiler_4.4.1 BiocManager_1.30.23 + ## [1] gtable_0.3.5 jsonlite_1.8.9 renv_1.0.11 + ## [4] dplyr_1.1.4 compiler_4.4.1 BiocManager_1.30.25 ## [7] tidyselect_1.2.1 rvcheck_0.2.1 scales_1.3.0 ## [10] yaml_2.3.10 fastmap_1.2.0 here_1.0.1 ## [13] ggplot2_3.5.1 R6_2.5.1 generics_0.1.3 - ## [16] knitr_1.48 yulab.utils_0.1.5 tibble_3.2.1 + ## [16] knitr_1.48 yulab.utils_0.1.7 tibble_3.2.1 ## [19] desc_1.4.3 dlstats_0.1.7 rprojroot_2.0.4 ## [22] munsell_0.5.1 pillar_1.9.0 RColorBrewer_1.1-3 - ## [25] rlang_1.1.4 utf8_1.2.4 cachem_1.1.0 - ## [28] badger_0.2.4 xfun_0.46 fs_1.6.4 - ## [31] memoise_2.0.1 cli_3.6.3 magrittr_2.0.3 - ## [34] rworkflows_1.0.1 digest_0.6.36 grid_4.4.1 - ## [37] rstudioapi_0.16.0 lifecycle_1.0.4 vctrs_0.6.5 - ## [40] data.table_1.15.4 evaluate_0.24.0 glue_1.7.0 - ## [43] fansi_1.0.6 colorspace_2.1-1 rmarkdown_2.27 - ## [46] tools_4.4.1 pkgconfig_2.0.3 htmltools_0.5.8.1 + ## [25] rlang_1.1.4 utf8_1.2.4 badger_0.2.4 + ## [28] xfun_0.48 fs_1.6.4 cli_3.6.3 + ## [31] magrittr_2.0.3 rworkflows_1.0.2 digest_0.6.37 + ## [34] grid_4.4.1 rstudioapi_0.16.0 lifecycle_1.0.4 + ## [37] vctrs_0.6.5 evaluate_1.0.1 glue_1.8.0 + ## [40] data.table_1.16.2 fansi_1.0.6 colorspace_2.1-1 + ## [43] rmarkdown_2.28 tools_4.4.1 pkgconfig_2.0.3 + ## [46] htmltools_0.5.8.1 diff --git a/inst/markdown/MotifPeeker.Rmd b/inst/markdown/MotifPeeker.Rmd index ba6aa69..c94538a 100644 --- a/inst/markdown/MotifPeeker.Rmd +++ b/inst/markdown/MotifPeeker.Rmd @@ -1,5 +1,5 @@ --- -title: "`r MotifPeeker::report_header()`" +title: "`r MotifPeeker:::report_header()`" date: "`r format(Sys.Date(), '%b-%d-%Y')`" output: html_document: @@ -70,15 +70,15 @@ if (is.null(params$exp_type)) { } else { exp_types <- params$exp_type } -peak_files_encode <- Vectorize(check_ENCODE, "encode_id")( +peak_files_encode <- Vectorize(MotifPeeker:::check_ENCODE, "encode_id")( params$peak_files, expect_format = c("narrowPeak", "bed")) -alignment_files_encode <- Vectorize(check_ENCODE, "encode_id")( +alignment_files_encode <- Vectorize(MotifPeeker:::check_ENCODE, "encode_id")( params$alignment_files, expect_format = "bam") result <- list( peaks = Vectorize(read_peak_file, "peak_file")(peak_files_encode), alignments = lapply(alignment_files_encode, Rsamtools::BamFile), exp_labels = params$exp_labels, - exp_type = unname(Vectorize(format_exptype, "exp_type")(exp_types)) + exp_type = unname(Vectorize(MotifPeeker:::format_exptype, "exp_type")(exp_types)) ) motif_files_jaspar <- Vectorize(check_JASPAR, "motif_id")(params$motif_files) user_motifs <- list( @@ -151,13 +151,13 @@ if (comparison_metrics) { comparison_indices <- setdiff(seq_along(result$peaks), params$reference_index) segregated_peaks <- lapply(comparison_indices, function(x) { - segregate_seqs(result$peaks[[params$reference_index]], - result$peaks[[x]]) + MotifPeeker:::segregate_seqs(result$peaks[[params$reference_index]], + result$peaks[[x]]) }) ## Calculate enrichment for segregated peaks if (user_motif_metrics) { - enrichment_df <- get_df_enrichment( + enrichment_df <- MotifPeeker:::get_df_enrichment( result, segregated_peaks, user_motifs, genome_build, params$reference_index, out_dir_extra, params$workers, params$meme_path, params$verbose @@ -242,7 +242,7 @@ for (i in seq_along(user_motifs$motifs)) { ## Command {-} `MotifPeeker` report was generated with the following command: ```{r report_command} -cat(report_command(params)) +cat(MotifPeeker:::report_command(params)) ```
@@ -282,7 +282,7 @@ if (!alignment_metrics) { scale_fill_viridis(begin = 0.15, end = 0.6, discrete = TRUE, option = "A") - print(to_plotly(frip_exp_plot)) + print(MotifPeeker:::to_plotly(frip_exp_plot)) } ``` @@ -319,7 +319,7 @@ if (alignment_metrics) { scale_fill_viridis(begin = 0.15, end = 0.6, discrete = TRUE, option = "A") - print(to_plotly(frip_individual_plot)) + print(MotifPeeker:::to_plotly(frip_individual_plot)) } ``` ```{r frip_individual_dt, include = alignment_metrics} @@ -385,7 +385,7 @@ if (alignment_metrics) { scale_color_viridis(begin = 0.15, end = 0.6, discrete = TRUE, option = "A") - print(to_plotly(frip_cellcount_plot)) + print(MotifPeeker:::to_plotly(frip_cellcount_plot)) } } ``` @@ -412,7 +412,7 @@ peak_width_plt1 <- peak_width_df %>% scale_fill_viridis(begin = 0.2, end = 0.6, discrete = TRUE, option = "A") - print(to_plotly(peak_width_plt1)) + print(MotifPeeker:::to_plotly(peak_width_plt1)) ``` ```{r peakwidths_exp_plot2} @@ -429,7 +429,7 @@ peak_width_plt2 <- peak_width_df %>% scale_fill_viridis(begin = 0.2, end = 0.6, discrete = TRUE, option = "A") - print(to_plotly(peak_width_plt2)) + print(MotifPeeker:::to_plotly(peak_width_plt2)) ``` ```{r peakwidths_exp_dt} @@ -463,7 +463,7 @@ peak_width_plt3 <- peak_width_df %>% scale_fill_viridis(begin = 0.15, end = 0.6, discrete = TRUE, option = "A") - print(to_plotly(peak_width_plt3)) + print(MotifPeeker:::to_plotly(peak_width_plt3)) ``` ```{r peakwidths_ind_dt} @@ -545,7 +545,7 @@ if (!cellcount_metrics) { scale_color_viridis(begin = 0.15, end = 0.6, discrete = TRUE, option = "A") - print(to_plotly(peak_width_cellcount_plot)) + print(MotifPeeker:::to_plotly(peak_width_cellcount_plot)) } ``` @@ -603,7 +603,7 @@ if (!user_motif_metrics) { labs(color = "Experiment Type", x = "Distance (bp)", y = "Count") - motif_summit_dist_plt1 <- to_plotly(motif_summit_dist_plt1, + motif_summit_dist_plt1 <- MotifPeeker:::to_plotly(motif_summit_dist_plt1, html_tags = FALSE) ## Density plot @@ -622,7 +622,7 @@ if (!user_motif_metrics) { fill = "Experiment Type", x = "Distance (bp)", y = "Count") - motif_summit_dist_plt2 <- to_plotly(motif_summit_dist_plt2, + motif_summit_dist_plt2 <- MotifPeeker:::to_plotly(motif_summit_dist_plt2, html_tags = FALSE) motif_summit_dist_exp_plt <- @@ -678,7 +678,7 @@ if (!user_motif_metrics) { scale_fill_viridis(begin = 0.15, end = 0.6, discrete = TRUE, option = "A") - print(to_plotly(motif_summit_dist_ind_plt, html_tags = TRUE)) + print(MotifPeeker:::to_plotly(motif_summit_dist_ind_plt, html_tags = TRUE)) ## DT motif_summit_dist_df %>% @@ -797,12 +797,12 @@ if (!user_motif_metrics) { print_labels(result$exp_labels, params$reference_index, i, "known_motif", result$read_count) ## Plot - plot_enrichment_individual(result, enrichment_df, i, motif_i, - label_colours, params$reference_index) %>% + MotifPeeker:::plot_enrichment_individual(result, enrichment_df, i, + motif_i, label_colours, params$reference_index) %>% print() ## DT cat(" \n ") - dt_enrichment_individual(result, enrichment_df, i, motif_i, + MotifPeeker:::dt_enrichment_individual(result, enrichment_df, i, motif_i, params$reference_index) %>% print() cat(" \n ") diff --git a/man/bpapply.Rd b/man/bpapply.Rd index 5177ef3..61a07c2 100644 --- a/man/bpapply.Rd +++ b/man/bpapply.Rd @@ -83,3 +83,4 @@ res <- bpapply(x, half_it, workers = 2) print(res) } +\keyword{internal} diff --git a/man/check_ENCODE.Rd b/man/check_ENCODE.Rd index 685bb0a..82b5739 100644 --- a/man/check_ENCODE.Rd +++ b/man/check_ENCODE.Rd @@ -31,3 +31,4 @@ if (requireNamespace("curl", quietly = TRUE) && } } +\keyword{internal} diff --git a/man/check_dep.Rd b/man/check_dep.Rd index 9976194..c838607 100644 --- a/man/check_dep.Rd +++ b/man/check_dep.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/check_dep.R +% Please edit documentation in R/utilities.R \name{check_dep} \alias{check_dep} \title{Check attached dependency} diff --git a/man/check_duplicates.Rd b/man/check_duplicates.Rd index c6878f3..0f3cd9e 100644 --- a/man/check_duplicates.Rd +++ b/man/check_duplicates.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/check_duplicates.R +% Please edit documentation in R/utilities.R \name{check_duplicates} \alias{check_duplicates} \title{Check for duplicates} diff --git a/man/confirm_meme_install.Rd b/man/confirm_meme_install.Rd index 7f6d9b1..68b7140 100644 --- a/man/confirm_meme_install.Rd +++ b/man/confirm_meme_install.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/confirm_meme_install.R +% Please edit documentation in R/utilities.R \name{confirm_meme_install} \alias{confirm_meme_install} \title{Stop if MEME suite is not installed} diff --git a/man/format_exptype.Rd b/man/format_exptype.Rd index ccce353..857dcb0 100644 --- a/man/format_exptype.Rd +++ b/man/format_exptype.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/format_exptype.R +% Please edit documentation in R/utilities.R \name{format_exptype} \alias{format_exptype} \title{Format exp_type} @@ -29,3 +29,4 @@ Format input exp_type to look pretty. format_exptype("chipseq") } +\keyword{internal} diff --git a/man/get_df_enrichment.Rd b/man/get_df_enrichment.Rd index 5a1f182..49abac5 100644 --- a/man/get_df_enrichment.Rd +++ b/man/get_df_enrichment.Rd @@ -116,3 +116,4 @@ Other generate data.frames: \code{\link{get_df_distances}()} } \concept{generate data.frames} +\keyword{internal} diff --git a/man/messager.Rd b/man/messager.Rd index bda6b12..f3733b5 100644 --- a/man/messager.Rd +++ b/man/messager.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/messager.R +% Please edit documentation in R/utilities.R \name{messager} \alias{messager} \title{Print messages} diff --git a/man/pipe.Rd b/man/pipe.Rd index 89cc642..930b022 100644 --- a/man/pipe.Rd +++ b/man/pipe.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils_pipe.R +% Please edit documentation in R/utilities.R \name{\%>\%} \alias{\%>\%} \title{Pipe operator} @@ -18,7 +18,8 @@ The result of calling `rhs(lhs)`. See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. } \details{ -Generated by \code{\link[usethis]{use_pipe}}. +Generated by \code{\link[usethis]{use_pipe}}. Modified to import from +\code{dplyr} instead of \code{magrittr}. } \examples{ seq_len(10) \%>\% sum diff --git a/man/plot_enrichment_individual.Rd b/man/plot_enrichment_individual.Rd index 031a864..8be8a56 100644 --- a/man/plot_enrichment_individual.Rd +++ b/man/plot_enrichment_individual.Rd @@ -96,3 +96,4 @@ Other plot functions: \code{\link{plot_motif_comparison}()} } \concept{plot functions} +\keyword{internal} diff --git a/man/pretty_number.Rd b/man/pretty_number.Rd index fb2dda4..f0b5d42 100644 --- a/man/pretty_number.Rd +++ b/man/pretty_number.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pretty_number.R +% Please edit documentation in R/utilities.R \name{pretty_number} \alias{pretty_number} \title{Convert numbers to more readable strings} @@ -23,3 +23,4 @@ converted to "1K". Supported suffixes are "K", "M", and "B". print(pretty_number(134999)) } +\keyword{internal} diff --git a/man/report_command.Rd b/man/report_command.Rd index e42e160..b1a662d 100644 --- a/man/report_command.Rd +++ b/man/report_command.Rd @@ -23,5 +23,5 @@ report_command(params = list( exp_labels = c("exp1", "exp2"), genome_build = "hg19")) - } +\keyword{internal} diff --git a/man/report_header.Rd b/man/report_header.Rd index f2bc937..8573c18 100644 --- a/man/report_header.Rd +++ b/man/report_header.Rd @@ -20,3 +20,4 @@ the \emph{MotifPeeker.Rmd} template. report_header() } +\keyword{internal} diff --git a/man/segregate_seqs.Rd b/man/segregate_seqs.Rd index 656d39c..d811833 100644 --- a/man/segregate_seqs.Rd +++ b/man/segregate_seqs.Rd @@ -47,3 +47,4 @@ print(res) \seealso{ \link[GenomicRanges]{findOverlaps} } +\keyword{internal} diff --git a/man/to_plotly.Rd b/man/to_plotly.Rd index d7b0b07..cd7548f 100644 --- a/man/to_plotly.Rd +++ b/man/to_plotly.Rd @@ -45,3 +45,4 @@ to_plotly(p, html_tags = FALSE) \seealso{ \link[plotly]{ggplotly} } +\keyword{internal} diff --git a/man/trim_seqs.Rd b/man/trim_seqs.Rd index db05e09..8bac5b4 100644 --- a/man/trim_seqs.Rd +++ b/man/trim_seqs.Rd @@ -37,3 +37,4 @@ trimmed_seqs <- trim_seqs(peaks, peak_width = 100, summary(GenomicRanges::width(trimmed_seqs)) } +\keyword{internal} diff --git a/man/use_cache.Rd b/man/use_cache.Rd index b7bd3e1..e176107 100644 --- a/man/use_cache.Rd +++ b/man/use_cache.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/use_cache.R +% Please edit documentation in R/utilities.R \name{use_cache} \alias{use_cache} \title{Check, add and access files in cache} From 412a5af1478eb087e2ac53217947975285dd9dd9 Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 13:42:57 +0100 Subject: [PATCH 04/13] Internalise some functions and move utility functions to utilities.R FIXES --- NAMESPACE | 3 +++ R/bpapply.R | 2 +- R/check_ENCODE.R | 2 +- R/get_df_enrichment.R | 2 +- R/normalise_paths.R | 23 ----------------- R/plot_enrichment_individual.R | 9 ++++--- R/random_string.R | 12 --------- R/report_command.R | 2 +- R/report_header.R | 2 +- R/segregate_seqs.R | 2 +- R/to_plotly.R | 2 +- R/trim_seqs.R | 2 +- R/utilities.R | 43 ++++++++++++++++++++++++++++--- inst/markdown/MotifPeeker.Rmd | 8 +++--- man/bpapply.Rd | 2 +- man/check_ENCODE.Rd | 1 - man/format_exptype.Rd | 2 +- man/get_df_enrichment.Rd | 1 - man/normalise_paths.Rd | 2 +- man/plot_enrichment_individual.Rd | 9 ++++--- man/pretty_number.Rd | 2 +- man/random_string.Rd | 2 +- man/report_command.Rd | 2 +- man/report_header.Rd | 2 +- man/segregate_seqs.Rd | 1 - man/to_plotly.Rd | 2 +- man/trim_seqs.Rd | 2 +- tests/testthat/test-bpapply.R | 15 ++++++----- 28 files changed, 81 insertions(+), 78 deletions(-) delete mode 100644 R/normalise_paths.R delete mode 100644 R/random_string.R diff --git a/NAMESPACE b/NAMESPACE index 193002b..aa91489 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,18 +3,21 @@ export("%>%") export(MotifPeeker) export(calc_frip) +export(check_ENCODE) export(check_JASPAR) export(check_genome_build) export(denovo_motifs) export(find_motifs) export(get_JASPARCORE) export(get_df_distances) +export(get_df_enrichment) export(motif_enrichment) export(motif_similarity) export(plot_enrichment_overall) export(read_motif_file) export(read_peak_file) export(save_peak_file) +export(segregate_seqs) export(summit_to_motif) import(BiocParallel) import(dplyr) diff --git a/R/bpapply.R b/R/bpapply.R index 8686a49..3ad7649 100644 --- a/R/bpapply.R +++ b/R/bpapply.R @@ -19,7 +19,7 @@ #' half_it <- function(arg1) return(arg1 / 2) #' x <- seq_len(10) #' -#' res <- bpapply(x, half_it, workers = 2) +#' res <- MotifPeeker:::bpapply(x, half_it, workers = 2) #' print(res) #' #' @keywords internal diff --git a/R/check_ENCODE.R b/R/check_ENCODE.R index f4156c2..ae1426b 100644 --- a/R/check_ENCODE.R +++ b/R/check_ENCODE.R @@ -18,7 +18,7 @@ #' check_ENCODE("ENCFF920TXI", expect_format = c("bed", "gz")) #' } #' -#' @keywords internal +#' @export check_ENCODE <- function(encode_id, expect_format, verbose = FALSE) { if (!all(is.character(encode_id))) return(encode_id) ### Validate ENCODE ID ### diff --git a/R/get_df_enrichment.R b/R/get_df_enrichment.R index 5669430..e72f8f6 100644 --- a/R/get_df_enrichment.R +++ b/R/get_df_enrichment.R @@ -58,7 +58,7 @@ #' #' @family generate data.frames #' -#' @keywords internal +#' @export get_df_enrichment <- function(result, segregated_peaks, user_motifs, diff --git a/R/normalise_paths.R b/R/normalise_paths.R deleted file mode 100644 index 38dc6ee..0000000 --- a/R/normalise_paths.R +++ /dev/null @@ -1,23 +0,0 @@ -#' Apply \code{\link[base]{normalizePath}} to a list of paths -#' -#' @param path_list A list of paths. -#' -#' @return A list of normalised paths or the input as is if contents are not -#' a character. -#' -#' @keywords internal -normalise_paths <- function(path_list) { - if (all(is.null(path_list))) return(path_list) - - ## Convert objects to list if not already - if (!is.list(path_list) &&(!is.vector(path_list) || length(path_list) == 1)) - path_list <- list(path_list) - - ## Return input as is if not character - if (!all(vapply(path_list, is.character, logical(1)))) return(path_list) - - ## Normalise paths - lapply(path_list, function(path) { - normalizePath(path) - }) -} diff --git a/R/plot_enrichment_individual.R b/R/plot_enrichment_individual.R index c23b561..5e70b9f 100644 --- a/R/plot_enrichment_individual.R +++ b/R/plot_enrichment_individual.R @@ -46,14 +46,15 @@ #' genome_build <- #' BSgenome.Hsapiens.UCSC.hg38::BSgenome.Hsapiens.UCSC.hg38 #' enrichment_df <- get_df_enrichment( -#' input, segregated_input, motifs, genome_build, reference_index = 1, -#' workers = 1 +#' input, segregated_input, motifs, genome_build, +#' reference_index = 1, workers = 1 #' ) #' label_colours <- c("red", "cyan") #' -#' plt <- plot_enrichment_individual( +#' plt <- MotifPeeker:::plot_enrichment_individual( #' input, enrichment_df, comparison_i = 2, motif_i = 1, -#' label_colours = label_colours, reference_index = 1, html_tags = FALSE +#' label_colours = label_colours, reference_index = 1, +#' html_tags = FALSE #' ) #' print(plt) #' } diff --git a/R/random_string.R b/R/random_string.R deleted file mode 100644 index a4c7a47..0000000 --- a/R/random_string.R +++ /dev/null @@ -1,12 +0,0 @@ -#' Generate a random string -#' -#' @param length The length of the random string to generate. -#' -#' @returns A random string of the specified length. -#' -#' @keywords internal -random_string <- function(length) { - char_base <- c(0:9, letters) - random_chars <- sample(char_base, length, replace = TRUE) - return(paste(random_chars, collapse = "")) -} diff --git a/R/report_command.R b/R/report_command.R index 78674d7..eb06a45 100644 --- a/R/report_command.R +++ b/R/report_command.R @@ -9,7 +9,7 @@ #' \code{\link{MotifPeeker}} command. #' #' @examples -#' report_command(params = list( +#' MotifPeeker:::report_command(params = list( #' alignment_files = c("file1.bam", "file2.bam"), #' exp_labels = c("exp1", "exp2"), #' genome_build = "hg19")) diff --git a/R/report_header.R b/R/report_header.R index bcbd08d..70a2d32 100644 --- a/R/report_header.R +++ b/R/report_header.R @@ -7,7 +7,7 @@ #' @returns Header string to be rendering within Rmarkdown file. #' #' @examples -#' report_header() +#' MotifPeeker:::report_header() #' #' @keywords internal report_header <- function() { diff --git a/R/segregate_seqs.R b/R/segregate_seqs.R index a4c56f6..43f866d 100644 --- a/R/segregate_seqs.R +++ b/R/segregate_seqs.R @@ -37,7 +37,7 @@ #' #' @seealso \link[GenomicRanges]{findOverlaps} #' -#' @keywords internal +#' @export segregate_seqs <- function(seqs1, seqs2) { common_seqs_ranges <- GenomicRanges::findOverlaps(seqs1, seqs2, type = "any") diff --git a/R/to_plotly.R b/R/to_plotly.R index b301ffb..c7c04bd 100644 --- a/R/to_plotly.R +++ b/R/to_plotly.R @@ -14,7 +14,7 @@ #' @examples #' x <- data.frame(a = c(1,2,3), b = c(2,3,4)) #' p <- ggplot2::ggplot(x, ggplot2::aes(x = a, y = b)) + ggplot2::geom_point() -#' to_plotly(p, html_tags = FALSE) +#' MotifPeeker:::to_plotly(p, html_tags = FALSE) #' #' @seealso \link[plotly]{ggplotly} #' diff --git a/R/trim_seqs.R b/R/trim_seqs.R index f2aaaa9..efe4c19 100644 --- a/R/trim_seqs.R +++ b/R/trim_seqs.R @@ -22,7 +22,7 @@ #' peaks <- CTCF_TIP_peaks #' genome_build <- BSgenome.Hsapiens.UCSC.hg38::BSgenome.Hsapiens.UCSC.hg38 #' -#' trimmed_seqs <- trim_seqs(peaks, peak_width = 100, +#' trimmed_seqs <- MotifPeeker:::trim_seqs(peaks, peak_width = 100, #' genome_build = genome_build) #' summary(GenomicRanges::width(trimmed_seqs)) #' diff --git a/R/utilities.R b/R/utilities.R index bb4fdf1..604c43d 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -10,7 +10,7 @@ #' "NA". #' #' @examples -#' print(pretty_number(134999)) +#' print(MotifPeeker:::pretty_number(134999)) #' #' @keywords internal pretty_number <- function(x, decimal_digits = 2) { @@ -46,8 +46,6 @@ pretty_number <- function(x, decimal_digits = 2) { #' seq_len(10) %>% sum #' #' @return The result of calling `rhs(lhs)`. -#' -#' @keywords internal NULL #' Format exp_type @@ -69,7 +67,7 @@ NULL #' @return A character vector of formatted exp_type. #' #' @examples -#' format_exptype("chipseq") +#' MotifPeeker:::format_exptype("chipseq") #' #' @keywords internal format_exptype <- function(exp_type) { @@ -215,3 +213,40 @@ confirm_meme_install <- function(meme_path = NULL) { stopper(stp_msg) } } + +#' Generate a random string +#' +#' @param length The length of the random string to generate. +#' +#' @returns A random string of the specified length. +#' +#' @keywords internal +random_string <- function(length) { + char_base <- c(0:9, letters) + random_chars <- sample(char_base, length, replace = TRUE) + return(paste(random_chars, collapse = "")) +} + +#' Apply \code{\link[base]{normalizePath}} to a list of paths +#' +#' @param path_list A list of paths. +#' +#' @return A list of normalised paths or the input as is if contents are not +#' a character. +#' +#' @keywords internal +normalise_paths <- function(path_list) { + if (all(is.null(path_list))) return(path_list) + + ## Convert objects to list if not already + if (!is.list(path_list) &&(!is.vector(path_list) || length(path_list) == 1)) + path_list <- list(path_list) + + ## Return input as is if not character + if (!all(vapply(path_list, is.character, logical(1)))) return(path_list) + + ## Normalise paths + lapply(path_list, function(path) { + normalizePath(path) + }) +} diff --git a/inst/markdown/MotifPeeker.Rmd b/inst/markdown/MotifPeeker.Rmd index c94538a..974737b 100644 --- a/inst/markdown/MotifPeeker.Rmd +++ b/inst/markdown/MotifPeeker.Rmd @@ -70,9 +70,9 @@ if (is.null(params$exp_type)) { } else { exp_types <- params$exp_type } -peak_files_encode <- Vectorize(MotifPeeker:::check_ENCODE, "encode_id")( +peak_files_encode <- Vectorize(check_ENCODE, "encode_id")( params$peak_files, expect_format = c("narrowPeak", "bed")) -alignment_files_encode <- Vectorize(MotifPeeker:::check_ENCODE, "encode_id")( +alignment_files_encode <- Vectorize(check_ENCODE, "encode_id")( params$alignment_files, expect_format = "bam") result <- list( peaks = Vectorize(read_peak_file, "peak_file")(peak_files_encode), @@ -151,13 +151,13 @@ if (comparison_metrics) { comparison_indices <- setdiff(seq_along(result$peaks), params$reference_index) segregated_peaks <- lapply(comparison_indices, function(x) { - MotifPeeker:::segregate_seqs(result$peaks[[params$reference_index]], + segregate_seqs(result$peaks[[params$reference_index]], result$peaks[[x]]) }) ## Calculate enrichment for segregated peaks if (user_motif_metrics) { - enrichment_df <- MotifPeeker:::get_df_enrichment( + enrichment_df <- get_df_enrichment( result, segregated_peaks, user_motifs, genome_build, params$reference_index, out_dir_extra, params$workers, params$meme_path, params$verbose diff --git a/man/bpapply.Rd b/man/bpapply.Rd index 61a07c2..5b2301e 100644 --- a/man/bpapply.Rd +++ b/man/bpapply.Rd @@ -79,7 +79,7 @@ specified. half_it <- function(arg1) return(arg1 / 2) x <- seq_len(10) -res <- bpapply(x, half_it, workers = 2) +res <- MotifPeeker:::bpapply(x, half_it, workers = 2) print(res) } diff --git a/man/check_ENCODE.Rd b/man/check_ENCODE.Rd index 82b5739..685bb0a 100644 --- a/man/check_ENCODE.Rd +++ b/man/check_ENCODE.Rd @@ -31,4 +31,3 @@ if (requireNamespace("curl", quietly = TRUE) && } } -\keyword{internal} diff --git a/man/format_exptype.Rd b/man/format_exptype.Rd index 857dcb0..affa782 100644 --- a/man/format_exptype.Rd +++ b/man/format_exptype.Rd @@ -26,7 +26,7 @@ A character vector of formatted exp_type. Format input exp_type to look pretty. } \examples{ -format_exptype("chipseq") +MotifPeeker:::format_exptype("chipseq") } \keyword{internal} diff --git a/man/get_df_enrichment.Rd b/man/get_df_enrichment.Rd index 49abac5..5a1f182 100644 --- a/man/get_df_enrichment.Rd +++ b/man/get_df_enrichment.Rd @@ -116,4 +116,3 @@ Other generate data.frames: \code{\link{get_df_distances}()} } \concept{generate data.frames} -\keyword{internal} diff --git a/man/normalise_paths.Rd b/man/normalise_paths.Rd index 13b9268..c99004f 100644 --- a/man/normalise_paths.Rd +++ b/man/normalise_paths.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/normalise_paths.R +% Please edit documentation in R/utilities.R \name{normalise_paths} \alias{normalise_paths} \title{Apply \code{\link[base]{normalizePath}} to a list of paths} diff --git a/man/plot_enrichment_individual.Rd b/man/plot_enrichment_individual.Rd index 8be8a56..4b65b89 100644 --- a/man/plot_enrichment_individual.Rd +++ b/man/plot_enrichment_individual.Rd @@ -76,14 +76,15 @@ motifs <- list( genome_build <- BSgenome.Hsapiens.UCSC.hg38::BSgenome.Hsapiens.UCSC.hg38 enrichment_df <- get_df_enrichment( - input, segregated_input, motifs, genome_build, reference_index = 1, - workers = 1 + input, segregated_input, motifs, genome_build, + reference_index = 1, workers = 1 ) label_colours <- c("red", "cyan") - plt <- plot_enrichment_individual( + plt <- MotifPeeker:::plot_enrichment_individual( input, enrichment_df, comparison_i = 2, motif_i = 1, - label_colours = label_colours, reference_index = 1, html_tags = FALSE + label_colours = label_colours, reference_index = 1, + html_tags = FALSE ) print(plt) } diff --git a/man/pretty_number.Rd b/man/pretty_number.Rd index f0b5d42..b2aa4a5 100644 --- a/man/pretty_number.Rd +++ b/man/pretty_number.Rd @@ -20,7 +20,7 @@ Format raw numbers to more readable strings. For example, 1000 will be converted to "1K". Supported suffixes are "K", "M", and "B". } \examples{ -print(pretty_number(134999)) +print(MotifPeeker:::pretty_number(134999)) } \keyword{internal} diff --git a/man/random_string.Rd b/man/random_string.Rd index 705df46..43fa980 100644 --- a/man/random_string.Rd +++ b/man/random_string.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/random_string.R +% Please edit documentation in R/utilities.R \name{random_string} \alias{random_string} \title{Generate a random string} diff --git a/man/report_command.Rd b/man/report_command.Rd index b1a662d..68f3785 100644 --- a/man/report_command.Rd +++ b/man/report_command.Rd @@ -18,7 +18,7 @@ Reconstruct the \code{\link{MotifPeeker}} command from the parameters used to generate the HTML report. } \examples{ -report_command(params = list( +MotifPeeker:::report_command(params = list( alignment_files = c("file1.bam", "file2.bam"), exp_labels = c("exp1", "exp2"), genome_build = "hg19")) diff --git a/man/report_header.Rd b/man/report_header.Rd index 8573c18..203d35e 100644 --- a/man/report_header.Rd +++ b/man/report_header.Rd @@ -17,7 +17,7 @@ Generate a header for \link[MotifPeeker]{MotifPeeker} reports generated using the \emph{MotifPeeker.Rmd} template. } \examples{ -report_header() +MotifPeeker:::report_header() } \keyword{internal} diff --git a/man/segregate_seqs.Rd b/man/segregate_seqs.Rd index d811833..656d39c 100644 --- a/man/segregate_seqs.Rd +++ b/man/segregate_seqs.Rd @@ -47,4 +47,3 @@ print(res) \seealso{ \link[GenomicRanges]{findOverlaps} } -\keyword{internal} diff --git a/man/to_plotly.Rd b/man/to_plotly.Rd index cd7548f..56aa6ae 100644 --- a/man/to_plotly.Rd +++ b/man/to_plotly.Rd @@ -39,7 +39,7 @@ Convert ggplot2 objects to plotly \examples{ x <- data.frame(a = c(1,2,3), b = c(2,3,4)) p <- ggplot2::ggplot(x, ggplot2::aes(x = a, y = b)) + ggplot2::geom_point() -to_plotly(p, html_tags = FALSE) +MotifPeeker:::to_plotly(p, html_tags = FALSE) } \seealso{ diff --git a/man/trim_seqs.Rd b/man/trim_seqs.Rd index 8bac5b4..356f5ed 100644 --- a/man/trim_seqs.Rd +++ b/man/trim_seqs.Rd @@ -32,7 +32,7 @@ data("CTCF_TIP_peaks", package = "MotifPeeker") peaks <- CTCF_TIP_peaks genome_build <- BSgenome.Hsapiens.UCSC.hg38::BSgenome.Hsapiens.UCSC.hg38 -trimmed_seqs <- trim_seqs(peaks, peak_width = 100, +trimmed_seqs <- MotifPeeker:::trim_seqs(peaks, peak_width = 100, genome_build = genome_build) summary(GenomicRanges::width(trimmed_seqs)) diff --git a/tests/testthat/test-bpapply.R b/tests/testthat/test-bpapply.R index 8c767e1..850dc2f 100644 --- a/tests/testthat/test-bpapply.R +++ b/tests/testthat/test-bpapply.R @@ -7,20 +7,21 @@ test_that("bpapply works", { x <- y <- seq_len(10) ### Non-existent apply_fun ### - expect_error(bpapply(x, test_func, apply_fun = "does_not_exist")) + expect_error(MotifPeeker:::bpapply(x, test_func, + apply_fun = "does_not_exist")) ### bplapply ### - res <- bpapply(x, test_func, workers = 2) + res <- MotifPeeker:::bpapply(x, test_func, workers = 2) expect_equal(unlist(res), x) ### SnowParam ### - res <- bpapply(x, test_func, workers = 1, force_snowparam = TRUE, - progressbar = FALSE) + res <- MotifPeeker:::bpapply(x, test_func, workers = 1, + force_snowparam = TRUE, progressbar = FALSE) expect_equal(unlist(res), x) ### bpmapply ### - res <- bpapply(x, test_func, apply_fun = BiocParallel::bpmapply, - workers = 2, MoreArgs = list(arg2 = y), - progressbar = FALSE) + res <- MotifPeeker:::bpapply(x, test_func, + apply_fun = BiocParallel::bpmapply, workers = 2, + MoreArgs = list(arg2 = y), progressbar = FALSE) expect_equal(res[1,2], 3) }) From 406f4aecc478d9141ebaae75d92ed78cb0374c2a Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 13:48:14 +0100 Subject: [PATCH 05/13] Remove paste in warning message --- R/filter_repeats.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/filter_repeats.R b/R/filter_repeats.R index 31f42c5..0873c0c 100644 --- a/R/filter_repeats.R +++ b/R/filter_repeats.R @@ -17,8 +17,7 @@ filter_repeats <- function(motifs, filter_n = 6) { if (is.null(filter_n) || filter_n < 1) return(motifs) if (filter_n < 4) { - warn_msg <- paste("It is not recommended to filter out motifs with", - "less than 4 consecutive nucleotide repeats.") + warn_msg <- "It is not recommended to filter out motifs with less than 4 consecutive nucleotide repeats." warning(warn_msg) } From c69ef7fab384c7710d966744420b9b4300946add Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 14:06:25 +0100 Subject: [PATCH 06/13] Remove install_github() --- vignettes/MotifPeeker.Rmd | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/vignettes/MotifPeeker.Rmd b/vignettes/MotifPeeker.Rmd index 4cb3643..00165b3 100644 --- a/vignettes/MotifPeeker.Rmd +++ b/vignettes/MotifPeeker.Rmd @@ -100,13 +100,9 @@ cpan install XML::Parser ``` For more information, refer to the [Perl dependency section of the MEME suite](https://meme-suite.org/meme/doc/install.html#prereq_perl). -Once the MEME suite and its associated Perl dependencies are installed, the -latest development version of `MotifPeeker` can be installed using the following -code: +Once the MEME suite and its associated Perl dependencies are installed, install +and load `MotifPeeker`: ```{r, eval = FALSE} -if(!require("remotes")) install.packages("remotes") - -remotes::install_github("neurogenomics/MotifPeeker") library(MotifPeeker) ``` From 1210b863c6aaeaae03724a548a637ca42233a9dd Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 14:15:28 +0100 Subject: [PATCH 07/13] Add option to continue execution if MEME install is not detected --- NEWS.md | 1 + R/utilities.R | 13 ++++++++++--- man/confirm_meme_install.Rd | 4 +++- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index a75e928..2d8c8f5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ * Replace `magrittr` import by `dplyr::%>%`. * Reduce the number of exported functions. * Move utility functions to 'utilities.R'. +* Allow vignettes to run without MEME suite installed. # MotifPeeker 0.99.4 diff --git a/R/utilities.R b/R/utilities.R index 604c43d..cb3f22a 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -191,6 +191,7 @@ check_dep <- function(pkg, fatal = TRUE, custom_msg = NULL){ #' Stop if MEME suite is not installed #' +#' @param continue Continue code execution if MEME suite is not installed. #' @inheritParams memes::runFimo #' #' @importFrom memes meme_is_installed @@ -200,8 +201,8 @@ check_dep <- function(pkg, fatal = TRUE, custom_msg = NULL){ #' @seealso \code{\link[memes]{check_meme_install}} #' #' @keywords internal -confirm_meme_install <- function(meme_path = NULL) { - stp_msg <- paste( +confirm_meme_install <- function(meme_path = NULL, continue = FALSE) { + msg <- paste( "Cannot find MEME suite installation. If installed, try setting the", "path", shQuote("MEME_BIN"), "environment varaible, or use the", shQuote("meme_path"), "parameter in the MotifPeeker function call.", @@ -210,8 +211,14 @@ confirm_meme_install <- function(meme_path = NULL) { ) if (!memes::meme_is_installed(meme_path)) { - stopper(stp_msg) + if (continue) { + messager(msg) + return(FALSE) + } else { + stopper(msg) + } } + return(TRUE) } #' Generate a random string diff --git a/man/confirm_meme_install.Rd b/man/confirm_meme_install.Rd index 68b7140..f7bc783 100644 --- a/man/confirm_meme_install.Rd +++ b/man/confirm_meme_install.Rd @@ -4,11 +4,13 @@ \alias{confirm_meme_install} \title{Stop if MEME suite is not installed} \usage{ -confirm_meme_install(meme_path = NULL) +confirm_meme_install(meme_path = NULL, continue = FALSE) } \arguments{ \item{meme_path}{path to \verb{meme/bin/} (optional). Defaut: \code{NULL}, searches "MEME_PATH" environment variable or "meme_path" option for path to "meme/bin/".} + +\item{continue}{Continue code execution if MEME suite is not installed.} } \value{ Null From 008c2cefa8e28bb8d1e0357c058555e3391ac8f2 Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 14:27:57 +0100 Subject: [PATCH 08/13] Allow run without MEME suite installed --- vignettes/MotifPeeker.Rmd | 40 ++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/vignettes/MotifPeeker.Rmd b/vignettes/MotifPeeker.Rmd index 00165b3..710c2af 100644 --- a/vignettes/MotifPeeker.Rmd +++ b/vignettes/MotifPeeker.Rmd @@ -186,25 +186,27 @@ The report can be generated by using the main function `MotifPeeker()`. For more run customisations, refer to the next sections. ```{r run-motifpeeker} -MotifPeeker( - peak_files = peak_files, - reference_index = 2, # Set TIP-seq experiment as reference - alignment_files = alignment_files, - exp_labels = c("ChIP", "TIP"), - exp_type = c("chipseq", "tipseq"), - genome_build = "hg38", # Use hg38 genome build - motif_files = motif_files, - cell_counts = NULL, # No cell-count information - denovo_motif_discovery = TRUE, - denovo_motifs = 3, # Discover top 3 motifs - motif_db = NULL, # Use default motif database (JASPAR) - download_buttons = TRUE, - out_dir = tempdir(), # Save output in a temporary directory - workers = 2, # Use two CPU cores on a 16GB RAM machine - debug = FALSE, - quiet = TRUE, - verbose = TRUE -) +if (MotifPeeker:::confirm_meme_install(continue = TRUE)) { + MotifPeeker( + peak_files = peak_files, + reference_index = 2, # Set TIP-seq experiment as reference + alignment_files = alignment_files, + exp_labels = c("ChIP", "TIP"), + exp_type = c("chipseq", "tipseq"), + genome_build = "hg38", # Use hg38 genome build + motif_files = motif_files, + cell_counts = NULL, # No cell-count information + denovo_motif_discovery = TRUE, + denovo_motifs = 3, # Discover top 3 motifs + motif_db = NULL, # Use default motif database (JASPAR) + download_buttons = TRUE, + out_dir = tempdir(), # Save output in a temporary directory + workers = 2, # Use two CPU cores on a 16GB RAM machine + debug = FALSE, + quiet = TRUE, + verbose = TRUE + ) +} ``` ### Required Inputs From 553e1a06d6375525bb96c571c9bae46f1fb255e6 Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Mon, 21 Oct 2024 15:15:47 +0100 Subject: [PATCH 09/13] Remove stopper() wrapper --- NEWS.md | 1 + R/MotifPeeker.R | 8 ++++---- R/bpapply.R | 2 +- R/check_ENCODE.R | 4 ++-- R/check_genome_build.R | 2 +- R/dt_enrichment_individual.R | 2 +- R/plot_enrichment_individual.R | 2 +- R/read_motif_file.R | 2 +- R/read_peak_file.R | 2 +- R/save_peak_file.R | 2 +- R/stopper.R | 19 ------------------- R/utilities.R | 6 +++--- inst/markdown/MotifPeeker.Rmd | 2 +- man/stopper.Rd | 21 --------------------- tests/testthat/test-stopper.R | 6 ------ 15 files changed, 18 insertions(+), 63 deletions(-) delete mode 100644 R/stopper.R delete mode 100644 man/stopper.Rd delete mode 100644 tests/testthat/test-stopper.R diff --git a/NEWS.md b/NEWS.md index 2d8c8f5..59de503 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ * Reduce the number of exported functions. * Move utility functions to 'utilities.R'. * Allow vignettes to run without MEME suite installed. +* Remove `stopper()` wrapper around `stop()`. # MotifPeeker 0.99.4 diff --git a/R/MotifPeeker.R b/R/MotifPeeker.R index 9582bb9..e55a042 100644 --- a/R/MotifPeeker.R +++ b/R/MotifPeeker.R @@ -207,18 +207,18 @@ MotifPeeker <- function( len_alignment_files <- if (is.list(alignment_files)) length(alignment_files) else 1 if (len_peak_files != len_alignment_files) { - stopper(stp_msg) + stop(stp_msg) } } if (!is.null(cell_counts) && length(cell_counts) != length(peak_files)) { stp_msg <- paste0("Length of ", shQuote("cell_counts"), " must be ", "equal to ", shQuote("peak_files"), ".") - stopper(stp_msg) + stop(stp_msg) } if (denovo_motif_discovery && (is.null(denovo_motifs) || denovo_motifs < 1)) { stp_msg <- "Number of de-novo motifs to find must be greater than 0." - stopper(stp_msg) + stop(stp_msg) } ### Check duplicate labels ### @@ -233,7 +233,7 @@ MotifPeeker <- function( ### Create output folder ### if (!dir.exists(out_dir)) { stp_msg <- "Output directory does not exist." - stopper(stp_msg) + stop(stp_msg) } out_dir <- file.path( out_dir, diff --git a/R/bpapply.R b/R/bpapply.R index 3ad7649..12bfe05 100644 --- a/R/bpapply.R +++ b/R/bpapply.R @@ -36,7 +36,7 @@ bpapply <- function( stp_msg <- paste("Supplied apply_fun is not a valid BiocParallel function.") apply_fun_package <- attr(apply_fun, "package") if (length(apply_fun_package) == 0 || - apply_fun_package != "BiocParallel") stopper(stp_msg) + apply_fun_package != "BiocParallel") stop(stp_msg) BPPARAM <- get_bpparam(workers = workers, progressbar = progressbar, diff --git a/R/check_ENCODE.R b/R/check_ENCODE.R index ae1426b..71b61b8 100644 --- a/R/check_ENCODE.R +++ b/R/check_ENCODE.R @@ -38,14 +38,14 @@ check_ENCODE <- function(encode_id, expect_format, verbose = FALSE) { if (!grepl(id_pattern, json_data$accession) || is.null(json_data$href)) { stp_msg <- paste("Error downloading ENCODE JSON data.", "Check if ID is correct and leads to a file.") - stopper(stp_msg) + stop(stp_msg) } ext <- basename(tools::file_ext(json_data$href)) if (!ext %in% expect_format) { stp_msg <- paste0("Error downloading file from ENCODE.\n", "Expected file format: ", expect_format, " but got: ", ext) - stopper(stp_msg) + stop(stp_msg) } ### Fetch file ### diff --git a/R/check_genome_build.R b/R/check_genome_build.R index f985cc7..4d3f72b 100644 --- a/R/check_genome_build.R +++ b/R/check_genome_build.R @@ -34,5 +34,5 @@ check_genome_build <- function(genome_build) { ". ", "Try passing a BSgenome object." ) - stopper(stp_msg) + stop(stp_msg) } diff --git a/R/dt_enrichment_individual.R b/R/dt_enrichment_individual.R index 4c5144b..dec544c 100644 --- a/R/dt_enrichment_individual.R +++ b/R/dt_enrichment_individual.R @@ -15,7 +15,7 @@ dt_enrichment_individual <- function(result, motif_i, reference_index = 1) { stp_msg <- "reference_index cannot be the same as comparison_i." - if (reference_index == comparison_i) stopper(stp_msg) + if (reference_index == comparison_i) stop(stp_msg) ref_label <- result$exp_labels[reference_index] comp_label <- result$exp_labels[comparison_i] diff --git a/R/plot_enrichment_individual.R b/R/plot_enrichment_individual.R index 5e70b9f..e4092f8 100644 --- a/R/plot_enrichment_individual.R +++ b/R/plot_enrichment_individual.R @@ -71,7 +71,7 @@ plot_enrichment_individual <- function(result, reference_index = 1, html_tags = TRUE) { stp_msg <- "reference_index cannot be the same as comparison_i." - if (reference_index == comparison_i) stopper(stp_msg) + if (reference_index == comparison_i) stop(stp_msg) ref_label <- result$exp_labels[reference_index] comp_label <- result$exp_labels[comparison_i] diff --git a/R/read_motif_file.R b/R/read_motif_file.R index a07bfa9..73b6b3b 100644 --- a/R/read_motif_file.R +++ b/R/read_motif_file.R @@ -61,7 +61,7 @@ read_motif_file <- function(motif_file, if (!file_format %in% names(read_functions)) { stp_msg <- paste("Unsupported file format. The motif file must be one", "of homer, jaspar, meme, transfac or uniprobe.") - stopper(stp_msg) + stop(stp_msg) } read_function <- read_functions[[file_format]] motif <- read_function(motif_file) diff --git a/R/read_peak_file.R b/R/read_peak_file.R index 55defe3..68f3ce2 100644 --- a/R/read_peak_file.R +++ b/R/read_peak_file.R @@ -54,7 +54,7 @@ read_peak_file <- function(peak_file, file_format = "auto", verbose = FALSE) { ". Please provide a valid file format", "(MACS2/3 narrowPeak, or SEACR BED)." ) - stopper(stp_msg) + stop(stp_msg) } messager( "Auto-inferred peak file format as", diff --git a/R/save_peak_file.R b/R/save_peak_file.R index 2842123..27d920b 100644 --- a/R/save_peak_file.R +++ b/R/save_peak_file.R @@ -46,7 +46,7 @@ save_peak_file <- function(peak_obj, ## Verify peak_obj columns x <- data.frame(peak_obj) if (!all(c("seqnames", "start", "end", "name") %in% colnames(x))) { - stopper("peak_obj must have columns: seqnames, start, end, name.") + stop("peak_obj must have columns: seqnames, start, end, name.") } names(x)[names(x) == "seqnames"] <- "chr" diff --git a/R/stopper.R b/R/stopper.R deleted file mode 100644 index 12acdd1..0000000 --- a/R/stopper.R +++ /dev/null @@ -1,19 +0,0 @@ -#' Stop messages -#' -#' Conditionally print stop messages. -#' Allows developers to easily control verbosity of functions, -#' and meet Bioconductor requirements that dictate the stop message -#' must first be stored to a variable before passing to \link[base]{stop}. -#' @param v Whether to print messages or not. -#' -#' @return Null -#' -#' @keywords internal -stopper <- function(..., v = TRUE) { - msg <- paste(...) - if (v) { - stop(msg) - } else { - stop() - } -} diff --git a/R/utilities.R b/R/utilities.R index cb3f22a..e648314 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -159,7 +159,7 @@ check_duplicates <- function(x) { stp_msg <- paste("Duplicated items found in the label list. Please input", "unique experiment and motif labels.") if (any(duplicated(x))) { - stopper(stp_msg) + stop(stp_msg) } } @@ -182,7 +182,7 @@ check_dep <- function(pkg, fatal = TRUE, custom_msg = NULL){ } if (!requireNamespace(pkg, quietly = TRUE)) { if (fatal) { - stopper(custom_msg) + stop(custom_msg) } else { warning(custom_msg) } @@ -215,7 +215,7 @@ confirm_meme_install <- function(meme_path = NULL, continue = FALSE) { messager(msg) return(FALSE) } else { - stopper(msg) + stop(msg) } } return(TRUE) diff --git a/inst/markdown/MotifPeeker.Rmd b/inst/markdown/MotifPeeker.Rmd index 974737b..bc307f3 100644 --- a/inst/markdown/MotifPeeker.Rmd +++ b/inst/markdown/MotifPeeker.Rmd @@ -263,7 +263,7 @@ if (!alignment_metrics) { } else { if (length(result$alignments) != length(result$peaks)) { stp_msg <- "Number of alignment files and peak files do not match." - stopper(stp_msg) + stop(stp_msg) } cat("\n### By Experiment Type {- .unlisted} \n") frip_exp_plot <- frip_df %>% diff --git a/man/stopper.Rd b/man/stopper.Rd deleted file mode 100644 index ceb98f3..0000000 --- a/man/stopper.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stopper.R -\name{stopper} -\alias{stopper} -\title{Stop messages} -\usage{ -stopper(..., v = TRUE) -} -\arguments{ -\item{v}{Whether to print messages or not.} -} -\value{ -Null -} -\description{ -Conditionally print stop messages. -Allows developers to easily control verbosity of functions, - and meet Bioconductor requirements that dictate the stop message - must first be stored to a variable before passing to \link[base]{stop}. -} -\keyword{internal} diff --git a/tests/testthat/test-stopper.R b/tests/testthat/test-stopper.R deleted file mode 100644 index b6d3039..0000000 --- a/tests/testthat/test-stopper.R +++ /dev/null @@ -1,6 +0,0 @@ -test_that("stopper works", { - - msg <- "You have encountered an error" - testthat::expect_error(stopper(msg = msg)) - testthat::expect_error(stopper(msg = msg, v=FALSE)) -}) From 3e6865bacaa0cb2d49ab774936b0d7c899e10e45 Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Tue, 22 Oct 2024 10:25:22 +0100 Subject: [PATCH 10/13] Use message() for parallel executions in messager() --- NEWS.md | 1 + R/motif_enrichment.R | 4 ++-- R/summit_to_motif.R | 2 +- R/utilities.R | 16 ++-------------- man/messager.Rd | 5 +---- tests/testthat/test-messager.R | 9 ++------- 6 files changed, 9 insertions(+), 28 deletions(-) diff --git a/NEWS.md b/NEWS.md index 59de503..3fdee83 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,7 @@ * Move utility functions to 'utilities.R'. * Allow vignettes to run without MEME suite installed. * Remove `stopper()` wrapper around `stop()`. +* Use message() for parallel executions # MotifPeeker 0.99.4 diff --git a/R/motif_enrichment.R b/R/motif_enrichment.R index 7acda6f..d0eb089 100644 --- a/R/motif_enrichment.R +++ b/R/motif_enrichment.R @@ -56,7 +56,7 @@ motif_enrichment <- function(peak_input, ## Handle empty input if (length(peak_input) == 0) { messager("No peaks detected in input for motif_enrichment.", - "Returning empty result.", v = verbose, parallel = TRUE) + "Returning empty result.", v = verbose) return(empty_result) } @@ -74,7 +74,7 @@ motif_enrichment <- function(peak_input, ## Handle zero enrichment if (is.null(ame_out)) { messager("No peaks were enriched for the input motif.", - "Returning empty result.", v = verbose, parallel = TRUE) + "Returning empty result.", v = verbose) return(empty_result) } diff --git a/R/summit_to_motif.R b/R/summit_to_motif.R index 896e481..daf2a2d 100644 --- a/R/summit_to_motif.R +++ b/R/summit_to_motif.R @@ -65,7 +65,7 @@ summit_to_motif <- function(peak_input, ## p-value calculation for desired fp_rate fimo_threshold <- fp_rate / (2 * mean(GenomicRanges::width(peaks))) messager("The p-value threshold for motif scanning with FIMO is", - fimo_threshold, v = verbose, parallel = TRUE) + fimo_threshold, v = verbose) fimo_df <- memes::runFimo(sequences = peak_sequences, motifs = motif, bfile = bfile, diff --git a/R/utilities.R b/R/utilities.R index e648314..24cfefe 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -102,25 +102,13 @@ format_exptype <- function(exp_type) { #' #' #' @param v Whether to print messages or not. -#' @param parallel Whether to enable message print when wrapped -#' in parallelised functions. #' #' @return Null #' #' @keywords internal -messager <- function(..., - v = Sys.getenv("VERBOSE") != "FALSE", - parallel = TRUE) { +messager <- function(..., v = Sys.getenv("VERBOSE") != "FALSE") { msg <- paste(...) - - message_parallel <- function(...) { - system2("echo", args = paste0(..., collpase = "")) - } - if(isTRUE(parallel)){ - if(v) try({message_parallel(msg)}) - } else { - if (v) try({message(msg)}) - } + if (v) try({message(msg)}) } #' Check, add and access files in cache diff --git a/man/messager.Rd b/man/messager.Rd index f3733b5..ee2924f 100644 --- a/man/messager.Rd +++ b/man/messager.Rd @@ -4,13 +4,10 @@ \alias{messager} \title{Print messages} \usage{ -messager(..., v = Sys.getenv("VERBOSE") != "FALSE", parallel = TRUE) +messager(..., v = Sys.getenv("VERBOSE") != "FALSE") } \arguments{ \item{v}{Whether to print messages or not.} - -\item{parallel}{Whether to enable message print when wrapped -in parallelised functions.} } \value{ Null diff --git a/tests/testthat/test-messager.R b/tests/testthat/test-messager.R index b646ef5..2af5d64 100644 --- a/tests/testthat/test-messager.R +++ b/tests/testthat/test-messager.R @@ -2,12 +2,7 @@ test_that("messager works", { msg <- "Hello world" #### Parallel = FALSE #### - msg_out <- utils::capture.output(messager(msg, parallel = FALSE), - type = "message") + msg_out <- utils::capture.output(messager(msg), + type = "message") testthat::expect_equal(msg, msg_out) - #### Parallel = TRUE #### - f <- textConnection("test3", "w") - msg_out2 <- utils::capture.output(messager(msg, parallel = TRUE), - type = "message") - testthat::expect_equal(msg_out2, character()) }) From 6b508851a1834ae2bef75037c3bd3c4b197ee10d Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Tue, 22 Oct 2024 10:45:33 +0100 Subject: [PATCH 11/13] Replace @return with @returns --- R/get_df_distances.R | 2 +- R/to_plotly.R | 2 +- R/utilities.R | 12 ++++++------ README.md | 2 +- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/get_df_distances.R b/R/get_df_distances.R index 5ab197d..1a8c48d 100644 --- a/R/get_df_distances.R +++ b/R/get_df_distances.R @@ -26,7 +26,7 @@ #' #' @importFrom purrr map_df #' -#' @return A \code{data.frame} with the following columns: +#' @returns A \code{data.frame} with the following columns: #' \describe{ #' \item{exp_label}{Experiment labels.} #' \item{exp_type}{Experiment types.} diff --git a/R/to_plotly.R b/R/to_plotly.R index c7c04bd..c2c67a0 100644 --- a/R/to_plotly.R +++ b/R/to_plotly.R @@ -9,7 +9,7 @@ #' @importFrom plotly ggplotly #' @importFrom htmltools tagList #' -#' @return A \code{plotly} object. +#' @returns A \code{plotly} object. #' #' @examples #' x <- data.frame(a = c(1,2,3), b = c(2,3,4)) diff --git a/R/utilities.R b/R/utilities.R index 24cfefe..7204ff0 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -6,7 +6,7 @@ #' @param x A number. #' @param decimal_digits Number of decimal digits to round to. #' -#' @return A character string of the formatted number. \code{NA} is returned as +#' @returns A character string of the formatted number. \code{NA} is returned as #' "NA". #' #' @examples @@ -45,7 +45,7 @@ pretty_number <- function(x, decimal_digits = 2) { #' @examples #' seq_len(10) %>% sum #' -#' @return The result of calling `rhs(lhs)`. +#' @returns The result of calling `rhs(lhs)`. NULL #' Format exp_type @@ -64,7 +64,7 @@ NULL #' } #' Any item not mentioned above will be returned as-is. #' -#' @return A character vector of formatted exp_type. +#' @returns A character vector of formatted exp_type. #' #' @examples #' MotifPeeker:::format_exptype("chipseq") @@ -103,7 +103,7 @@ format_exptype <- function(exp_type) { #' #' @param v Whether to print messages or not. #' -#' @return Null +#' @returns Null #' #' @keywords internal messager <- function(..., v = Sys.getenv("VERBOSE") != "FALSE") { @@ -160,7 +160,7 @@ check_duplicates <- function(x) { #' package is not attached. #' @param custom_msg a custom message to display if the package is not attached. #' -#' @return Null +#' @returns Null #' #' @keywords internal check_dep <- function(pkg, fatal = TRUE, custom_msg = NULL){ @@ -226,7 +226,7 @@ random_string <- function(length) { #' #' @param path_list A list of paths. #' -#' @return A list of normalised paths or the input as is if contents are not +#' @returns A list of normalised paths or the input as is if contents are not #' a character. #' #' @keywords internal diff --git a/README.md b/README.md index 6cb9f22..3ff401c 100644 --- a/README.md +++ b/README.md @@ -18,7 +18,7 @@ status](https://github.com/neurogenomics/MotifPeeker/workflows/rworkflows/badge. **Authors:** ***Hiranyamaya (Hiru) Dash, Thomas Roberts, Nathan Skene*** -**Updated:** ***Oct-21-2024*** +**Updated:** ***Oct-22-2024*** ## Introduction From c99577cfa48c79bcdca26002cbb4070760ee7473 Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Tue, 22 Oct 2024 10:58:32 +0100 Subject: [PATCH 12/13] Refactor with switch statement --- R/download_button.R | 58 ++++++++++++--------------- tests/testthat/test-download_button.R | 4 ++ 2 files changed, 29 insertions(+), 33 deletions(-) diff --git a/R/download_button.R b/R/download_button.R index e024ece..7eef6ce 100644 --- a/R/download_button.R +++ b/R/download_button.R @@ -27,37 +27,29 @@ download_button <- function(path, icon = "fa fa-save", add_button = TRUE, ...) { - if (add_button) { - wrn_msg <- paste("Package", shQuote("downloadthis"), "is required to", - "add download buttons to the HTML report. Skipping", - "download buttons...") - check_dep("downloadthis", fatal = FALSE, custom_msg = wrn_msg) - - type <- tolower(type) - if (type == "dir") { - btn <- downloadthis::download_dir( - path = path, - output_name = output_name, - button_label = button_label, - button_type = button_type, - has_icon = has_icon, - icon = icon, - self_contained = TRUE - ) - } else if (type == "file") { - btn <- downloadthis::download_file( - path = path, - output_name = output_name, - button_label = button_label, - button_type = button_type, - has_icon = has_icon, - icon = icon, - self_contained = TRUE - ) - } - - return(btn) - } else { - return(invisible()) - } + if (!add_button) return(invisible()) + + wrn_msg <- paste("Package", shQuote("downloadthis"), "is required to", + "add download buttons to the HTML report. Skipping", + "download buttons...") + check_dep("downloadthis", fatal = FALSE, custom_msg = wrn_msg) + + btn_args <- list( + path = path, + output_name = output_name, + button_label = button_label, + button_type = button_type, + has_icon = has_icon, + icon = icon, + self_contained = TRUE + ) + + type <- tolower(type) + btn <- switch( + type, + "dir" = do.call(downloadthis::download_dir, btn_args), + "file" = do.call(downloadthis::download_file, btn_args) + ) + + return(btn) } diff --git a/tests/testthat/test-download_button.R b/tests/testthat/test-download_button.R index b9379ab..661686d 100644 --- a/tests/testthat/test-download_button.R +++ b/tests/testthat/test-download_button.R @@ -6,4 +6,8 @@ test_that("download_button works", { type = "file", button_label = "Download Peaks") expect_true(grepl("button", btn)) + expect_invisible(download_button(out, type = "file", + button_label = "Download Peaks", + add_button = FALSE)) }) + From c224027b368cd8438493e7e41ef7ec75127e2f14 Mon Sep 17 00:00:00 2001 From: HDash <16350928+HDash@users.noreply.github.com> Date: Tue, 22 Oct 2024 11:25:07 +0100 Subject: [PATCH 13/13] Refactor code to only use grep --- R/filter_repeats.R | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/R/filter_repeats.R b/R/filter_repeats.R index 0873c0c..8a45a0f 100644 --- a/R/filter_repeats.R +++ b/R/filter_repeats.R @@ -22,14 +22,7 @@ filter_repeats <- function(motifs, filter_n = 6) { } repeat_pattern <- paste0("([A-Z])\\1{", filter_n - 1, ",}") - good_motif_indices <- vapply(seq_along(motifs$consensus), function(i) { - if (!grepl(repeat_pattern, motifs$consensus[i])) { - return(i) - } else { - return(-1) - } - }, numeric(1)) - good_motif_indices <- good_motif_indices[good_motif_indices != -1] + good_motif_indices <- grep(repeat_pattern, motifs$consensus, invert = TRUE) filtered_motifs <- motifs[good_motif_indices,] return(filtered_motifs) }