Skip to content

Commit

Permalink
changed test to hopefully pass
Browse files Browse the repository at this point in the history
Co-Authored-By: Michael Hunter <[email protected]>
  • Loading branch information
smasongarrison and mhunter1 committed Jun 17, 2024
1 parent 965bf0d commit 6d2865b
Show file tree
Hide file tree
Showing 7 changed files with 143 additions and 124 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: BGmisc
Title: An R Package for Extended Behavior Genetics Analysis
Version: 1.3.1
Version: 1.3.1.1
Authors@R: c(
person("S. Mason", "Garrison", , email= "[email protected]", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-4804-6003")),
Expand Down
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# BGmisc 1.3.1.1
* Added some more tests of identifyModel.R
* Modified tests to be MKL friendly

# BGmisc 1.3.1
* Confirmed that all orcids are correct
Expand Down
21 changes: 11 additions & 10 deletions cran-comments.md
Original file line number Diff line number Diff line change
@@ -1,14 +1,15 @@

# Description

This update removes an invalid ORCID iD that was included in the package.
Thanks Kurt Hornik for pointing it out to me! I'm also using this as an excuse to push the current version of the package. It also adds a new function to import GEDCOM files, among other fun things we're presenting at BGA at the end of June.
This update tweaks how one test is handled for the MKL check. ( https://www.stats.ox.ac.uk/pub/bdr/Rblas/MKL/BGmisc.out ) We have changed the test from expect_true(all(diag(add) == 1)) to expect_true(sum((diag(add) - 1)^2) < 1e-10). This test should work on all platforms. While we were at it, we also allowed some of the expect_equal tests to have a tolerance of 1e-10.



# Test Environments

1. Local OS: Windows 11 x64 (build 22635), R version 4.4.0 (2024-04-24 ucrt)
1. Local OS: Windows 11 x64 (build 22635), R version 4.4.1 (2024-06-14 ucrt)
2. **GitHub Actions**:
- [Link](https://github.com/R-Computing-Lab/BGmisc/actions/runs/9537687414)
- [Link](https://github.com/R-Computing-Lab/BGmisc/actions/runs/9555870410)
- macOS (latest version) with the latest R release.
- Windows (latest version) with the latest R release.
- Ubuntu (latest version) with:
Expand All @@ -18,9 +19,9 @@ Thanks Kurt Hornik for pointing it out to me! I'm also using this as an excuse t

## R CMD check results

── R CMD check ────────────────────────────────────────────────
─ using log directory 'E:/Dropbox/Lab/Research/Projects/2024/BGMiscJoss/BGmisc.Rcheck'
─ using R version 4.4.0 (2024-04-24 ucrt)
── R CMD check ────────────────────────────────────────
─ using log directory 'E:/Dropbox/Lab/Research/Projects/2024/BGMiscJoss/BGmisc.Rcheck' (719ms)
─ using R version 4.4.1 (2024-06-14 ucrt)
─ using platform: x86_64-w64-mingw32
─ R was compiled by
gcc.exe (GCC) 13.2.0
Expand All @@ -29,11 +30,11 @@ Thanks Kurt Hornik for pointing it out to me! I'm also using this as an excuse t
─ using session charset: UTF-8
─ using options '--no-manual --as-cran'
✔ checking for file 'BGmisc/DESCRIPTION'
─ this is package 'BGmisc' version '1.3.1'
─ this is package 'BGmisc' version '1.3.1.1'
─ package encoding: UTF-8
.... boring stuff
── R CMD check results ────────────────────── BGmisc 1.3.1 ────
Duration: 50.9s
── R CMD check results ──────────── BGmisc 1.3.1.1 ────
Duration: 54s

0 errors ✔ | 0 warnings ✔ | 0 notes ✔

Expand Down
5 changes: 0 additions & 5 deletions tests/testthat/test-identifyModel.R
Original file line number Diff line number Diff line change
Expand Up @@ -79,8 +79,3 @@ test_that("comp2vech handles lists correctly", {
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")
})
120 changes: 69 additions & 51 deletions tests/testthat/test-networks.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,12 +35,14 @@ test_that("ped2graph produces a graph for inbreeding data", {


test_that("ped2add produces correct matrix dims, values, and dimnames for hazard", {
tolerance <- 1e-10
data(hazard)
add <- ped2add(hazard)
# Check dimension
expect_equal(dim(add), c(nrow(hazard), nrow(hazard)))
# Check several values
expect_true(all(diag(add) == 1))
#expect_true(all(diag(add) == 1))
expect_true(sum((diag(add) - 1)^2) < tolerance)
expect_equal(add, t(add))
expect_equal(add[2, 1], 0)
expect_equal(add[10, 1], .25)
Expand All @@ -53,16 +55,18 @@ test_that("ped2add produces correct matrix dims, values, and dimnames for hazard
})

test_that("ped2add produces correct matrix dims, values, and dimnames for alternative transpose", {
tolerance <- 1e-10
data(hazard)
add <- ped2add(hazard, tcross.alt.crossprod = TRUE)
# Check dimension
expect_equal(dim(add), c(nrow(hazard), nrow(hazard)))
expect_equal(dim(add), c(nrow(hazard), nrow(hazard)),tolerance = tolerance)
# Check several values
expect_true(all(diag(add) == 1))
expect_equal(add, t(add))
expect_equal(add[2, 1], 0)
expect_equal(add[10, 1], .25)
expect_equal(add[9, 1], 0)
#expect_true(all(diag(add) == 1))
expect_true(sum((diag(add) - 1)^2) < tolerance)
expect_equal(add, t(add),tolerance = tolerance)
expect_equal(add[2, 1], 0,tolerance = tolerance)
expect_equal(add[10, 1], .25,tolerance = tolerance)
expect_equal(add[9, 1], 0,tolerance = tolerance)
expect_equal(add["5", "6"], .5)
# Check that dimnames are correct
dn <- dimnames(add)
Expand All @@ -72,16 +76,17 @@ test_that("ped2add produces correct matrix dims, values, and dimnames for altern
# to do, combine the sets that are equalivant. shouldn't need to run 1000 expect equals

test_that("ped2add produces correct matrix dims, values, and dimnames for inbreeding data", {
tolerance <- 1e-10
data(inbreeding)
add <- ped2add(inbreeding)
# Check dimension
expect_equal(dim(add), c(nrow(inbreeding), nrow(inbreeding)))
expect_equal(dim(add), c(nrow(inbreeding), nrow(inbreeding)),tolerance = tolerance)
# Check several values
expect_true(all(diag(add) >= 1))
expect_equal(add, t(add))
expect_equal(add[2, 1], 0)
expect_equal(add[6, 1], .5)
expect_equal(add[113, 113], 1.1250)
expect_true(all(diag(add) >= 1-tolerance))
expect_equal(add, t(add),tolerance = tolerance)
expect_equal(add[2, 1], 0,tolerance = tolerance)
expect_equal(add[6, 1], .5,tolerance = tolerance)
expect_equal(add[113, 113], 1.1250,tolerance = tolerance)
expect_equal(add["113", "112"], 0.62500)
# Check that dimnames are correct
dn <- dimnames(add)
Expand All @@ -91,89 +96,99 @@ test_that("ped2add produces correct matrix dims, values, and dimnames for inbree


test_that("ped2add produces correct matrix dims, values, and dimnames for inbreeding data with alternative transpose", {
tolerance <- 1e-10
data(inbreeding)
add <- ped2add(inbreeding, tcross.alt.star = TRUE)
# Check dimension
expect_equal(dim(add), c(nrow(inbreeding), nrow(inbreeding)))
# Check several values
expect_true(all(diag(add) >= 1))
expect_equal(add, t(add))
expect_equal(add[2, 1], 0)
expect_equal(add[6, 1], .5)
expect_equal(add[113, 113], 1.1250)
expect_equal(add, t(add), tolerance = tolerance)
expect_equal(add[2, 1], 0, tolerance = tolerance)
expect_equal(add[6, 1], .5, tolerance = tolerance)
expect_equal(add[113, 113], 1.1250, tolerance = tolerance)
expect_equal(add["113", "112"], 0.62500)
# Check that dimnames are correct
dn <- dimnames(add)
expect_equal(dn[[1]], dn[[2]])
expect_equal(dn[[1]], as.character(inbreeding$ID))
})
test_that("ped2add flattens diagonal for inbreeding data", {
tolerance <- 1e-10
data(inbreeding)
add <- ped2add(inbreeding, flatten.diag = TRUE)
# Check dimension
expect_equal(dim(add), c(nrow(inbreeding), nrow(inbreeding)))
expect_equal(dim(add), c(nrow(inbreeding), nrow(inbreeding)), tolerance = tolerance)
# Check several values
expect_true(all(diag(add) == 1))
expect_equal(add, t(add))
expect_equal(add[2, 1], 0)
expect_equal(add[6, 1], .5)
expect_equal(add[113, 113], 1)
# expect_true(all(diag(add) == 1))
expect_true(sum((diag(add) - 1)^2) < tolerance)
expect_equal(add, t(add), tolerance = tolerance)
expect_equal(add[2, 1], 0, tolerance = tolerance)
expect_equal(add[6, 1], .5, tolerance = tolerance)
expect_equal(add[113, 113], 1, tolerance = tolerance)
expect_equal(add["113", "112"], 0.62500)
# Check that dimnames are correct
dn <- dimnames(add)
expect_equal(dn[[1]], dn[[2]])
expect_equal(dn[[1]], as.character(inbreeding$ID))
})
test_that("ped2mit produces correct matrix dims, values, and dimnames for inbreeding", {
tolerance <- 1e-10
# Check dimension
data(inbreeding)
mit <- ped2mit(inbreeding)
# Check dimension
expect_equal(dim(mit), c(nrow(inbreeding), nrow(inbreeding)))
# Check several values
expect_true(all(diag(mit) == 1))
expect_equal(mit, t(mit))
expect_equal(mit[2, 1], 0)
expect_equal(mit[6, 1], 1)
expect_equal(mit[113, 113], 1)
expect_equal(mit["113", "112"], 1)
# expect_true(all(diag(mit) == 1))
expect_true(sum((diag(mit) - 1)^2) < tolerance)
expect_equal(mit, t(mit), tolerance = tolerance)
expect_equal(mit[2, 1], 0, tolerance = tolerance)
expect_equal(mit[6, 1], 1, tolerance = tolerance)
expect_equal(mit[113, 113], 1, tolerance = tolerance)
expect_equal(mit["113", "112"], 1, tolerance = tolerance)
# Check that dimnames are correct
dn <- dimnames(mit)
expect_equal(dn[[1]], dn[[2]])
expect_equal(dn[[1]], as.character(inbreeding$ID))
})

test_that("ped2mit produces correct matrix dims, values, and dimnames for inbreeding", {
tolerance <- 1e-10
# Check dimension
data(inbreeding)
mit <- ped2mit(inbreeding)
# Check dimension
expect_equal(dim(mit), c(nrow(inbreeding), nrow(inbreeding)))
expect_equal(dim(mit), c(nrow(inbreeding), nrow(inbreeding)), tolerance = tolerance)
# Check several values
expect_true(all(diag(mit) == 1))
expect_equal(mit, t(mit))
expect_equal(mit[2, 1], 0)
expect_equal(mit[6, 1], 1)
expect_equal(mit[113, 113], 1)
expect_equal(mit["113", "112"], 1)
# expect_true(all(diag(mit) == 1))
expect_true(sum((diag(mit) - 1)^2) < tolerance)
expect_equal(mit, t(mit), tolerance = tolerance)
expect_equal(mit[2, 1], 0, tolerance = tolerance)
expect_equal(mit[6, 1], 1, tolerance = tolerance)
expect_equal(mit[113, 113], 1, tolerance = tolerance)
expect_equal(mit["113", "112"], 1, tolerance = tolerance)
# Check that dimnames are correct
dn <- dimnames(mit)
expect_equal(dn[[1]], dn[[2]])
expect_equal(dn[[1]], as.character(inbreeding$ID))
})

test_that("ped2cn produces correct matrix dims, values, and dimnames", {
# # Check dimension
tolerance <- 1e-10

# Check dimension
data(inbreeding)
cn <- ped2cn(inbreeding)
expect_equal(dim(cn), c(nrow(inbreeding), nrow(inbreeding)))
expect_equal(dim(cn), c(nrow(inbreeding), nrow(inbreeding)), tolerance = tolerance)
# Check several values
expect_true(all(diag(cn) == 1))
expect_equal(cn, t(cn))
expect_equal(cn[2, 1], 0)
expect_equal(cn[6, 1], 0)
expect_equal(cn[113, 113], 1)
expect_equal(cn["113", "112"], 1)
# expect_true(all(diag(cn) == 1))
expect_true(sum((diag(cn) - 1)^2) < tolerance)
expect_equal(cn, t(cn), tolerance = tolerance)
expect_equal(cn[2, 1], 0, tolerance = tolerance)
expect_equal(cn[6, 1], 0, tolerance = tolerance)
expect_equal(cn[113, 113], 1, tolerance = tolerance)
expect_equal(cn["113", "112"], 1, tolerance = tolerance)
# Check that dimnames are correct
dn <- dimnames(cn)
expect_equal(dn[[1]], dn[[2]])
Expand All @@ -182,16 +197,18 @@ test_that("ped2cn produces correct matrix dims, values, and dimnames", {
})

test_that("ped2ce produces correct matrix dims, values, and dimnames", {
tolerance <- 1e-10
data(inbreeding)
ce <- ped2ce(inbreeding)
expect_equal(dim(ce), c(nrow(inbreeding), nrow(inbreeding)))
expect_equal(dim(ce), c(nrow(inbreeding), nrow(inbreeding)), tolerance = tolerance)
# Check several values
expect_true(all(diag(ce) == 1))
expect_equal(ce, t(ce))
expect_equal(ce[2, 1], 1)
expect_equal(ce[6, 1], 1)
expect_equal(ce[113, 113], 1)
expect_equal(ce["113", "112"], 1)
# expect_true(all(diag(ce) == 1))
expect_true(sum((diag(ce) - 1)^2) < tolerance)
expect_equal(ce, t(ce), tolerance = tolerance)
expect_equal(ce[2, 1], 1, tolerance = tolerance)
expect_equal(ce[6, 1], 1, tolerance = tolerance)
expect_equal(ce[113, 113], 1, tolerance = tolerance)
expect_equal(ce["113", "112"], 1, tolerance = tolerance)
# Check that dimnames are correct
dn <- dimnames(ce)
expect_equal(dn[[1]], dn[[2]])
Expand All @@ -207,6 +224,7 @@ test_that("ped2add verbose prints updates", {

test_that("ped2maternal/paternal produces correct matrix dims", {
data(hazard)
tolerance <- 1e-10
mat <- ped2maternal(hazard)
expect_equal(dim(mat), c(nrow(hazard), ncol(hazard) + 1))
data(hazard)
Expand Down
26 changes: 15 additions & 11 deletions vignettes/analyticrelatedness.html
Original file line number Diff line number Diff line change
Expand Up @@ -343,20 +343,22 @@ <h1 class="title toc-ignore">Calculating and Inferring Relatedness

<div id="introduction" class="section level1">
<h1>Introduction</h1>
<p>This vignette focuses on the calculation and inference of relatedness
coefficients using the <code>BGmisc</code> package. The relatedness
coefficient is a measure of the genetic relationship between two
individuals. Here, we introduce two functions:
<code>calculateRelatedness</code> and <code>inferRelatedness</code>,
which allow users to compute and infer the relatedness coefficient
respectively.</p>
<p>This vignette demonstrates analytic methods for determining
relatedness in a pedigree. The relatedness coefficient is a measure of
the genetic overlap between two individuals. In the simplest terms, it
quantifies the genetic overlap between two individuals. The relatedness
coefficient ranges from 0 to 1, with 1 indicating a perfect genetic
match (which occurs when comparing an individual to themselves, their
identical twin, or their clone), whereas 0 indicates no genetic overlap.
We introduce two functions: <code>calculateRelatedness</code> and
<code>inferRelatedness</code>, which allow users to compute and infer
the relatedness coefficient, respectively.</p>
<div id="loading-required-libraries" class="section level2">
<h2>Loading Required Libraries</h2>
<div class="sourceCode" id="cb1"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb1-1"><a href="#cb1-1" tabindex="-1"></a><span class="fu">library</span>(BGmisc)</span></code></pre></div>
</div>
</div>
<div id="calculating-relatedness-coefficient" class="section level1">
<h1>Calculating Relatedness Coefficient</h1>
<div id="calculating-relatedness-coefficient" class="section level2">
<h2>Calculating Relatedness Coefficient</h2>
<p>The <code>calculateRelatedness</code> function offers a method to
compute the relatedness coefficient based on shared ancestry, as
described by Wright (1922). This function utilizes the formula:</p>
Expand All @@ -373,12 +375,14 @@ <h1>Calculating Relatedness Coefficient</h1>
<span id="cb3-2"><a href="#cb3-2" tabindex="-1"></a><span class="fu">calculateRelatedness</span>(<span class="at">generations =</span> <span class="dv">1</span>, <span class="at">full =</span> <span class="cn">FALSE</span>)</span>
<span id="cb3-3"><a href="#cb3-3" tabindex="-1"></a><span class="co">#&gt; [1] 0.25</span></span></code></pre></div>
</div>
</div>
<div id="inferring-relatedness-coefficient" class="section level1">
<h1>Inferring Relatedness Coefficient</h1>
<p>The <code>inferRelatedness</code> 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.</p>
environmental variance. This function leverages the <code>ACE</code>
framework.</p>
<div class="sourceCode" id="cb4"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb4-1"><a href="#cb4-1" tabindex="-1"></a><span class="co"># Example usage:</span></span>
<span id="cb4-2"><a href="#cb4-2" tabindex="-1"></a><span class="co"># Infer the relatedness coefficient:</span></span>
<span id="cb4-3"><a href="#cb4-3" tabindex="-1"></a><span class="fu">inferRelatedness</span>(<span class="at">obsR =</span> <span class="fl">0.5</span>, <span class="at">aceA =</span> <span class="fl">0.9</span>, <span class="at">aceC =</span> <span class="dv">0</span>, <span class="at">sharedC =</span> <span class="dv">0</span>)</span>
Expand Down
Loading

0 comments on commit 6d2865b

Please sign in to comment.