diff --git a/DESCRIPTION b/DESCRIPTION index 98edc7f..23e81e3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,14 +39,15 @@ Imports: jsonlite, methods, patchwork, + rJava, rlang, + scales, tibble, tools, utils VignetteBuilder: knitr Suggests: knitr, - rJava, rmarkdown, testthat (>= 3.0.0) Config/testthat/edition: 3 diff --git a/R/class_all_generics.R b/R/class_all_generics.R index 347c898..ad784e7 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -375,3 +375,13 @@ setGeneric("readSamples", function(object, ...) standardGeneric("readSamples")) setGeneric("serverInfo", function(object, ...) standardGeneric("serverInfo")) +## ---- +#' @importFrom GenomeInfoDb seqnames +NULL + + +## ---- +#' @importFrom GenomeInfoDb seqnames<- +NULL + + diff --git a/R/class_phg_metrics.R b/R/class_phg_metrics.R index add8eb1..a8048a5 100644 --- a/R/class_phg_metrics.R +++ b/R/class_phg_metrics.R @@ -630,9 +630,13 @@ setMethod( ## ---- +#' @title +#' Return all contig IDs from metrics object +#' #' @param x #' A \code{PHGMetrics} object #' +#' @return A vector of unique contig IDs #' @importFrom GenomeInfoDb seqnames #' @export setMethod( @@ -662,8 +666,10 @@ setMethod( ## ---- +#' @title #' Set Sequence Names for PHGMetrics Object #' +#' @description #' This method replaces old IDs with new IDs in the `PHGMetrics` object. #' It ensures that both `metricAlign` and `metricGvcf` fields are updated #' with the new sequence names provided in the `value` data frame. @@ -711,16 +717,16 @@ setMethod( # Helper function to replace IDs replaceIds <- function(x, slot_name, field, value) { - metrics <- slot(x, slot_name) + metrics <- methods::slot(x, slot_name) if (is.null(metrics) || length(metrics) == 0) return() len <- if (is(metrics, "data.frame")) 1 else length(metrics) for (i in seq_len(len)) { oldIds <- as.character(metrics[[i]][[field]]) - replacements <- setNames(value$new_id, value$old_id) + replacements <- stats::setNames(value$new_id, value$old_id) newIds <- ifelse(oldIds %in% names(replacements), replacements[oldIds], oldIds) metrics[[i]][[field]] <- newIds } - slot(x, slot_name) <<- metrics + methods::slot(x, slot_name) <<- metrics } # Replace IDs in metricAlign if it's not NULL diff --git a/R/utils_metrics.R b/R/utils_metrics.R index b3ac9a2..a957485 100644 --- a/R/utils_metrics.R +++ b/R/utils_metrics.R @@ -243,7 +243,7 @@ metMessenger <- function( # } parseFormula <- function(formula) { # Extract the terms object from the formula - termsObj <- terms(formula) + termsObj <- stats::terms(formula) # Extract the response variables (LHS) lhsVars <- all.vars(formula[[2]]) @@ -261,7 +261,7 @@ parseFormula <- function(formula) { } # Check if keywords are used with other variables in RHS - if ("ALL" %in% lhsVars && length(rhsVars) > 1) { + if (any(keywords %in% rhsVars) && length(rhsVars) > 1) { rlang::abort(errorMsg) } diff --git a/R/vis_plot_gvcf.R b/R/vis_plot_gvcf.R index 651d7e4..aecb871 100644 --- a/R/vis_plot_gvcf.R +++ b/R/vis_plot_gvcf.R @@ -43,7 +43,7 @@ plotGvcfFromMetrics <- function(df, formula, nRow, nCol, tag) { filtGvcfMap <- GVCF_MAP[GVCF_MAP$id %in% lhsVars, ] } - if (length(filtGvcfMap) == 0) { + if (nrow(filtGvcfMap) == 0) { rlang::abort("No valid metrics found in left-hand side of equation") } diff --git a/man/seqnames-PHGMetrics-method.Rd b/man/seqnames-PHGMetrics-method.Rd new file mode 100644 index 0000000..75c4bc7 --- /dev/null +++ b/man/seqnames-PHGMetrics-method.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_metrics.R +\name{seqnames,PHGMetrics-method} +\alias{seqnames,PHGMetrics-method} +\title{Return all contig IDs from metrics object} +\usage{ +\S4method{seqnames}{PHGMetrics}(x) +} +\arguments{ +\item{x}{A \code{PHGMetrics} object} +} +\value{ +A vector of unique contig IDs +} +\description{ +Return all contig IDs from metrics object +} diff --git a/man/seqnames-set-PHGMetrics-method.Rd b/man/seqnames-set-PHGMetrics-method.Rd index 7ecb00a..858ab16 100644 --- a/man/seqnames-set-PHGMetrics-method.Rd +++ b/man/seqnames-set-PHGMetrics-method.Rd @@ -30,8 +30,8 @@ retained. \examples{ \dontrun{ newIds <- data.frame( - old_id = c("1", "2", "3"), - new_id = c("A", "B", "C") + old_id = c("old_1", "old_2", "old_3"), + new_id = c("new_01", "new_02", "new_03") ) # Assume 'met' is a PHGMetrics object diff --git a/tests/testthat/test_class_phg_metrics.R b/tests/testthat/test_class_phg_metrics.R index 139833a..1dbb0dc 100644 --- a/tests/testthat/test_class_phg_metrics.R +++ b/tests/testthat/test_class_phg_metrics.R @@ -117,6 +117,26 @@ test_that("PHGMetrics general metric ID return and update tests", { object = metricsIds(metTest), expected = c("toy_anchors_s01", "new_gvcf_id") ) + + # seqnames + expect_equal( + object = seqnames(metBase), + expected = c( + "1", "2", "3", + "Vu01", "Vu02", "Vu03", "Vu04", "Vu05", + "Vu06", "Vu07", "Vu08", "Vu09", "Vu10", + "Vu11", "contig_206", "contig_178" + ) + ) + + metTest <- metBase + expect_error(object = seqnames(metTest) <- data.frame(old_id = "error")) + expect_error(object = seqnames(metTest) <- c("another", "error")) + seqnames(metTest) <- data.frame( + old_id = c("Vu01", "Vu03", "1"), + new_id = c("CHR_NEW_01", "CHR_NEW_03", "ALGN_CHR_01") + ) + expect_true(all(c("CHR_NEW_01", "CHR_NEW_03", "ALGN_CHR_01") %in% seqnames(metTest))) }) @@ -315,11 +335,15 @@ test_that("PHGMetrics general gVCF plot tests", { metBase <- PHGMetrics(metricDir) expect_true(is(plotGvcf(metBase, metBase$toy_gvcf_metrics), "ggplot")) + expect_error(is(plotGvcf(metBase, c(metBase$toy_gvcf_metrics, metBase$toy_anchors_s01)), "ggplot")) expect_true(is(plotGvcf(metBase), "ggplot")) expect_true(is(plotGvcf(metBase, f = ALL ~ ALL), "ggplot")) expect_true(is(plotGvcf(metBase, f = ALL ~ Vu01 + Vu05), "ggplot")) + expect_true(is(plotGvcf(metBase, f = num_ns ~ Vu01 + Vu05), "ggplot")) expect_error(is(plotGvcf(metBase, f = ALL + CORE ~ ALL + Vu02), "ggplot")) expect_error(is(plotGvcf(metBase, f = CORE + num_ns ~ ALL + Vu02), "ggplot")) + expect_error(is(plotGvcf(metBase, f = num_nsss ~ ALL + Vu02), "ggplot")) + expect_error(is(plotGvcf(metBase, f = num_nsss ~ ALL), "ggplot")) })