Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Issue https://github.com/statOmics/msqrob2/issues/63 #64

Merged
merged 13 commits into from
Sep 3, 2024
Merged

Issue https://github.com/statOmics/msqrob2/issues/63 #64

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
6063604
[FEAT] - implementation of a referencePresent slot in the params of s…
leopoldguyot Aug 22, 2024
7df1cff
[FEAT] - add option to not return the contrast that involve parameter…
leopoldguyot Aug 22, 2024
67cf13a
[FEAT] - changing the logic behind the creation of "referencePresent"
leopoldguyot Aug 23, 2024
4910d4a
[FEAT] - new column to topFeature output when acceptDifferentReferenc…
leopoldguyot Aug 23, 2024
414f510
[TEST] - test for msqrob-utils (check reference)
leopoldguyot Aug 23, 2024
dc0795e
[TEST] - add tests for msqrobLm and varContrast and getContrast
leopoldguyot Aug 23, 2024
06025a4
[TEST] - add test for topFeatures
leopoldguyot Aug 26, 2024
b018bb0
[FEAT] - Check that global design matrix is full rank + handle case i…
leopoldguyot Aug 28, 2024
6a41212
[FEAT] - handling of interaction models
leopoldguyot Aug 29, 2024
f3c691f
[FIX] - fixing some issues revealed by the cptac vignette
leopoldguyot Aug 29, 2024
a97a4e5
[TEST] - test for propagateFalseStatus + refactoring
leopoldguyot Aug 29, 2024
bed5c34
[OPTI] - optimization of checkReference
leopoldguyot Aug 29, 2024
bddff79
[TEST + DOC] - tests and doc for getFormulaFactors
leopoldguyot Aug 29, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
51 changes: 36 additions & 15 deletions R/msqrob-utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -107,26 +107,19 @@ checkReference <- function(y, data, paramNames, formula) {
referenceLevels <- getReferenceLevels(data, formula)
factor <- names(referenceLevels)
subset <- droplevels(data[!is.na(y), factor, drop = FALSE])
referencePresent <- list()
for (param in paramNames) {
referencePresent[[param]] <- NA
}
paramSplit <- list()
for (x in factor) {
paramSplit[[x]] <- paramNames[grep(x, paramNames)]
}
for (x in factor){
factor_status <- unlist(lapply(factor, function(x) {
noIntercept <- all(paste0(x, levels(as.factor(data[, x]))) %in% paramNames)
if (noIntercept || (referenceLevels[[x]] %in% levels(subset[, x]))) {
for (param in paramSplit[[x]]) {
referencePresent[[param]] <- TRUE
}
} else {
for (param in paramSplit[[x]]) {
referencePresent[[param]] <- FALSE
}
}
}
refPres <- referenceLevels[[x]] %in% levels(subset[, x])
return(noIntercept || refPres)
}))
names(factor_status) <- factor

referencePresent <- propagateFalseStatus(paramSplit, factor_status)

return(unlist(referencePresent))
}

Expand Down Expand Up @@ -182,9 +175,37 @@ checkFullRank <- function(modelMatrix) {
return(qr(modelMatrix)$rank == ncol(modelMatrix))
}


##### None exported functions from multcomp package is included here to
##### During R and Bioc checks

propagateFalseStatus <- function(vectors, statuses) {
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nice attempt to solve the interaction issue, I however can't fully wrap my head around what you are doing. A few comments on the function:

  • Could you document the internal function using standard comments so to briefly describe what the function does, and especially what are the expected argument inputs.
  • Be very careful with repeat to not allow for infinite loops, I personally prefer a while() loop although there is still is risk of infinite loops.
  • I can't see unit tests, but maybe this is in progress

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I added tests, commented the function and changed the code. a97a4e5

repeat {
false_elements <- unique(unlist(vectors[statuses == FALSE]))

new_statuses <- map_lgl(seq_along(vectors), function(i) {
if (statuses[i] == TRUE && any(vectors[[i]] %in% false_elements)) {
return(FALSE)
} else {
return(statuses[i])
}
})

if (all(new_statuses == statuses)) break

statuses <- new_statuses
}

all_elements <- unique(unlist(vectors))
element_status <- setNames(rep(TRUE, length(all_elements)), all_elements)

for (i in seq_along(vectors)) {
element_status[vectors[[i]]] <- statuses[i]
}

return(element_status)
}


.chrlinfct2matrix <- function(ex, var) {
if (!is.character(ex)) {
Expand Down
25 changes: 17 additions & 8 deletions tests/testthat/test_msqrob-utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,17 @@
y_ref <- c(rep(1,5), rep(1,5), rep(1,5))
names(y_ref) <- 1:15
data <- data.frame(condition = as.factor(rep(letters[1:3], c(5,5,5))),
condition2 = as.factor(rep(letters[1:5], 3)),
numerical = c(1:5, 1:5, 1:5),
row.names = 1:15)
form <- formula(~ 1 + condition + numerical, data = data)
form_num <- formula(~ 1 + numerical, data = data)
form_no_intercept <- formula(~ -1 + condition + numerical, data = data)
form_interaction <- formula(~ 1 + condition*condition2, data = data)
return(list(data = data, form = form,
form_num = form_num,
form_no_intercept = form_no_intercept,
form_interaction = form_interaction,
y_no_ref = y_no_ref,
y_ref = y_ref))
}
Expand All @@ -34,24 +37,30 @@ test_that("checkReference", {
y_ref <- .create_minimal_data()$y_ref
formula <- .create_minimal_data()$form
formula_no_intercept <- .create_minimal_data()$form_no_intercept
formula_interaction <- .create_minimal_data()$form_interaction

paramNames <- colnames(model.matrix(formula, data = data))
paramNames_no_intercept <- colnames(model.matrix(formula_no_intercept, data = data))
paramNames_interaction <- colnames(model.matrix(formula_interaction, data = data))

reference_present_no_ref <- c(NA, FALSE, FALSE, NA)
names(reference_present_no_ref) <- c("(Intercept)", "conditionb", "conditionc", "numerical")
reference_present_no_ref <- c(FALSE, FALSE)
names(reference_present_no_ref) <- c("conditionb", "conditionc")
expect_identical(reference_present_no_ref, msqrob2:::checkReference(y_no_ref, data, paramNames, formula))

reference_present_no_int <- c(TRUE, TRUE, TRUE, NA)
names(reference_present_no_int) <- c("conditiona", "conditionb", "conditionc", "numerical")
reference_present_no_int <- c(TRUE, TRUE, TRUE)
names(reference_present_no_int) <- c("conditiona", "conditionb", "conditionc")
expect_identical(reference_present_no_int, msqrob2:::checkReference(y_no_ref, data, paramNames_no_intercept, formula_no_intercept))

reference_present_ref <- c(NA, TRUE, TRUE, NA)
names(reference_present_ref) <- c("(Intercept)", "conditionb", "conditionc", "numerical")
reference_present_ref <- c(TRUE, TRUE)
names(reference_present_ref) <- c("conditionb", "conditionc")
expect_identical(reference_present_ref, msqrob2:::checkReference(y_ref, data, paramNames, formula))

reference_no_var <- c(NA)
names(reference_no_var) <- c("(Intercept)")
reference_no_var <- logical(0)
expect_identical(reference_no_var, msqrob2:::checkReference(y_ref, data, c("(Intercept)"), as.formula(~1)))

reference_interaction <- rep(FALSE, length(paramNames_interaction[-1]))
names(reference_interaction) <- paramNames_interaction[-1]
expect_identical(reference_interaction, msqrob2:::checkReference(y_no_ref, data, paramNames_interaction, formula_interaction))
})

test_that("referenceContrast", {
Expand Down
8 changes: 4 additions & 4 deletions tests/testthat/test_msqrob.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,11 +23,11 @@ test_that("msqrobLm", {
Y <- .create_minimal_data()$Y
msqrobLm_object <- msqrobLm(Y, form_cond, data, robust = FALSE)

reference_present_no_ref <- c(NA, FALSE, FALSE)
names(reference_present_no_ref) <- c("(Intercept)", "conditionb", "conditionc")
reference_present_no_ref <- c(FALSE, FALSE)
names(reference_present_no_ref) <- c("conditionb", "conditionc")
expect_identical(reference_present_no_ref, msqrobLm_object$feat1@params$referencePresent)

reference_present_ref <- c(NA, TRUE, TRUE)
names(reference_present_ref) <- c("(Intercept)", "conditionb", "conditionc")
reference_present_ref <- c(TRUE, TRUE)
names(reference_present_ref) <- c("conditionb", "conditionc")
expect_identical(reference_present_ref, msqrobLm_object$feat2@params$referencePresent)
})