Merge pull request #43 from R-Computing-Lab/dev_main

changed test to hopefully pass

Author: smasongarrison

DESCRIPTION

@@ -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= "garrissm@wfu.edu", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-4804-6003")),

NEWS.md

@@ -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

cran-comments.md

@@ -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:
@@ -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
@@ -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 ✔
 

tests/testthat/test-identifyModel.R

@@ -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")
-})

tests/testthat/test-networks.R

@@ -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)
@@ -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)
@@ -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)
@@ -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]])
@@ -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]])
@@ -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)

vignettes/analyticrelatedness.html

@@ -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>
@@ -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>