fix several bugs

R/AnnotationMatrix.R

@@ -25,7 +25,8 @@ NULL
 #'   \code{rowRanges}, the annotation matrix in the \code{annotations}
 #'   assay, and the per-annotation table in \code{colData}. Subsetting works
 #'   in both directions -- \code{x[i, j]} narrows SNPs and annotations
-#'   together -- and \code{\link{getBaseline}} / \code{\link{getCandidates}}
+#'   together -- and \code{\link{baselineAnnotations}} /
+#'   \code{\link{testedAnnotations}}
 #'   are column subsets rather than reconstructions.
 #' @importClassesFrom SummarizedExperiment RangedSummarizedExperiment
 #' @export
@@ -89,17 +90,10 @@ setMethod("show", "AnnotationMatrix", function(object) {
         "Continuous: {sum(meta$type == 'continuous')}\n",
         .trim = FALSE
     ))
-    cat(glue("  Genome build: {getGenome(object)}\n", .trim = FALSE))
-})
-
-#' @rdname getGenome
-#' @export
-setMethod("getGenome", "AnnotationMatrix", function(x) {
-    build <- discard(
-        unique(GenomeInfoDb::genome(SummarizedExperiment::rowRanges(x))),
-        is.na
-    )
-    if (length(build) == 0L) NA_character_ else build[[1L]]
+    cat(glue(
+        "  Genome build: {GenomeInfoDb::genome(object)}\n",
+        .trim = FALSE
+    ))
 })
 
 # =============================================================================
@@ -202,17 +196,13 @@ AnnotationMatrix <- function(
 # rows, the assay and the per-annotation table aligned, where the previous
 # implementation rebuilt the object from three separately-subset pieces.
 # @noRd
-#' @importFrom checkmate assertClass
-.annotTier <- function(annot, tier) {
-    assertClass(annot, "AnnotationMatrix")
-    annot[, SummarizedExperiment::colData(annot)$tier == tier]
+# Callers are methods dispatching on AnnotationMatrix, so the class is
+# already guaranteed here -- no assertClass.
+.annotTier <- function(x, tier) {
+    x[, SummarizedExperiment::colData(x)$tier == tier]
 }
 
-#' @title Get Baseline Annotations
-#' @description Extract only baseline-tier annotations from an
-#'   \code{AnnotationMatrix}.
-#' @param annot An \code{AnnotationMatrix} object.
-#' @return An \code{AnnotationMatrix} with only baseline annotations.
+#' @rdname baselineAnnotations
 #' @examples
 #' snpRanges <- GenomicRanges::GRanges(
 #'   "22", IRanges::IRanges((1:10) * 100, width = 1))
@@ -221,17 +211,13 @@ AnnotationMatrix <- function(
 #' meta <- data.frame(name = paste0("annot", 1:5), tier = "baseline",
 #'   type = "binary")
 #' am <- AnnotationMatrix(annotations, snpRanges, annotationMeta = meta)
-#' getBaseline(am)
+#' baselineAnnotations(am)
 #' @export
-getBaseline <- function(annot) {
-    .annotTier(annot, "baseline")
-}
+setMethod("baselineAnnotations", "AnnotationMatrix", function(x) {
+    .annotTier(x, "baseline")
+})
 
-#' @title Get Candidate Annotations
-#' @description Extract only candidate-tier annotations from an
-#'   \code{AnnotationMatrix}.
-#' @param annot An \code{AnnotationMatrix} object.
-#' @return An \code{AnnotationMatrix} with only candidate annotations.
+#' @rdname testedAnnotations
 #' @examples
 #' snpRanges <- GenomicRanges::GRanges(
 #'   "22", IRanges::IRanges((1:10) * 100, width = 1))
@@ -240,8 +226,8 @@ getBaseline <- function(annot) {
 #' meta <- data.frame(name = paste0("annot", 1:5),
 #'   tier = c(rep("baseline", 3), rep("candidate", 2)), type = "binary")
 #' am <- AnnotationMatrix(annotations, snpRanges, annotationMeta = meta)
-#' getCandidates(am)
+#' testedAnnotations(am)
 #' @export
-getCandidates <- function(annot) {
-    .annotTier(annot, "candidate")
-}
+setMethod("testedAnnotations", "AnnotationMatrix", function(x) {
+    .annotTier(x, "candidate")
+})

R/ColocBoostResult.R

@@ -23,8 +23,8 @@
 #
 # What the two DO share is the LD panel they were computed against and the
 # projection surface, so both extend ColocResultBase -- which carries the
-# ldSketch slot and its accessor -- and both answer getColocPairs() and
-# getColocVariants().
+# ldSketch slot and its accessor -- and both answer colocPairs() and
+# colocVariants().
 #
 #   element      the member variants of one CoS
 #   inner mcols  per-variant: vcp
@@ -44,8 +44,8 @@ NULL
 
 #' @title ColocBoost Result
 #' @description A collection of ColocBoost results, one element per confidence
-#'   set (CoS). Project it with \code{\link{getColocPairs}},
-#'   \code{\link{getColocVariants}} or \code{\link{getColocBoostOutcomes}}.
+#'   set (CoS). Project it with \code{\link{colocPairs}},
+#'   \code{\link{colocVariants}} or \code{\link{colocBoostOutcomes}}.
 #' @slot outcomeInfo A data frame mapping each outcome \code{name} to its
 #'   \code{study}, \code{context}, \code{trait} and \code{dataForm}. ColocBoost
 #'   is given outcome names as bare labels, and those labels are lossy -- a
@@ -220,7 +220,7 @@ setMethod("show", "ColocBoostResult", function(object) {
 #' # Its unit is a SET of colocalized outcomes rather than a pair, so one row
 #' # can carry any number of them.
 #' colocboostResultExample$outcomes
-#' getColocPairs(colocboostResultExample)$nOutcomes
+#' colocPairs(colocboostResultExample)$nOutcomes
 #' # A run that failed or was not requested arrives as NULL and is skipped,
 #' # giving an empty result rather than an error.
 #' nrow(ColocBoostResult(list(NULL), "xqtl_coloc"))
@@ -405,7 +405,7 @@ ColocBoostResult <- function(
 # -- silently yields NA.
 #
 # min_abs_cor is used because that is what `minAbsCorr` means everywhere else
-# in the package (fineMappingPipeline, getColocCredibleSets).
+# in the package (fineMappingPipeline, colocCredibleSets).
 # @noRd
 .cbrPurity <- function(purity, id) {
     m <- purity$min_abs_cor
@@ -553,7 +553,7 @@ ColocBoostResult <- function(
 
 #' @rdname colocViews
 #' @export
-setMethod("getColocPairs", "ColocBoostResult", function(x) {
+setMethod("colocPairs", "ColocBoostResult", function(x) {
     # Named "pairs" for symmetry with ColocResult, but a ColocBoost row is a
     # SET, not a pair: `outcomes` holds however many outcomes colocalized.
     md <- mcols(x, use.names = FALSE)
@@ -575,7 +575,7 @@ setMethod("getColocPairs", "ColocBoostResult", function(x) {
 #' @rdname colocViews
 #' @export
 setMethod(
-    "getColocVariants",
+    "colocVariants",
     "ColocBoostResult",
     function(x, pooled = FALSE) {
         long <- .cbrLongVariants(x)
@@ -626,15 +626,15 @@ setMethod(
 #'   \code{trait} and \code{dataForm}.
 #' @examples
 #' # See colocboostPipeline(); a ColocBoostResult carries the mapping it needs.
-#' methods::existsMethod("getColocBoostOutcomes", "ColocBoostResult")
+#' methods::existsMethod("colocBoostOutcomes", "ColocBoostResult")
 #' @export
-setGeneric("getColocBoostOutcomes", function(x, ...) {
-    standardGeneric("getColocBoostOutcomes")
+setGeneric("colocBoostOutcomes", function(x, ...) {
+    standardGeneric("colocBoostOutcomes")
 })
 
-#' @rdname getColocBoostOutcomes
+#' @rdname colocBoostOutcomes
 #' @export
-setMethod("getColocBoostOutcomes", "ColocBoostResult", function(x) {
+setMethod("colocBoostOutcomes", "ColocBoostResult", function(x) {
     if (length(x) == 0L) {
         return(tibble())
     }
@@ -665,7 +665,7 @@ setMethod("getColocBoostOutcomes", "ColocBoostResult", function(x) {
 #' @title Coerce a ColocBoostResult to a data frame
 #' @description Returns the set-level view. New code should call the view it
 #'   wants (\code{\link{colocViews}},
-#'   \code{\link{getColocBoostOutcomes}}).
+#'   \code{\link{colocBoostOutcomes}}).
 #' @param x A \code{ColocBoostResult}.
 #' @param row.names,optional Ignored; present for generic compatibility.
 #' @param ... Ignored.
@@ -677,7 +677,7 @@ setMethod(
     "as.data.frame",
     "ColocBoostResult",
     function(x, row.names = NULL, optional = FALSE, ...) {
-        as.data.frame(getColocPairs(x))
+        as.data.frame(colocPairs(x))
     }
 )
 
@@ -688,31 +688,31 @@ setMethod(
 #' @param ... Ignored.
 #' @return A list of timings, empty when none were recorded.
 #' @examples
-#' methods::existsMethod("getComputingTime", "ColocBoostResult")
+#' methods::existsMethod("computingTime", "ColocBoostResult")
 #' @export
-setGeneric("getComputingTime", function(x, ...) {
-    standardGeneric("getComputingTime")
+setGeneric("computingTime", function(x, ...) {
+    standardGeneric("computingTime")
 })
 
-#' @rdname getComputingTime
+#' @rdname computingTime
 #' @export
-setMethod("getComputingTime", "ColocBoostResult", function(x) {
+setMethod("computingTime", "ColocBoostResult", function(x) {
     x@computingTime
 })
 
 #' @title Region-Wide Variant Colocalization Probabilities
 #' @description The marginal \code{vcp} for every variant in the analysed
 #'   region, not just the confidence-set members. Distinct from
-#'   \code{\link{getColocVariants}}, which reports the per-set \code{vcp} of
+#'   \code{\link{colocVariants}}, which reports the per-set \code{vcp} of
 #'   members only.
 #' @param x A \code{\linkS4class{ColocBoostResult}}.
 #' @param ... Ignored.
 #' @return A \code{GRanges} carrying a \code{vcp} column, or \code{NULL}.
 #' @examples
-#' methods::existsMethod("getRegionVcp", "ColocBoostResult")
+#' methods::existsMethod("regionVcp", "ColocBoostResult")
 #' @export
-setGeneric("getRegionVcp", function(x, ...) standardGeneric("getRegionVcp"))
+setGeneric("regionVcp", function(x, ...) standardGeneric("regionVcp"))
 
-#' @rdname getRegionVcp
+#' @rdname regionVcp
 #' @export
-setMethod("getRegionVcp", "ColocBoostResult", function(x) x@regionVcp)
+setMethod("regionVcp", "ColocBoostResult", function(x) x@regionVcp)

R/ColocResult.R

@@ -43,8 +43,8 @@ NULL
 #'   normalized posterior over an arbitrary-sized set of outcomes -- so neither
 #'   can be expressed in the other's schema. What they share is the shape (one
 #'   element per colocalization unit, its variants inside) and therefore the
-#'   projection surface: both answer \code{\link{getColocPairs}} and
-#'   \code{\link{getColocVariants}}, so code that only needs "which variants
+#'   projection surface: both answer \code{\link{colocPairs}} and
+#'   \code{\link{colocVariants}}, so code that only needs "which variants
 #'   colocalized, and how strongly" works against either.
 #' @slot ldSketch The LD reference panel the underlying fits were computed
 #'   against, or \code{NULL}. Shared by both subclasses: coloc and ColocBoost
@@ -58,17 +58,17 @@ setClass(
     prototype(ldSketch = NULL)
 )
 
-#' @rdname getLdSketch
+#' @rdname ldSketch
 #' @export
-setMethod("getLdSketch", "ColocResultBase", function(x) x@ldSketch)
+setMethod("ldSketch", "ColocResultBase", function(x) x@ldSketch)
 
 #' @title Colocalization Result
 #' @description A collection of colocalization results, one element per tested
 #'   (QTL credible set, GWAS credible set, block) pair. Build the four views
-#'   with \code{\link{getColocPairs}}, \code{\link{getColocVariants}},
-#'   \code{\link{getColocCredibleSets}} and \code{\link{getColocGenes}}.
+#'   with \code{\link{colocPairs}}, \code{\link{colocVariants}},
+#'   \code{\link{colocCredibleSets}} and \code{\link{colocGenes}}.
 #' @details The inherited \code{ldSketch} is what
-#'   \code{getColocCredibleSets()} uses to compute credible-set purity.
+#'   \code{colocCredibleSets()} uses to compute credible-set purity.
 #' @seealso \code{\link{colocPipeline}}
 #' @export
 setClass("ColocResult", contains = "ColocResultBase")
@@ -198,7 +198,7 @@ setMethod("show", "ColocResult", function(object) {
 #' @param variants A list, parallel to \code{pairs}' rows, of per-pair data
 #'   frames with a \code{variant_id} column and a \code{SNP.PP.H4} column.
 #' @param ldSketch Optional genotype panel (see \code{\link{readGenotypes}})
-#'   for the LD reference, used by \code{\link{getColocCredibleSets}} to
+#'   for the LD reference, used by \code{\link{colocCredibleSets}} to
 #'   compute purity.
 #' @return A \code{ColocResult}.
 #' @examples
@@ -331,7 +331,7 @@ ColocResult <- function(pairs, variants, ldSketch = NULL) {
 
 #' @rdname colocViews
 #' @export
-setMethod("getColocPairs", "ColocResult", function(x) {
+setMethod("colocPairs", "ColocResult", function(x) {
     md <- mcols(x, use.names = FALSE)
     if (is.null(md) || length(x) == 0L) {
         return(tibble())
@@ -341,7 +341,7 @@ setMethod("getColocPairs", "ColocResult", function(x) {
 
 #' @rdname colocViews
 #' @export
-setMethod("getColocVariants", "ColocResult", function(x, pooled = FALSE) {
+setMethod("colocVariants", "ColocResult", function(x, pooled = FALSE) {
     long <- .crLongVariants(x)
     if (!isTRUE(pooled) || nrow(long) == 0L) {
         return(long)
@@ -410,8 +410,8 @@ setMethod("getColocVariants", "ColocResult", function(x, pooled = FALSE) {
 
 #' @rdname colocViews
 #' @export
-setMethod("getColocGenes", "ColocResult", function(x) {
-    pairs <- getColocPairs(x)
+setMethod("colocGenes", "ColocResult", function(x) {
+    pairs <- colocPairs(x)
     if (nrow(pairs) == 0L) {
         return(tibble())
     }
@@ -439,7 +439,7 @@ setMethod("getColocGenes", "ColocResult", function(x) {
 #' @rdname colocViews
 #' @export
 setMethod(
-    "getColocCredibleSets",
+    "colocCredibleSets",
     "ColocResult",
     function(
         x,
@@ -461,7 +461,7 @@ setMethod(
         }
         out <- bind_rows(sets)
         .crApplyPurityFilter(
-            mutate(out, purity = .crPuritiesFor(out, getLdSketch(x))),
+            mutate(out, purity = .crPuritiesFor(out, ldSketch(x))),
             minAbsCorr
         )
     }
@@ -553,7 +553,7 @@ setMethod(
         .ldFromSketch(
             ldSketch,
             ids,
-            label = "getColocCredibleSets",
+            label = "colocCredibleSets",
             onMissing = "drop"
         ),
         error = function(cnd) NULL
@@ -607,6 +607,6 @@ setMethod(
     "as.data.frame",
     "ColocResult",
     function(x, row.names = NULL, optional = FALSE, ...) {
-        as.data.frame(getColocPairs(x))
+        as.data.frame(colocPairs(x))
     }
 )