fix more function signature issues

.Rbuildignore

@@ -10,5 +10,6 @@
 ^.claude
 ^data-raw$
 ^docs$
+^dev$
 ^air.toml
 ^inst/prototype

.github/environment/pixi.toml

@@ -32,7 +32,9 @@ r45 = {features = ["r45"]}
 "bioconductor-tidysummarizedexperiment" = "*"
 "gcc" = "*"
 "r-covr" = "*"
+"r-decor" = "*"
 "r-devtools" = "*"
+"r-goodpractice" = "*"
 "r-knitr" = "*"
 "r-lintr" = "*"
 "r-markdown" = "*"

.github/recipe/recipe.yaml

@@ -41,14 +41,14 @@ requirements:
     - r-base
     - r-bglr
     - r-bigsnpr
+    - r-checkmate
     - r-coda
     - r-coloc
     - r-colocboost
     - r-corshrink
     - r-cpp11
     - r-cpp11armadillo
     - r-ctwas
-    - r-decor
     - r-dplyr
     - r-flashier
     - r-fsusier
@@ -109,14 +109,14 @@ requirements:
     - r-base
     - r-bglr
     - r-bigsnpr
+    - r-checkmate
     - r-coda
     - r-coloc
     - r-colocboost
     - r-corshrink
     - r-cpp11
     - r-cpp11armadillo
     - r-ctwas
-    - r-decor
     - r-dplyr
     - r-flashier
     - r-fsusier

DESCRIPTION

@@ -28,6 +28,7 @@ Imports:
     BiocGenerics,
     BiocParallel,
     Biostrings,
+    checkmate,
     coloc,
     colocboost,
     DelayedArray,

NAMESPACE

@@ -457,7 +457,7 @@ importFrom(BiocParallel,
   MulticoreParam,
   bplapply,
   bpparam,
-  bpworkers
+  multicoreWorkers
 )
 importFrom(Biostrings,
   DNAStringSet,
@@ -500,6 +500,41 @@ importFrom(SummarizedExperiment,
   rowRanges
 )
 importFrom(archive,archive_read)
+importFrom(checkmate,
+  assert,
+  assertCharacter,
+  assertClass,
+  assertCount,
+  assertDataFrame,
+  assertDirectoryExists,
+  assertFileExists,
+  assertFlag,
+  assertInt,
+  assertList,
+  assertLogical,
+  assertMatrix,
+  assertMultiClass,
+  assertNames,
+  assertNumber,
+  assertNumeric,
+  assertScalar,
+  assertString,
+  assertSubset,
+  assertVector,
+  checkAtomicVector,
+  checkCharacter,
+  checkClass,
+  checkDataFrame,
+  checkFileExists,
+  checkList,
+  checkMatrix,
+  checkNames,
+  checkNull,
+  checkNumeric,
+  checkString,
+  checkSubset,
+  makeAssertCollection
+)
 importFrom(dplyr,
   across,
   add_count,
@@ -544,9 +579,12 @@ importFrom(methods,
 )
 importFrom(purrr,
   compact,
+  detect,
+  discard,
   exec,
   imap,
   keep,
+  list_assign,
   list_c,
   list_flatten,
   list_modify,
@@ -559,8 +597,12 @@ importFrom(purrr,
   map_int,
   map_lgl,
   partial,
+  possibly,
   reduce,
-  set_names
+  set_names,
+  walk,
+  walk2,
+  zap
 )
 importFrom(quadprog,solve.QP)
 importFrom(readr,
@@ -576,6 +618,7 @@ importFrom(rlang,
   arg_match,
   cnd_signal,
   inform,
+  try_fetch,
   warn
 )
 importFrom(stats,
@@ -653,7 +696,6 @@ importFrom(tools,
 importFrom(utils,
   combn,
   head,
-  modifyList,
   read.table,
   tail
 )

R/AllClasses.R

@@ -192,8 +192,7 @@ setClass(
     if (length(GenomeInfoDb::seqlevels(object)) == 0L) {
         return(NULL)
     }
-    build <- unique(GenomeInfoDb::genome(object))
-    build <- build[!is.na(build)]
+    build <- discard(unique(GenomeInfoDb::genome(object)), is.na)
     if (length(build) == 1L && str_length(build) > 0L) {
         return(NULL)
     }
@@ -217,8 +216,7 @@ setMethod("getGenome", "SumStatsBase", function(x, ...) {
     # GRangesList already has somewhere to keep it, and a parallel `genome`
     # slot went stale against it (getGenome() said hg19 while genome(x) said
     # NA, so every Bioconductor path that reads genome(x) saw nothing).
-    build <- unique(GenomeInfoDb::genome(x))
-    build <- build[!is.na(build)]
+    build <- discard(unique(GenomeInfoDb::genome(x)), is.na)
     if (length(build) == 0L) NA_character_ else build[[1L]]
 })
 
@@ -439,15 +437,32 @@ setMethod(
     }
 )
 
+# The collection's identity columns plus the per-entry payload columns.
+# @noRd
+.withEntryPayload <- function(md, entries) {
+    # `[[<-` not cbind(): the collection may already carry these columns, and
+    # they must be REPLACED -- cbind would append a second copy of each, which
+    # every reader then shadows with the stale one.
+    withFit <- `[[<-`(
+        md,
+        "susieFit",
+        value = S4Vectors::SimpleList(map(entries, getSusieFit))
+    )
+    `[[<-`(
+        withFit,
+        "cvResult",
+        value = S4Vectors::SimpleList(map(entries, getCvResult))
+    )
+}
+
 # Rebuild a fine-mapping collection from adjusted entries, keeping every
 # identity column and collection-level slot.
 # @noRd
 .fmrFromEntries <- function(x, entries) {
-    grl <- GenomicRanges::GRangesList(map(entries, rowVariants))
-    md <- mcols(x, use.names = FALSE)
-    md$susieFit <- S4Vectors::SimpleList(map(entries, getSusieFit))
-    md$cvResult <- S4Vectors::SimpleList(map(entries, getCvResult))
-    mcols(grl) <- md
+    grl <- `mcols<-`(
+        GenomicRanges::GRangesList(map(entries, rowVariants)),
+        value = .withEntryPayload(mcols(x, use.names = FALSE), entries)
+    )
     new(class(x), grl, ldSketch = .asLdSketch(getLdSketch(x)))
 }
 
@@ -534,8 +549,7 @@ setMethod("getRetainedMass", "FineMappingResultBase", function(x, ...) {
     if (nrow(x) == 0L) {
         return(.rcEmptyMass(x))
     }
-    parts <- map(seq_len(nrow(x)), .rcMassForRow, x = x)
-    parts <- compact(parts)
+    parts <- compact(map(seq_len(nrow(x)), .rcMassForRow, x = x))
     if (length(parts) == 0L) {
         return(.rcEmptyMass(x))
     }
@@ -691,8 +705,8 @@ setMethod("fsusieCredibleBand", "FineMappingResultBase", function(x, ...) {
 #' @rdname fsusieAffectedRegions
 #' @export
 setMethod("fsusieAffectedRegions", "FineMappingResultBase", function(x, ...) {
-    grs <- map(seq_len(nrow(x)), .fsusieEntryAffectedRegions, x = x)
-    grs <- grs[lengths(grs) > 0L]
+    perRow <- map(seq_len(nrow(x)), .fsusieEntryAffectedRegions, x = x)
+    grs <- perRow[lengths(perRow) > 0L]
     if (length(grs) == 0L) {
         return(GenomicRanges::GRanges())
     }
@@ -751,6 +765,7 @@ setMethod(
 # Resolve the single pinned entry and return its GRanges view (aggregating
 # across multiple entries requires type = "data.frame").
 # @noRd
+#' @importFrom rlang try_fetch
 .fmrbTopLociGranges <- function(
     x,
     study,
@@ -761,7 +776,7 @@ setMethod(
     signalCutoff,
     minPurity
 ) {
-    sel <- tryCatch(
+    sel <- try_fetch(
         .fmrSelectEntry(
             x,
             study = study,
@@ -770,7 +785,7 @@ setMethod(
             method = method,
             region = region
         ),
-        error = function(e) e
+        error = function(cnd) cnd
     )
     if (inherits(sel, "error")) {
         msg <- glue(
@@ -867,7 +882,9 @@ setMethod("resolveWeights", "FineMappingResultBase", function(x, ...) {
     # The per-variant weight of the row a selector pins. Defined on the
     # collection because that is what getFineMappingResult() now returns; the
     # body is the per-row primitive, so the two cannot drift.
-    .fmrRowResolveWeights(.fmrSelectEntry(x, ...), ...)
+    # `...` is the row selector; it is consumed by .fmrSelectEntry and has
+    # no meaning to the per-row primitive, so it is not forwarded twice.
+    .fmrRowResolveWeights(.fmrSelectEntry(x, ...))
 })
 
 #' @rdname getVariantIds

R/AllGenerics.R

@@ -50,6 +50,8 @@ NULL
 #' @param annotations An \code{AnnotationMatrix} object, or NULL for
 #'   unstratified estimation.
 #' @param local Logical, whether to compute per-block local estimates.
+#' @param estimatorArgs Optional named list of estimator-specific options
+#'   (\code{lambda} for lder / gldsc / hdl, \code{nIter} for sldsc).
 #' @param ... Additional method-specific arguments.
 #' @param study Character (length 1) or \code{NULL}. Restrict the selection to
 #'   this study; \code{NULL} matches all studies.
@@ -139,6 +141,8 @@ setGeneric("computeLdScores", function(ldRef, annotations = NULL, ...) {
 #'   inferred from file extension.
 #' @param ... The keyword source arguments described above, plus any further
 #'   arguments forwarded to the format-specific reader.
+#' @param vcfArgs Optional named list of arguments forwarded to
+#'   \code{VariantAnnotation::readVcf} when the source is a VCF.
 #' @return A \code{RangedSummarizedExperiment} of variants x samples.
 #' @seealso \code{\link{computeLd}}
 #' @examples

R/AnnotationMatrix.R

@@ -38,26 +38,35 @@ setClass(
 # The tier/type vocabulary is the only thing left to check: the SNP-by-
 # annotation shape is now enforced by SummarizedExperiment itself.
 # @noRd
+#' @importFrom checkmate makeAssertCollection assertNames assertSubset
 .validateAnnotationMatrix <- function(object) {
-    errors <- character()
+    coll <- makeAssertCollection()
     cd <- SummarizedExperiment::colData(object)
-    required <- c("name", "tier", "type")
-    if (!all(is_in(required, colnames(cd)))) {
-        return("annotationMeta must have columns: name, tier, type")
-    }
-    if (!all(is_in(cd$tier, c("baseline", "candidate")))) {
-        errors <- c(
-            errors,
-            "annotationMeta$tier must be 'baseline' or 'candidate'"
-        )
-    }
-    if (!all(is_in(cd$type, c("binary", "continuous")))) {
-        errors <- c(
-            errors,
-            "annotationMeta$type must be 'binary' or 'continuous'"
-        )
+    assertNames(
+        colnames(cd),
+        must.include = c("name", "tier", "type"),
+        what = "colnames",
+        .var.name = "annotationMeta",
+        add = coll
+    )
+    # The value checks below read those columns; without them they would
+    # report the consequence rather than the cause.
+    if (!coll$isEmpty()) {
+        return(coll$getMessages())
     }
-    if (length(errors) == 0) TRUE else errors
+    assertSubset(
+        cd$tier,
+        c("baseline", "candidate"),
+        .var.name = "annotationMeta$tier",
+        add = coll
+    )
+    assertSubset(
+        cd$type,
+        c("binary", "continuous"),
+        .var.name = "annotationMeta$type",
+        add = coll
+    )
+    coll$getMessages()
 }
 
 #' @rdname show-methods
@@ -86,8 +95,10 @@ setMethod("show", "AnnotationMatrix", function(object) {
 #' @rdname getGenome
 #' @export
 setMethod("getGenome", "AnnotationMatrix", function(x, ...) {
-    build <- unique(GenomeInfoDb::genome(SummarizedExperiment::rowRanges(x)))
-    build <- build[!is.na(build)]
+    build <- discard(
+        unique(GenomeInfoDb::genome(SummarizedExperiment::rowRanges(x))),
+        is.na
+    )
     if (length(build) == 0L) NA_character_ else build[[1L]]
 })
 
@@ -114,6 +125,7 @@ setMethod("getGenome", "AnnotationMatrix", function(x, ...) {
     if (!all(is_in(requiredCols, colnames(annotationMeta)))) {
         abort("annotationMeta must have columns: name, tier, type")
     }
+    # NOT assertMatrix: `annotations` may be a sparse Matrix, not a base one.
     if (ncol(annotations) != nrow(annotationMeta)) {
         abort(glue(
             "`annotations` has {ncol(annotations)} column(s) for ",
@@ -150,21 +162,24 @@ AnnotationMatrix <- function(
     genome = "hg19"
 ) {
     .amCheckInputs(annotations, annotationMeta)
-    if (is.null(colnames(annotations))) {
-        colnames(annotations) <- annotationMeta$name
-    }
+    annotations <- `colnames<-`(
+        annotations,
+        colnames(annotations) %||% annotationMeta$name
+    )
     if (nrow(annotations) != length(snpRanges)) {
         abort(glue(
             "`annotations` has {nrow(annotations)} row(s) for ",
             "{length(snpRanges)} SNP range(s); the rows must match."
         ))
     }
-    if (!is.null(genome) && length(genome) == 1L && !is.na(genome)) {
-        GenomeInfoDb::genome(snpRanges) <- genome
+    named <- if (!is.null(genome) && length(genome) == 1L && !is.na(genome)) {
+        GenomeInfoDb::`genome<-`(snpRanges, value = genome)
+    } else {
+        snpRanges
     }
     se <- SummarizedExperiment::SummarizedExperiment(
         assays = list(annotations = annotations),
-        rowRanges = snpRanges,
+        rowRanges = named,
         # Keyed off the assay's own colnames, not annotationMeta$name:
         # SummarizedExperiment requires the two to agree, and the previous
         # class let them diverge, so taking the name column would reject
@@ -187,7 +202,9 @@ 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]
 }