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 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..aa91489 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,31 +2,23 @@ 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 +47,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..3fdee83 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,15 @@ +# MotifPeeker 0.99.5 + +## Miscellaneous + +* 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. +* Remove `stopper()` wrapper around `stop()`. +* Use message() for parallel executions + + # MotifPeeker 0.99.4 ## Miscellaneous 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 ece2700..12bfe05 100644 --- a/R/bpapply.R +++ b/R/bpapply.R @@ -19,10 +19,10 @@ #' 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) #' -#' @export +#' @keywords internal bpapply <- function( X, FUN, @@ -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_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/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/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/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/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/filter_repeats.R b/R/filter_repeats.R index 31f42c5..8a45a0f 100644 --- a/R/filter_repeats.R +++ b/R/filter_repeats.R @@ -17,20 +17,12 @@ 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) } 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) } 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_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/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/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/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 b71e39d..e4092f8 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) #' } @@ -61,7 +62,7 @@ #' #' @family plot functions #' -#' @export +#' @keywords internal plot_enrichment_individual <- function(result, enrichment_df, comparison_i, @@ -70,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/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/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/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/report_command.R b/R/report_command.R index dc0cece..eb06a45 100644 --- a/R/report_command.R +++ b/R/report_command.R @@ -9,13 +9,12 @@ #' \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")) #' -#' -#' @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..70a2d32 100644 --- a/R/report_header.R +++ b/R/report_header.R @@ -7,9 +7,9 @@ #' @returns Header string to be rendering within Rmarkdown file. #' #' @examples -#' report_header() +#' MotifPeeker:::report_header() #' -#' @export +#' @keywords internal report_header <- function() { paste0( "