From fe354088c32160e1944a4dc14353b63a64665be1 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Sun, 16 Jun 2024 18:04:53 -0400 Subject: [PATCH] added bonus tests --- NEWS.md | 3 +++ tests/testthat/test-identifyModel.R | 33 +++++++++++++++++++++++++++++ vignettes/analyticrelatedness.Rmd | 2 +- vignettes/validation.Rmd | 4 +++- 4 files changed, 40 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index be6d30e..7130616 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# BGmisc 1.3.1.1 +* Added some more tests of identifyModel.R + # BGmisc 1.3.1 * Confirmed that all orcids are correct * Added gedcom importer diff --git a/tests/testthat/test-identifyModel.R b/tests/testthat/test-identifyModel.R index bd5a9f3..29a10ce 100644 --- a/tests/testthat/test-identifyModel.R +++ b/tests/testthat/test-identifyModel.R @@ -1,3 +1,7 @@ +# Test cases for model identification and fitting functions + +# Test that a fully specified model with adequate parameters is correctly identified + test_that("identified model is identified", { set.seed(5) @@ -14,6 +18,8 @@ test_that("identified model is identified", { )$identified) }) +# Test for error when a model is underidentified due to insufficient parameters + test_that("underidentified model is unidentified", { set.seed(5) @@ -24,7 +30,9 @@ test_that("underidentified model is unidentified", { )$identified) }) +# Test that fitComponentModel returns expected coefficients with valid input data test_that("fitComponentModel work", { + # Initial example using commented out real data loading # data(twinData, package = "OpenMx") # selVars <- c("ht1", "ht2") # mzData <- subset(twinData, zyg %in% c(1), c(selVars, "zyg")) @@ -51,3 +59,28 @@ test_that("fitComponentModel work", { ) expect_equal(result$coefficients, c(compmA = 0.0036404, compmC = 0.0002317, compmE = 0.0006713), tolerance = 1e-4) }) + +# Test for incorrect input types in comp2vech +test_that("comp2vech handles incorrect input types", { + expect_error(comp2vech("some non-matrix input"), "x is neither a list nor a matrix") +}) + +# Ensure default names are correctly assigned +test_that("default names are assigned correctly", { + result <- identifyComponentModel(matrix(1, 2, 2), matrix(1, 2, 2)) + expect_equal(result$nidp, c("Comp1", "Comp2")) +}) + + + +# Test for list handling in comp2vech +test_that("comp2vech handles lists correctly", { + list_input <- list(matrix(c(1, 0.5, 0.5, 1), 2, 2), matrix(1, 2, 2)) + expect_length(comp2vech(list_input, include.zeros = TRUE), 10) # Adjust based on expected vector length +}) + + +# Test for incorrect input types in comp2vech +test_that("comp2vech handles incorrect input types", { + expect_error(comp2vech("some non-matrix input"), "x is neither a list nor a matrix") +}) diff --git a/vignettes/analyticrelatedness.Rmd b/vignettes/analyticrelatedness.Rmd index 2873856..9f33d07 100644 --- a/vignettes/analyticrelatedness.Rmd +++ b/vignettes/analyticrelatedness.Rmd @@ -46,7 +46,7 @@ calculateRelatedness(generations = 1, full = FALSE) # Inferring Relatedness Coefficient -The `inferRelatedness` function is designed to infer the relatedness coefficient between two groups based on the observed correlation between their additive genetic variance and shared environmental variance. This function leverages the ACE framework. +The `inferRelatedness` function is designed to infer the relatedness coefficient between two groups based on the observed correlation between their additive genetic variance and shared environmental variance. This function leverages the `ACE` framework. ```{r} # Example usage: diff --git a/vignettes/validation.Rmd b/vignettes/validation.Rmd index 79a7636..bb209cf 100644 --- a/vignettes/validation.Rmd +++ b/vignettes/validation.Rmd @@ -89,6 +89,7 @@ library(tidyverse) summarizeFamilies(df, famID = "newFamID", personID = "personID")$family_summary %>% glimpse() ``` + If we didn't know to look for duplicates, we might not notice the issue. Indeed, only of the duplicates was selected as are founder member. However, the `checkIDs` function can help us identify and repair these errors: ```{r} @@ -106,6 +107,7 @@ df %>% filter(personID %in% result$non_unique_ids) %>% arrange(personID) ``` + Yep, these are definitely the duplicates. ```{r} @@ -155,7 +157,7 @@ results <- checkSex(potter, code_male = 1, code_female = 0, verbose = TRUE, repa print(results) ``` -In this example, the checkSex function checks the unique values in the sex column and identifies any inconsistencies in the sex coding of parents. The function returns a list containing validation results, such as the unique values found in the sex column and any inconsistencies in the sex coding of parents. +In this example, the `checkSex` function checks the unique values in the sex column and identifies any inconsistencies in the sex coding of parents. The function returns a list containing validation results, such as the unique values found in the sex column and any inconsistencies in the sex coding of parents. If incorrect sex codes are found, you can attempt to repair them automatically using the repair argument: