From 40920535654debf61389e7154d1b1ba22b8fb730 Mon Sep 17 00:00:00 2001 From: Daniel Nachun Date: Wed, 8 Jul 2026 15:03:07 -0700 Subject: [PATCH] fix entry bugs --- R/GwasFineMappingResult.R | 9 ++++++++- R/QtlFineMappingResult.R | 8 +++++++- R/qtlSumStats.R | 9 ++++++++- R/twasWeights.R | 8 +++++++- tests/testthat/test_GwasFineMappingResult.R | 17 +++++++++++++++++ tests/testthat/test_QtlFineMappingResult.R | 20 ++++++++++++++++++++ tests/testthat/test_TwasWeightsEntry.R | 13 +++++++++++++ 7 files changed, 80 insertions(+), 4 deletions(-) diff --git a/R/GwasFineMappingResult.R b/R/GwasFineMappingResult.R index f2a9914a..8ba4f587 100644 --- a/R/GwasFineMappingResult.R +++ b/R/GwasFineMappingResult.R @@ -36,7 +36,14 @@ setClass("GwasFineMappingResult", if (!all(entryTypes)) errors <- c(errors, "every element of the `entry` column must be a FineMappingEntry") - keyDf <- as.data.frame(object[, c("study", "method", "region_id")]) + # Extract key columns directly rather than via `object[, keyCols]`: + # column-subsetting preserves the GwasFineMappingResult class while + # dropping the required `entry` column, and older S4Vectors revalidates + # that intermediate, spuriously failing with "missing columns: entry". + keyCols <- c("study", "method", "region_id") + keyDf <- as.data.frame( + lapply(keyCols, function(cn) object[[cn]]), + col.names = keyCols, stringsAsFactors = FALSE) if (anyDuplicated(keyDf)) errors <- c(errors, "(study, method, region_id) tuple uniqueness violated") diff --git a/R/QtlFineMappingResult.R b/R/QtlFineMappingResult.R index f4f9eff5..17761df8 100644 --- a/R/QtlFineMappingResult.R +++ b/R/QtlFineMappingResult.R @@ -42,7 +42,13 @@ setClass("QtlFineMappingResult", "'%s' column must be character (got %s)", jc, class(vals)[[1L]])) } keyCols <- c("study", "context", "trait", "method", jointCols) - keyDf <- as.data.frame(object[, keyCols, drop = FALSE]) + # Extract key columns directly rather than via `object[, keyCols]`: + # column-subsetting preserves the QtlFineMappingResult class while + # dropping the required `entry` column, and older S4Vectors revalidates + # that intermediate, spuriously failing with "missing columns: entry". + keyDf <- as.data.frame( + lapply(keyCols, function(cn) object[[cn]]), + col.names = keyCols, stringsAsFactors = FALSE) if (anyDuplicated(keyDf)) errors <- c(errors, "(study, context, trait, method[, joint*]) tuple uniqueness violated") diff --git a/R/qtlSumStats.R b/R/qtlSumStats.R index 6cbb1d93..cbca4ab3 100644 --- a/R/qtlSumStats.R +++ b/R/qtlSumStats.R @@ -35,7 +35,14 @@ setClass("QtlSumStats", if (!all(entryTypes)) errors <- c(errors, "every element of the `entry` column must be a GRanges") - keyDf <- as.data.frame(object[, c("study", "context", "trait")]) + # Extract key columns directly rather than via `object[, keyCols]`: + # column-subsetting preserves the QtlSumStats class while dropping the + # required `entry` column, and older S4Vectors revalidates that + # intermediate, spuriously failing with "missing columns: entry". + keyCols <- c("study", "context", "trait") + keyDf <- as.data.frame( + lapply(keyCols, function(cn) object[[cn]]), + col.names = keyCols, stringsAsFactors = FALSE) if (anyDuplicated(keyDf)) errors <- c(errors, "(study, context, trait) tuple uniqueness violated") diff --git a/R/twasWeights.R b/R/twasWeights.R index 77d3a7a8..c67b312f 100644 --- a/R/twasWeights.R +++ b/R/twasWeights.R @@ -42,7 +42,13 @@ setClass("TwasWeights", "'%s' column must be character (got %s)", jc, class(vals)[[1L]])) } keyCols <- c("study", "context", "trait", "method", jointCols) - keyDf <- as.data.frame(object[, keyCols, drop = FALSE]) + # Extract key columns directly rather than via `object[, keyCols]`: + # column-subsetting preserves the TwasWeights class while dropping the + # required `entry` column, and older S4Vectors revalidates that + # intermediate, spuriously failing with "missing columns: entry". + keyDf <- as.data.frame( + lapply(keyCols, function(cn) object[[cn]]), + col.names = keyCols, stringsAsFactors = FALSE) if (anyDuplicated(keyDf)) errors <- c(errors, "(study, context, trait, method[, joint*]) tuple uniqueness violated") diff --git a/tests/testthat/test_GwasFineMappingResult.R b/tests/testthat/test_GwasFineMappingResult.R index 557e7405..813401c1 100644 --- a/tests/testthat/test_GwasFineMappingResult.R +++ b/tests/testthat/test_GwasFineMappingResult.R @@ -14,6 +14,23 @@ test_that("GwasFineMappingResult: builds a collection keyed by 2-tuple", { }) +test_that("GwasFineMappingResult: validity does not recurse on key subset (#546)", { + # The validity method builds a key-column data.frame to check tuple + # uniqueness. Doing so via `object[, keyCols]` preserves the + # GwasFineMappingResult class while dropping the required `entry` column; + # older S4Vectors revalidates that intermediate and fails with + # "missing columns: entry". + e <- .sc_makeFineMappingEntry(3) + res <- GwasFineMappingResult(study = "g1", method = "susie", + entry = list(e)) + expect_s4_class(res, "GwasFineMappingResult") + expect_true(validObject(res)) + + sub <- res[, c("study", "method", "region_id")] + expect_false("entry" %in% names(sub)) +}) + + test_that("GwasFineMappingResult: errors on length mismatch", { e <- .sc_makeFineMappingEntry(3) expect_error( diff --git a/tests/testthat/test_QtlFineMappingResult.R b/tests/testthat/test_QtlFineMappingResult.R index 569795dc..bb8ce76b 100644 --- a/tests/testthat/test_QtlFineMappingResult.R +++ b/tests/testthat/test_QtlFineMappingResult.R @@ -17,6 +17,26 @@ test_that("QtlFineMappingResult: builds a collection keyed by 4-tuple", { }) +test_that("QtlFineMappingResult: validity does not recurse on key subset (#546)", { + # The validity method builds a key-column data.frame to check tuple + # uniqueness. Doing so via `object[, keyCols]` preserves the + # QtlFineMappingResult class while dropping the required `entry` column; + # older S4Vectors revalidates that intermediate and fails with + # "missing columns: entry". Guard the reporter's exact scenario. + e <- .sc_makeFineMappingEntry(3) + res <- QtlFineMappingResult( + study = "s", context = "c", trait = "t", method = "qsusie", + entry = list(e), ldSketch = NULL) + expect_s4_class(res, "QtlFineMappingResult") + expect_true(validObject(res)) + + # A bare key-column subset is itself an invalid QtlFineMappingResult; + # validity must never re-run over it. + sub <- res[, c("study", "context", "trait", "method"), drop = FALSE] + expect_false("entry" %in% names(sub)) +}) + + test_that("QtlFineMappingResult: stores an LD sketch when supplied", { e <- .sc_makeFineMappingEntry(3) gh <- .sc_makeGenotypeHandle() diff --git a/tests/testthat/test_TwasWeightsEntry.R b/tests/testthat/test_TwasWeightsEntry.R index ffdfa884..7c4b2546 100644 --- a/tests/testthat/test_TwasWeightsEntry.R +++ b/tests/testthat/test_TwasWeightsEntry.R @@ -57,6 +57,19 @@ test_that("TwasWeights: rejects non-TwasWeightsEntry rows", { }) +test_that("TwasWeights: validity does not recurse on key subset (#546)", { + # Building the tuple-uniqueness key via `object[, keyCols]` preserves the + # TwasWeights class while dropping the required `entry` column; older + # S4Vectors revalidates that intermediate and fails with "missing columns". + e <- .sc_makeTwasWeightsEntry(p = 5L) + res <- TwasWeights( + study = "s1", context = "c1", trait = "t1", method = "lasso", + entry = list(e)) + expect_s4_class(res, "TwasWeights") + expect_true(validObject(res)) +}) + + # === Tests migrated from test_showMethods.R (TwasWeightsEntry) ===