From d751e947c25716eabae7d78f624faba22f2c6f57 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Wed, 15 Nov 2023 20:00:02 -0500 Subject: [PATCH 01/24] Update checkSex.R --- R/checkSex.R | 58 ++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 18 deletions(-) diff --git a/R/checkSex.R b/R/checkSex.R index 5bee0c1..8b2c356 100644 --- a/R/checkSex.R +++ b/R/checkSex.R @@ -5,20 +5,20 @@ #' 2. Optionally repairs the sex coding based on a specified logic. #' #' @param ped A dataframe representing the pedigree data with a 'sex' column. -#' @param code_male The code used to represent males in the 'sex' column. If NULL, no recoding is performed. +#' @param code_male The code used to represent males in the 'sex' column. If both male and female are NULL, no recoding is performed. +#' @param code_female The code used to represent females in the 'sex' column. If both male and female are NULL, no recoding is performed. #' @param verbose A logical flag indicating whether to print progress and validation messages to the console. #' @param repair A logical flag indicating whether to attempt repairs on the sex coding. -#' @param recode A logical flag indicating whether to recode the 'sex' variable. #' #' @return Depending on the value of `repair`, either a list containing validation results or a repaired dataframe is returned. #' @examples #' \dontrun{ #' ped <- data.frame(ID = c(1, 2, 3), sex = c("M", "F", "M")) -#' checkSex(ped, code_male = "M", verbose = TRUE, repair = FALSE, recode = TRUE) +#' checkSex(ped, code_male = "M", verbose = TRUE, repair = FALSE) #' } #' @export #' -checkSex <- function(ped, code_male = NULL, verbose = FALSE, repair = FALSE, recode = FALSE) { +checkSex <- function(ped, code_male = NULL, code_female = NULL,verbose = FALSE, repair = FALSE) { # Standardize column names in the input dataframe ped <- standardize_colnames(ped) @@ -26,6 +26,11 @@ checkSex <- function(ped, code_male = NULL, verbose = FALSE, repair = FALSE, rec # Initialize a list to store validation results validation_results <- list() + + # Initialize a list to track changes made during repair + changes <- list() + + if (verbose) { cat("Step 1: Checking how many genders...\n") } @@ -35,23 +40,28 @@ checkSex <- function(ped, code_male = NULL, verbose = FALSE, repair = FALSE, rec validation_results$sex_length <- length(unique(ped$sex)) if (verbose) { cat(paste0( - validation_results$sex_length, " unique values found.\n ", - paste0(validation_results$sex_unique) - )) + validation_results$sex_length, " unique values found.\n " + ), + paste0(validation_results$sex_unique)) } - if (repair) { if (verbose) { - cat("Step 3: Attempting to repair sex coding...\n") + cat("Step 2: Attempting to repair sex coding...\n") } - # Initialize a list to track changes made during repair - changes <- list() + # [Insert logic to repair sex coding here] if (validation_results$sex_length == 2) { most_frequent_sex_dad <- names(sort(table(ped$sex[ped$ID %in% ped$dadID]), decreasing = TRUE))[1] + original_ped <- ped ped <- recodeSex(ped, code_male = most_frequent_sex_dad) + # Count and record the change + num_changes <- sum(original_ped$sex != ped$sex) + # Record the change and the count + changes[[length(changes) + 1]] <- sprintf( + "Recode sex based on most frequent sex in dads: %s. Total gender changes made: %d", + most_frequent_sex_dad, num_changes) } # Update the pedigree dataframe after repair repaired_ped <- ped @@ -60,7 +70,7 @@ checkSex <- function(ped, code_male = NULL, verbose = FALSE, repair = FALSE, rec cat("Changes Made:\n") print(changes) } - return(repaired_ped) + return(list(validation_results, repaired_ped, changes)) } else { return(validation_results) } @@ -82,8 +92,8 @@ checkSex <- function(ped, code_male = NULL, verbose = FALSE, repair = FALSE, rec #' @export #' #' @seealso \code{\link{checkSex}} -repairSex <- function(ped, verbose = FALSE, code_male = NULL) { - checkSex(ped = ped, verbose = verbose, repair = TRUE, code_male = code_male) +repairSex <- function(ped, verbose = FALSE, code_male = NULL, code_female = NULL) { + checkSex(ped = ped, verbose = verbose, repair = TRUE, code_male = code_male, code_female = code_female) } #' Recodes Sex Variable in a Pedigree Dataframe @@ -96,19 +106,31 @@ repairSex <- function(ped, verbose = FALSE, code_male = NULL) { #' @keywords internal #' @seealso \code{\link{plotPedigree}} recodeSex <- function( - ped, verbose = FALSE, code_male = NULL, code_na = NULL, + ped, verbose = FALSE, code_male = NULL, code_female = NULL, code_na = NULL, recode_male = "M", recode_female = "F", recode_na = NA_character_) { if (!is.null(code_na)) { ped$sex[ped$sex == code_na] <- NA } # Recode as "F" or "M" based on code_male, preserving NAs - if (!is.null(code_male)) { + if (!is.null(code_male) & is.null(code_female)) { # Initialize sex_recode as NA, preserving the length of the 'sex' column ped$sex_recode <- recode_na ped$sex_recode[ped$sex != code_male & !is.na(ped$sex)] <- recode_female ped$sex_recode[ped$sex == code_male] <- recode_male - } else { - ped$sex_recode <- ped$sex + # overwriting temp recode variable + ped$sex <- ped$sex_recode + ped$sex_recode <- NULL + + } else if(is.null(code_male) & !is.null(code_female)) { + # Initialize sex_recode as NA, preserving the length of the 'sex' column + ped$sex_recode <- recode_na + ped$sex_recode[ped$sex != code_female & !is.na(ped$sex)] <- recode_male + ped$sex_recode[ped$sex == code_female] <- recode_female + # overwriting temp recode variable + ped$sex <- ped$sex_recode + ped$sex_recode <- NULL } return(ped) } + +#%%% to do,: give option to rename the variable to anything the user specificies, recode doesn't actually make changes From a9c48c14f31d34e90c44d8555c0b53e559ac0f4e Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Thu, 16 Nov 2023 11:19:44 -0500 Subject: [PATCH 02/24] Update checkSex.R --- R/checkSex.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/checkSex.R b/R/checkSex.R index 8b2c356..f895fe4 100644 --- a/R/checkSex.R +++ b/R/checkSex.R @@ -44,8 +44,10 @@ checkSex <- function(ped, code_male = NULL, code_female = NULL,verbose = FALSE, ), paste0(validation_results$sex_unique)) } - - + validation_results$all_sex_dad <- names(sort(table(ped$sex[ped$ID %in% ped$dadID]), decreasing = TRUE)) + validation_results$all_sex_mom <- names(sort(table(ped$sex[ped$ID %in% ped$momID]), decreasing = TRUE)) + validation_results$most_frequent_sex_dad <- validation_results$all_sex_dad[1] + validation_results$most_frequent_sex_mom <- validation_results$all_sex_mom[1] if (repair) { if (verbose) { cat("Step 2: Attempting to repair sex coding...\n") From d6cfd699410496b5a72d4b2af978d3642329b838 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Thu, 16 Nov 2023 11:19:50 -0500 Subject: [PATCH 03/24] Create test-clean.R --- R/convertPedigree.R | 13 ++++++++----- R/plotPedigree.R | 2 +- tests/testthat/test-clean.R | 22 ++++++++++++++++++++++ vignettes/network.Rmd | 33 +++++++++++++++++---------------- 4 files changed, 48 insertions(+), 22 deletions(-) create mode 100644 tests/testthat/test-clean.R diff --git a/R/convertPedigree.R b/R/convertPedigree.R index 783891f..60989c2 100644 --- a/R/convertPedigree.R +++ b/R/convertPedigree.R @@ -194,7 +194,7 @@ ped2com <- function(ped, component, #' @export #' -ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE) { +ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE) { ped2com( ped = ped, max.gen = max.gen, @@ -202,7 +202,8 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA verbose = verbose, gc = gc, component = "additive", - flatten.diag = flatten.diag + flatten.diag = flatten.diag, + standardize.colnames = standardize.colnames ) } @@ -212,7 +213,7 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA #' @export #' @aliases ped2mt #' -ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE) { +ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE) { ped2com( ped = ped, max.gen = max.gen, @@ -220,7 +221,8 @@ ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALS verbose = verbose, gc = gc, component = "mitochondrial", - flatten.diag = flatten.diag + flatten.diag = flatten.diag, + standardize.colnames = standardize.colnames ) } @@ -240,7 +242,8 @@ ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FAL verbose = verbose, gc = gc, component = "common nuclear", - flatten.diag = flatten.diag + flatten.diag = flatten.diag, + standardize.colnames = standardize.colnames ) } diff --git a/R/plotPedigree.R b/R/plotPedigree.R index 3eae01c..87b2219 100644 --- a/R/plotPedigree.R +++ b/R/plotPedigree.R @@ -83,7 +83,7 @@ plotPedigree <- function(ped, id = p$id, dadid = p$father, momid = p$mother, - sex = p$sex_recode, + sex = p$sex, famid = p$ped ) p3 <- p2["1"] diff --git a/tests/testthat/test-clean.R b/tests/testthat/test-clean.R new file mode 100644 index 0000000..0864792 --- /dev/null +++ b/tests/testthat/test-clean.R @@ -0,0 +1,22 @@ +# Test that cleaning functions work +test_that("Check Sex", { + data(potter) + df_fam <- potter + df_fam$sex[df_fam$name=="Vernon Dursley"] <-0 + + checkSex( + df_fam, + code_male = 1, + verbose = TRUE, + repair = TRUE + ) + + + result <- calculateRelatedness(generations = 1, full = TRUE) + expect_equal(result, 0.5, tolerance = 1e-8) +}) + +test_that("calculateRelatedness function for half siblings", { + result <- calculateRelatedness(generations = 1, full = FALSE) + expect_equal(result, 0.25, tolerance = 1e-8) +}) diff --git a/vignettes/network.Rmd b/vignettes/network.Rmd index b6498f1..579adfe 100644 --- a/vignettes/network.Rmd +++ b/vignettes/network.Rmd @@ -36,7 +36,7 @@ structure inherent in pedigrees: ```{r setup} library(BGmisc) -data(hazard) +data(potter) ``` # Finding Extended Families @@ -49,18 +49,19 @@ all the extended families. People within the same extended family have at least some form of relation, however distant, while those in different extended families have no relations. -```{r, echo=FALSE, results='hide', out.width='50%', fig.cap="Hazard Pedigree"} -plotPedigree(hazard, code_male = 0, verbose = TRUE, ) +```{r, echo=FALSE, results='hide', out.width='50%', fig.cap="potter Pedigree"} +plotPedigree(potter, code_male = 1, verbose = TRUE) ``` -We will use the `hazard` pedigree data as an example. +We will use the `potter` pedigree data as an example. ```{r} -ds <- ped2fam(hazard, famID = "newFamID") -table(ds$FamID, ds$newFamID) +ds <- ped2fam(potter, famID = "newFamID", personID = "personID") +table(ds$famID, ds$newFamID) + ``` -Because the `hazard` data already had a family ID variable we compare +Because the `potter` data already had a family ID variable we compare our newly created variable to the pre-existing one. They match! # Computing Relatedness @@ -70,7 +71,7 @@ you'll likely want to know how much. For additive genetic relatedness, you can use the `ped2add()` function. ```{r} -add <- ped2add(hazard) +add <- ped2add(potter) ``` This computes the additive genetic relatedness for everyone in the data. @@ -96,9 +97,9 @@ family. ```{r} add_list <- lapply( - unique(hazard$FamID), + unique(potter$famID), function(d) { - tmp <- hazard[hazard$FamID %in% d, ] + tmp <- potter[potter$famID %in% d, ] ped2add(tmp) } ) @@ -113,10 +114,10 @@ extended family environment (`ped2ce`). ### Computing mitochondrial relatedness Here we calculate the mitochondrial relatedness between all pairs of -individuals in the `hazard` dataset. +individuals in the `potter` dataset. ```{r} -mit <- ped2mit(hazard) +mit <- ped2mit(potter) mit[1:7, 1:7] table(mit) ``` @@ -128,10 +129,10 @@ not. ### Computing relatedness through common nuclear environment Here we calculate the relatedness between all pairs of individuals in -the `hazard` dataset through sharing both parents. +the `potter` dataset through sharing both parents. ```{r} -commonNuclear <- ped2cn(hazard) +commonNuclear <- ped2cn(potter) commonNuclear[1:7, 1:7] table(commonNuclear) @@ -140,10 +141,10 @@ table(commonNuclear) ### Computing relatedness through common extended family environment Here we calculate the relatedness between all pairs of individuals in -the `hazard` dataset through sharing an extended family. +the `potter` dataset through sharing an extended family. ```{r} -extendedFamilyEnvironment <- ped2ce(hazard) +extendedFamilyEnvironment <- ped2ce(potter) extendedFamilyEnvironment[1:7, 1:7] table(extendedFamilyEnvironment) ``` From 3caa21e76707c2e264585abd8a163e75a6de6b80 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Fri, 17 Nov 2023 11:52:17 -0500 Subject: [PATCH 04/24] temp --- tests/testthat/test-clean.R | 22 ---------------------- tests/testthat/test-clean.X | 14 ++++++++++++++ 2 files changed, 14 insertions(+), 22 deletions(-) delete mode 100644 tests/testthat/test-clean.R create mode 100644 tests/testthat/test-clean.X diff --git a/tests/testthat/test-clean.R b/tests/testthat/test-clean.R deleted file mode 100644 index 0864792..0000000 --- a/tests/testthat/test-clean.R +++ /dev/null @@ -1,22 +0,0 @@ -# Test that cleaning functions work -test_that("Check Sex", { - data(potter) - df_fam <- potter - df_fam$sex[df_fam$name=="Vernon Dursley"] <-0 - - checkSex( - df_fam, - code_male = 1, - verbose = TRUE, - repair = TRUE - ) - - - result <- calculateRelatedness(generations = 1, full = TRUE) - expect_equal(result, 0.5, tolerance = 1e-8) -}) - -test_that("calculateRelatedness function for half siblings", { - result <- calculateRelatedness(generations = 1, full = FALSE) - expect_equal(result, 0.25, tolerance = 1e-8) -}) diff --git a/tests/testthat/test-clean.X b/tests/testthat/test-clean.X new file mode 100644 index 0000000..747b383 --- /dev/null +++ b/tests/testthat/test-clean.X @@ -0,0 +1,14 @@ +# Test that cleaning functions work +test_that("Check Sex", { + data(potter) + df_fam <- potter + df_fam$sex[df_fam$name=="Vernon Dursley"] <-0 + + checkSex( + df_fam, + code_male = 1, + verbose = TRUE, + repair = FALSE + ) + +}) From bc2387d770a74e928d4a493699808474d928596e Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Thu, 16 Nov 2023 11:19:50 -0500 Subject: [PATCH 05/24] Create test-clean.R --- R/convertPedigree.R | 13 ++++++++----- R/plotPedigree.R | 2 +- tests/testthat/test-clean.R | 15 +++++++++++++++ vignettes/network.Rmd | 33 +++++++++++++++++---------------- 4 files changed, 41 insertions(+), 22 deletions(-) create mode 100644 tests/testthat/test-clean.R diff --git a/R/convertPedigree.R b/R/convertPedigree.R index 783891f..60989c2 100644 --- a/R/convertPedigree.R +++ b/R/convertPedigree.R @@ -194,7 +194,7 @@ ped2com <- function(ped, component, #' @export #' -ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE) { +ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE) { ped2com( ped = ped, max.gen = max.gen, @@ -202,7 +202,8 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA verbose = verbose, gc = gc, component = "additive", - flatten.diag = flatten.diag + flatten.diag = flatten.diag, + standardize.colnames = standardize.colnames ) } @@ -212,7 +213,7 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA #' @export #' @aliases ped2mt #' -ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE) { +ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE) { ped2com( ped = ped, max.gen = max.gen, @@ -220,7 +221,8 @@ ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALS verbose = verbose, gc = gc, component = "mitochondrial", - flatten.diag = flatten.diag + flatten.diag = flatten.diag, + standardize.colnames = standardize.colnames ) } @@ -240,7 +242,8 @@ ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FAL verbose = verbose, gc = gc, component = "common nuclear", - flatten.diag = flatten.diag + flatten.diag = flatten.diag, + standardize.colnames = standardize.colnames ) } diff --git a/R/plotPedigree.R b/R/plotPedigree.R index 3eae01c..87b2219 100644 --- a/R/plotPedigree.R +++ b/R/plotPedigree.R @@ -83,7 +83,7 @@ plotPedigree <- function(ped, id = p$id, dadid = p$father, momid = p$mother, - sex = p$sex_recode, + sex = p$sex, famid = p$ped ) p3 <- p2["1"] diff --git a/tests/testthat/test-clean.R b/tests/testthat/test-clean.R new file mode 100644 index 0000000..ef8aebe --- /dev/null +++ b/tests/testthat/test-clean.R @@ -0,0 +1,15 @@ +# Test that cleaning functions work +test_that("Check Sex", { + data(potter) + df_fam <- potter + df_fam$sex[df_fam$name=="Vernon Dursley"] <- 0 + + result <- checkSex( + df_fam, + code_male = 1, + verbose = FALSE, + repair = TRUE + ) + expect_equal(result[[2]]$sex[result[[2]][["name"]]=="Vernon Dursley"], "M", tolerance = 1e-8) +}) + diff --git a/vignettes/network.Rmd b/vignettes/network.Rmd index b6498f1..579adfe 100644 --- a/vignettes/network.Rmd +++ b/vignettes/network.Rmd @@ -36,7 +36,7 @@ structure inherent in pedigrees: ```{r setup} library(BGmisc) -data(hazard) +data(potter) ``` # Finding Extended Families @@ -49,18 +49,19 @@ all the extended families. People within the same extended family have at least some form of relation, however distant, while those in different extended families have no relations. -```{r, echo=FALSE, results='hide', out.width='50%', fig.cap="Hazard Pedigree"} -plotPedigree(hazard, code_male = 0, verbose = TRUE, ) +```{r, echo=FALSE, results='hide', out.width='50%', fig.cap="potter Pedigree"} +plotPedigree(potter, code_male = 1, verbose = TRUE) ``` -We will use the `hazard` pedigree data as an example. +We will use the `potter` pedigree data as an example. ```{r} -ds <- ped2fam(hazard, famID = "newFamID") -table(ds$FamID, ds$newFamID) +ds <- ped2fam(potter, famID = "newFamID", personID = "personID") +table(ds$famID, ds$newFamID) + ``` -Because the `hazard` data already had a family ID variable we compare +Because the `potter` data already had a family ID variable we compare our newly created variable to the pre-existing one. They match! # Computing Relatedness @@ -70,7 +71,7 @@ you'll likely want to know how much. For additive genetic relatedness, you can use the `ped2add()` function. ```{r} -add <- ped2add(hazard) +add <- ped2add(potter) ``` This computes the additive genetic relatedness for everyone in the data. @@ -96,9 +97,9 @@ family. ```{r} add_list <- lapply( - unique(hazard$FamID), + unique(potter$famID), function(d) { - tmp <- hazard[hazard$FamID %in% d, ] + tmp <- potter[potter$famID %in% d, ] ped2add(tmp) } ) @@ -113,10 +114,10 @@ extended family environment (`ped2ce`). ### Computing mitochondrial relatedness Here we calculate the mitochondrial relatedness between all pairs of -individuals in the `hazard` dataset. +individuals in the `potter` dataset. ```{r} -mit <- ped2mit(hazard) +mit <- ped2mit(potter) mit[1:7, 1:7] table(mit) ``` @@ -128,10 +129,10 @@ not. ### Computing relatedness through common nuclear environment Here we calculate the relatedness between all pairs of individuals in -the `hazard` dataset through sharing both parents. +the `potter` dataset through sharing both parents. ```{r} -commonNuclear <- ped2cn(hazard) +commonNuclear <- ped2cn(potter) commonNuclear[1:7, 1:7] table(commonNuclear) @@ -140,10 +141,10 @@ table(commonNuclear) ### Computing relatedness through common extended family environment Here we calculate the relatedness between all pairs of individuals in -the `hazard` dataset through sharing an extended family. +the `potter` dataset through sharing an extended family. ```{r} -extendedFamilyEnvironment <- ped2ce(hazard) +extendedFamilyEnvironment <- ped2ce(potter) extendedFamilyEnvironment[1:7, 1:7] table(extendedFamilyEnvironment) ``` From c387163d7b2b0b7a58ccfd59c7fb86484c617d74 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Mon, 20 Nov 2023 09:13:14 -0500 Subject: [PATCH 06/24] merge to upload to utah server --- R/convertPedigree.R | 2 +- man/checkSex.Rd | 12 ++++++------ man/ped2add.Rd | 5 ++++- man/ped2mit.Rd | 5 ++++- man/potter.Rd | 16 ++++++++++------ man/recodeSex.Rd | 5 ++++- man/repairSex.Rd | 6 ++++-- tests/testthat/test-clean.R | 15 --------------- tests/testthat/test-clean.X | 11 ++++++----- .../figure-html/unnamed-chunk-2-1.png | Bin 0 -> 3138 bytes 10 files changed, 39 insertions(+), 38 deletions(-) delete mode 100644 tests/testthat/test-clean.R create mode 100644 vignettes/network_files/figure-html/unnamed-chunk-2-1.png diff --git a/R/convertPedigree.R b/R/convertPedigree.R index 60989c2..c4d49da 100644 --- a/R/convertPedigree.R +++ b/R/convertPedigree.R @@ -234,7 +234,7 @@ ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALS #' @details The algorithms and methodologies used in this function are further discussed and exemplified in the vignette titled "examplePedigreeFunctions". #' @export #' -ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE) { +ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE) { ped2com( ped = ped, max.gen = max.gen, diff --git a/man/checkSex.Rd b/man/checkSex.Rd index 9d6fb61..1dba27a 100644 --- a/man/checkSex.Rd +++ b/man/checkSex.Rd @@ -7,21 +7,21 @@ checkSex( ped, code_male = NULL, + code_female = NULL, verbose = FALSE, - repair = FALSE, - recode = FALSE + repair = FALSE ) } \arguments{ \item{ped}{A dataframe representing the pedigree data with a 'sex' column.} -\item{code_male}{The code used to represent males in the 'sex' column. If NULL, no recoding is performed.} +\item{code_male}{The code used to represent males in the 'sex' column. If both male and female are NULL, no recoding is performed.} + +\item{code_female}{The code used to represent females in the 'sex' column. If both male and female are NULL, no recoding is performed.} \item{verbose}{A logical flag indicating whether to print progress and validation messages to the console.} \item{repair}{A logical flag indicating whether to attempt repairs on the sex coding.} - -\item{recode}{A logical flag indicating whether to recode the 'sex' variable.} } \value{ Depending on the value of `repair`, either a list containing validation results or a repaired dataframe is returned. @@ -34,6 +34,6 @@ This function performs two main tasks: \examples{ \dontrun{ ped <- data.frame(ID = c(1, 2, 3), sex = c("M", "F", "M")) -checkSex(ped, code_male = "M", verbose = TRUE, repair = FALSE, recode = TRUE) +checkSex(ped, code_male = "M", verbose = TRUE, repair = FALSE) } } diff --git a/man/ped2add.Rd b/man/ped2add.Rd index ee6e054..920e670 100644 --- a/man/ped2add.Rd +++ b/man/ped2add.Rd @@ -10,7 +10,8 @@ ped2add( sparse = FALSE, verbose = FALSE, gc = FALSE, - flatten.diag = FALSE + flatten.diag = FALSE, + standardize.colnames = TRUE ) } \arguments{ @@ -27,6 +28,8 @@ generations as there are in the data.} \item{gc}{logical. If TRUE, do frequent garbage collection via \code{\link{gc}} to save memory} \item{flatten.diag}{logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones} + +\item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset} } \description{ Take a pedigree and turn it into an additive genetics relatedness matrix diff --git a/man/ped2mit.Rd b/man/ped2mit.Rd index af6f739..3962f27 100644 --- a/man/ped2mit.Rd +++ b/man/ped2mit.Rd @@ -11,7 +11,8 @@ ped2mit( sparse = FALSE, verbose = FALSE, gc = FALSE, - flatten.diag = FALSE + flatten.diag = FALSE, + standardize.colnames = TRUE ) } \arguments{ @@ -28,6 +29,8 @@ generations as there are in the data.} \item{gc}{logical. If TRUE, do frequent garbage collection via \code{\link{gc}} to save memory} \item{flatten.diag}{logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones} + +\item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset} } \description{ Take a pedigree and turn it into a mitochondrial relatedness matrix diff --git a/man/potter.Rd b/man/potter.Rd index cae5c56..6d06cb4 100755 --- a/man/potter.Rd +++ b/man/potter.Rd @@ -5,7 +5,7 @@ \alias{potter} \title{Fictional pedigree data on a wizarding family} \format{ -A data frame (and ped object) with 24 rows and 5 variables +A data frame (and ped object) with 36 rows and 8 variables } \usage{ data(potter) @@ -17,13 +17,17 @@ A dataset created purely from imagination that includes a subset of the Potter e The variables are as follows: \itemize{ - \item ID. Person identification variable + \item personID. Person identification variable + \item famID. Family identification variable + \item name. Name of the person + \item gen. Generation of the person + \item momID. ID of the mother + \item dadID. ID of the father + \item spouseID. ID of the spouse \item sex. Sex of the ID: 1 is male; 0 is female - \item maID. ID of the mother - \item paID. ID of the father - \item Name. Name of the person + } -Negative \code{maID}s and \code{paID}s are for people not in the dataset. +IDs in the 100s \code{momID}s and \code{dadID}s are for people not in the dataset. } \keyword{datasets} diff --git a/man/recodeSex.Rd b/man/recodeSex.Rd index 5e8bf39..1bfd704 100644 --- a/man/recodeSex.Rd +++ b/man/recodeSex.Rd @@ -8,6 +8,7 @@ recodeSex( ped, verbose = FALSE, code_male = NULL, + code_female = NULL, code_na = NULL, recode_male = "M", recode_female = "F", @@ -19,7 +20,9 @@ recodeSex( \item{verbose}{A logical flag indicating whether to print progress and validation messages to the console.} -\item{code_male}{The code used to represent males in the 'sex' column. If NULL, no recoding is performed.} +\item{code_male}{The code used to represent males in the 'sex' column. If both male and female are NULL, no recoding is performed.} + +\item{code_female}{The code used to represent females in the 'sex' column. If both male and female are NULL, no recoding is performed.} } \value{ A modified version of the input data.frame \code{ped}, containing an additional or modified 'sex_recode' column where the 'sex' values are recoded according to \code{code_male}. NA values in the 'sex' column are preserved. diff --git a/man/repairSex.Rd b/man/repairSex.Rd index cfbfbc3..f15896d 100644 --- a/man/repairSex.Rd +++ b/man/repairSex.Rd @@ -4,14 +4,16 @@ \alias{repairSex} \title{Repairs Sex Coding in a Pedigree Dataframe} \usage{ -repairSex(ped, verbose = FALSE, code_male = NULL) +repairSex(ped, verbose = FALSE, code_male = NULL, code_female = NULL) } \arguments{ \item{ped}{A dataframe representing the pedigree data with a 'sex' column.} \item{verbose}{A logical flag indicating whether to print progress and validation messages to the console.} -\item{code_male}{The code used to represent males in the 'sex' column. If NULL, no recoding is performed.} +\item{code_male}{The code used to represent males in the 'sex' column. If both male and female are NULL, no recoding is performed.} + +\item{code_female}{The code used to represent females in the 'sex' column. If both male and female are NULL, no recoding is performed.} } \value{ A dataframe where the sex coding has been repaired. diff --git a/tests/testthat/test-clean.R b/tests/testthat/test-clean.R deleted file mode 100644 index ef8aebe..0000000 --- a/tests/testthat/test-clean.R +++ /dev/null @@ -1,15 +0,0 @@ -# Test that cleaning functions work -test_that("Check Sex", { - data(potter) - df_fam <- potter - df_fam$sex[df_fam$name=="Vernon Dursley"] <- 0 - - result <- checkSex( - df_fam, - code_male = 1, - verbose = FALSE, - repair = TRUE - ) - expect_equal(result[[2]]$sex[result[[2]][["name"]]=="Vernon Dursley"], "M", tolerance = 1e-8) -}) - diff --git a/tests/testthat/test-clean.X b/tests/testthat/test-clean.X index 747b383..ef8aebe 100644 --- a/tests/testthat/test-clean.X +++ b/tests/testthat/test-clean.X @@ -2,13 +2,14 @@ test_that("Check Sex", { data(potter) df_fam <- potter - df_fam$sex[df_fam$name=="Vernon Dursley"] <-0 + df_fam$sex[df_fam$name=="Vernon Dursley"] <- 0 - checkSex( + result <- checkSex( df_fam, code_male = 1, - verbose = TRUE, - repair = FALSE + verbose = FALSE, + repair = TRUE ) - + expect_equal(result[[2]]$sex[result[[2]][["name"]]=="Vernon Dursley"], "M", tolerance = 1e-8) }) + diff --git a/vignettes/network_files/figure-html/unnamed-chunk-2-1.png b/vignettes/network_files/figure-html/unnamed-chunk-2-1.png new file mode 100644 index 0000000000000000000000000000000000000000..1a7cd3fc7a06232e948b804e87fe1eedc0a829ea GIT binary patch literal 3138 zcmcImXH-+$5)Od~31Scnf-Q8sdO-++gewH4gkp$vkfM}OH3%j#5Fnrkh)C!PD8Y*$ zD0pc{6PikqDjTZ#_Q>4GSC1Hgj>wScWmfQ|y_cmNQj z(g7|22%;MRu)zg3Hn?;YmyYMs>0AKM1?XI^Km>6vcVk0PLJ;0$ZCaaLfiLX0mVQCs z&>)Oc2ne*JVRH$+Aw2d1fyA}Uj0|nB<;>(rgmE!@VpMkf!l1Zv#bLD@ED=>=!)30b z((=ZJyRYJu=QvN#M=`NWRrmAYa4BK7zb0d5!0!&%#*F#3_NAw^kkC#^$^RSBx3xfS zjVZzG6_;uz6C2E`gjK}tBa-pLldoD*-a(F9t1;e3rP@f^T5@O3`GOHnNY(}8w<7rl zt%@*oQ>Ye%t{TdtrS(s0As&sI3HxuD^{7JFUtlSp4@&qpQTK{0-gX;z-Pbsx+6-ZX zaVwK)bM^|dt0 zQRrGW5{XKHk)-SSe>9H5l_WZ6fB1%l17QnEt;6m>Y>xJF)mnGy3uYK)?;aOdUOmfc zQLNP*a;?IEcxAW-OqtaU086k#krb1lRow8b=P5!>`O6uC@wrRyh9G? z2UWR;hf%_mVRbqBRYzNLXV!wrbGc*i>p9AJ;o`bb{+raydKOfi&l;|;cJWvcO@Vyj z&V8FAt7EZ*<#kGUAOY-OC+lLUf0az-bB(nl5p&*$;%GE6vHuBL^b@+%vNIi6+mt}< zac8ZaV~!>g`HUQF(NvhmC^#NPR?4klp%9Tn(uni-4P z{pYCHS6`DHmFgD1iRf~;<<+>`@-kQBd2iEyzu(V#*#`EG*!k&@{5eI>l9CjT-a+$x z8KDveLhh>A`Y!L?6+(Fxk35Q;CZc8Do-%rfiErPQ2Ix{A(mt|}^i&)%=)ee<@6W`| z%1IfUx4npV;obkbNQ!qd8I$@aJsqO>K-2+_(R&dZti;A5!7xTN^}Sq=lj>cOk47;t zOo7b8us&fTev59@d!4)zoSOmG`jP_0bg0VIYqOeoUBj7KMkjT@2sVkM*A>!KONwCo!x1 zp7Tfd>}6Pq2ISJ-Mzb(-{|q;eivWKzSYrckkBhgIFl&NzL3Xb6h7tvDug5fS$mnSz$89T;!KM+ zRe1lNFFLEk=X@h6SdoTT$M>=HP`WVC5)T#ATe&{$^z}e*GruJ8)PU(1z9R)3gsoil zejgEX&1-$-`tim=*AsQRH~HkTaB_5vGxEV}e-57?bcJO&t-@RiI-J)h>vMN$oVp(iq9C`3$s@^LYv!tQZ>z7J!>!}Y4iNhTya)tyV^I;(W;uZH-03y56_36 zh@`C^XZ#pBt~x}ReX6S~PW7rVK`*PgD)j%^%>mtueB$#1MRAr!Oi4E?m!uY+5VAJ# za$nOKvlqcMAu0DbS*dj`@jG1TR=o)aS_BcEg6c*6wxZ3y3sY1;GY}=6}yc< z9FL~G6a#}5#C~SrD$?QLHn`|R_ovzhXE6Cpr2>2gN8=J<=@@CclX7yzGUS!J*Y-lz zrr%kkc4dGv?_jr7)#c|Y^yzH-v0hK}A{mPg3!_D?60R@W$p&c=d)MxC2#DFHm5JRC zRVDkoO}ME^Ps)L!D!;;7t`*Dftk@rucdjr;=y6YvQBk>zd_jjzgcM`;LM_KiI8B#G zDoV+SlOe~o>OJb_o~@16EbKUD*CkcfSaUme5lmCo7fn>P%dlwFw9;3&bbvAB!)dcV zQBYaoNm=M21aY2lAac4yO+>(CoV7O-7Xp%q=B&RfWO{KhXc-&Rv>kk_Pe?d!#kmOn zr{#WeF{^{;IKzMNZWqxsc?YU5mbzx8kN0$KGM9^fIW)z3{q|`#r;b`314mWeq3!i| zuRAF8tF1YD+jPm&xy`n00NYIV zFY(N}TxS{Du-et~^3g9d*bi%3W#uDAcL$~$Pa-L1YtNu?xu>Pjeba?hYd!#a>{gs^3zQJt2 zN+P+i?7N`G+{TXi$?W7^rm0fSZCVt=2G)6>gWcHLNa7(%!)gt;^JP=)n#~Kfz0Y!h zEDfRcbxT>X;pIdwYpUPfBPl7=)|Wg+;5B0p95M;i7;AlalNa_;Tf{cqjBvNzexM@| zSU=(-oqE)va~mI-XNi{Wjyh#-V3k$yg_fq}r%^G;m-4x+zuc#B7U`~Bdr|xRMLlGV z=32}rwd|SBNaZx>VYQrlN{N7tD7X;DPwXnBO6rUmEgjDNku z5mxNVg&wa)RE3bAclT~9aQuLJy_^AIIZ`TD}xb=MyqPW>0M@t6H)S0 z$3Uu?o;NkCRm7Wh%Jj14CTPtBFFa@1R9X_pB(6%1r7n^qQb_W)QaCp<4&ezG^Odv= zx6#>&!>_!9z@eB(rrl7XAAa zg#+Wp+UFzozmaEWpmsX}T1QHJT92#G`$YL~GZ}v3*R}3_5*1uJS2hq{aQUfYf1^2Q zUis)@_8AND!{0R)1B+@MPq${EfSKRUuMO0154*l7Wnj{GjE5LEf6=kMKRzcwHuGMm zAUE)YjOsVZ>d2)fW$nNIQamloA6HwZ6`AX?GxV23zOYl2CKg8}JOZmTir=3;*}uBS zGvv;9huj!qqAd(J(=Ju=!86&%A{?n{TjWveV{v#F|Cpm)dL{l_aH!mn`!>jHX7jUs z)$G+hd#17+q3A>%ix)SOj34~U#|I8tH<1J>xhg-L7*xB!_R+%oVk?=3hEz)Le$(sW zmJ9ju>7br#6*p+q>E9Lu=knOe-WE2pZiYm+X*Sr-!FX#w*+G%eKIr`b>U6+I{qB!u og3nOziT-Q|`T2 Date: Mon, 20 Nov 2023 13:27:26 -0500 Subject: [PATCH 07/24] fix --- NEWS.md | 2 +- man/ped2cn.Rd | 5 +- vignettes/network.html | 113 +++++++++--------- .../figure-html/unnamed-chunk-2-1.png | Bin 3138 -> 0 bytes 4 files changed, 61 insertions(+), 59 deletions(-) delete mode 100644 vignettes/network_files/figure-html/unnamed-chunk-2-1.png diff --git a/NEWS.md b/NEWS.md index f6f7e28..e57bafc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ # BGmisc 1.1.0 -* Added ability to simulate twins, and harry potter dataset +* Added ability to simulate twins, trance paternal and maternal lines, and harry potter pedigree # BGmisc 1.0.1 * Hot fix to resolve plotPedigree wrapper function breaking for pedigrees that contained multiple families diff --git a/man/ped2cn.Rd b/man/ped2cn.Rd index af35226..7f5c4e6 100644 --- a/man/ped2cn.Rd +++ b/man/ped2cn.Rd @@ -10,7 +10,8 @@ ped2cn( sparse = FALSE, verbose = FALSE, gc = FALSE, - flatten.diag = FALSE + flatten.diag = FALSE, + standardize.colnames = TRUE ) } \arguments{ @@ -27,6 +28,8 @@ generations as there are in the data.} \item{gc}{logical. If TRUE, do frequent garbage collection via \code{\link{gc}} to save memory} \item{flatten.diag}{logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones} + +\item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset} } \description{ Take a pedigree and turn it into a common nuclear environmental relatedness matrix diff --git a/vignettes/network.html b/vignettes/network.html index 1ea4187..c7f32e4 100644 --- a/vignettes/network.html +++ b/vignettes/network.html @@ -360,7 +360,7 @@

Introduction

Loading Required Libraries and Data

library(BGmisc)
-data(hazard)
+data(potter)
@@ -373,19 +373,18 @@

Finding Extended Families

at least some form of relation, however distant, while those in different extended families have no relations.

-Hazard Pedigree +potter Pedigree

-Hazard Pedigree +potter Pedigree

-

We will use the hazard pedigree data as an example.

-
ds <- ped2fam(hazard, famID = "newFamID")
-table(ds$FamID, ds$newFamID)
+
We will use the potter pedigree data as an example.

+
ds <- ped2fam(potter, famID = "newFamID", personID = "personID")
+table(ds$famID, ds$newFamID)
 #>    
-#>      1  2
-#>   1 18  0
-#>   2  0 25

-
Because the hazard data already had a family ID variable
+#>      1
+#>   1 36
+

Because the potter data already had a family ID variable we compare our newly created variable to the pre-existing one. They match!

@@ -394,34 +393,34 @@

Computing Relatedness

Once you know which sets of people are related at all to one another, you’ll likely want to know how much. For additive genetic relatedness, you can use the ped2add() function.

-
add <- ped2add(hazard)
+
add <- ped2add(potter)

This computes the additive genetic relatedness for everyone in the data. It returns a square, symmetric matrix that has as many rows and columns as there are IDs.

add[1:7, 1:7]
-#>     1   2   3   4 7   5   6
-#> 1 1.0 0.0 0.5 0.5 0 0.5 0.5
-#> 2 0.0 1.0 0.5 0.5 0 0.5 0.5
-#> 3 0.5 0.5 1.0 0.5 0 0.5 0.5
-#> 4 0.5 0.5 0.5 1.0 0 0.5 0.5
-#> 7 0.0 0.0 0.0 0.0 1 0.0 0.0
-#> 5 0.5 0.5 0.5 0.5 0 1.0 0.5
-#> 6 0.5 0.5 0.5 0.5 0 0.5 1.0
+#> 1 2 3 4 5 6 7 +#> 1 1.0 0.50 0.00 0.00 0.0 0.500 0.000 +#> 2 0.5 1.00 0.00 0.00 0.0 0.250 0.000 +#> 3 0.0 0.00 1.00 0.50 0.0 0.500 0.250 +#> 4 0.0 0.00 0.50 1.00 0.0 0.250 0.500 +#> 5 0.0 0.00 0.00 0.00 1.0 0.000 0.500 +#> 6 0.5 0.25 0.50 0.25 0.0 1.000 0.125 +#> 7 0.0 0.00 0.25 0.50 0.5 0.125 1.000

The entry in the ith row and the jth column gives the relatedness between person i and person j. For example, person 1 and person 11 share -0.125

+0

table(add)
 #> add
 #>      0 0.0625  0.125   0.25    0.5      1 
-#>   1144    110    182    188    182     43
+#> 788 6 94 208 164 36

It’s probably fine to do this on the whole dataset when your data have fewer than 10,000 people. When the data get large, however, it’s much more efficient to compute this relatedness separately for each extended family.

add_list <- lapply(
-  unique(hazard$FamID),
+  unique(potter$famID),
   function(d) {
-    tmp <- hazard[hazard$FamID %in% d, ]
+    tmp <- potter[potter$famID %in% d, ]
     ped2add(tmp)
   }
 )
@@ -434,64 +433,64 @@

Other relatedness measures

Computing mitochondrial relatedness

Here we calculate the mitochondrial relatedness between all pairs of -individuals in the hazard dataset.

-
mit <- ped2mit(hazard)
+individuals in the potter dataset.

+
mit <- ped2mit(potter)
 mit[1:7, 1:7]
-#>   1 2 3 4 7 5 6
-#> 1 1 0 1 1 0 1 1
-#> 2 0 1 0 0 0 0 0
-#> 3 1 0 1 1 0 1 1
-#> 4 1 0 1 1 0 1 1
-#> 7 0 0 0 0 1 0 0
-#> 5 1 0 1 1 0 1 1
-#> 6 1 0 1 1 0 1 1
+#>   1 2 3 4 5 6 7
+#> 1 1 1 0 0 0 0 0
+#> 2 1 1 0 0 0 0 0
+#> 3 0 0 1 1 0 1 1
+#> 4 0 0 1 1 0 1 1
+#> 5 0 0 0 0 1 0 0
+#> 6 0 0 1 1 0 1 1
+#> 7 0 0 1 1 0 1 1
 table(mit)
 #> mit
 #>    0    1 
-#> 1590  259

+#> 1082  214

As you can see, some of the family members share mitochrondial DNA, -such as person 1 and person 3 1, whereas person 1 and person 2 do +such as person 1 and person 3 0, whereas person 1 and person 2 do not.

Computing relatedness through common nuclear environment

Here we calculate the relatedness between all pairs of individuals in -the hazard dataset through sharing both parents.

-
commonNuclear <- ped2cn(hazard)
+the potter dataset through sharing both parents.

+
commonNuclear <- ped2cn(potter)
 commonNuclear[1:7, 1:7]
-#>   1 2 3 4 7 5 6
-#> 1 1 0 0 0 0 0 0
-#> 2 0 1 0 0 0 0 0
-#> 3 0 0 1 1 0 1 1
-#> 4 0 0 1 1 0 1 1
-#> 7 0 0 0 0 1 0 0
-#> 5 0 0 1 1 0 1 1
-#> 6 0 0 1 1 0 1 1
+#>   1 2 3 4 5 6 7
+#> 1 1 1 0 0 0 0 0
+#> 2 1 1 0 0 0 0 0
+#> 3 0 0 1 1 0 0 0
+#> 4 0 0 1 1 0 0 0
+#> 5 0 0 0 0 1 0 0
+#> 6 0 0 0 0 0 1 0
+#> 7 0 0 0 0 0 0 1
 
 table(commonNuclear)
 #> commonNuclear
 #>    0    1 
-#> 1744  105

+#> 1196  100

Computing relatedness through common extended family environment

Here we calculate the relatedness between all pairs of individuals in -the hazard dataset through sharing an extended family.

-
extendedFamilyEnvironment <- ped2ce(hazard)
+the potter dataset through sharing an extended family.

+
extendedFamilyEnvironment <- ped2ce(potter)
 extendedFamilyEnvironment[1:7, 1:7]
-#>   1 2 3 4 7 5 6
-#> 1 1 1 1 1 1 1 1
-#> 2 1 1 1 1 1 1 1
-#> 3 1 1 1 1 1 1 1
-#> 4 1 1 1 1 1 1 1
-#> 7 1 1 1 1 1 1 1
-#> 5 1 1 1 1 1 1 1
-#> 6 1 1 1 1 1 1 1
+#>      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
+#> [1,]    1    1    1    1    1    1    1
+#> [2,]    1    1    1    1    1    1    1
+#> [3,]    1    1    1    1    1    1    1
+#> [4,]    1    1    1    1    1    1    1
+#> [5,]    1    1    1    1    1    1    1
+#> [6,]    1    1    1    1    1    1    1
+#> [7,]    1    1    1    1    1    1    1
 table(extendedFamilyEnvironment)
 #> extendedFamilyEnvironment
 #>    1 
-#> 1849

+#> 1296
diff --git a/vignettes/network_files/figure-html/unnamed-chunk-2-1.png b/vignettes/network_files/figure-html/unnamed-chunk-2-1.png deleted file mode 100644 index 1a7cd3fc7a06232e948b804e87fe1eedc0a829ea..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 3138 zcmcImXH-+$5)Od~31Scnf-Q8sdO-++gewH4gkp$vkfM}OH3%j#5Fnrkh)C!PD8Y*$ zD0pc{6PikqDjTZ#_Q>4GSC1Hgj>wScWmfQ|y_cmNQj z(g7|22%;MRu)zg3Hn?;YmyYMs>0AKM1?XI^Km>6vcVk0PLJ;0$ZCaaLfiLX0mVQCs z&>)Oc2ne*JVRH$+Aw2d1fyA}Uj0|nB<;>(rgmE!@VpMkf!l1Zv#bLD@ED=>=!)30b z((=ZJyRYJu=QvN#M=`NWRrmAYa4BK7zb0d5!0!&%#*F#3_NAw^kkC#^$^RSBx3xfS zjVZzG6_;uz6C2E`gjK}tBa-pLldoD*-a(F9t1;e3rP@f^T5@O3`GOHnNY(}8w<7rl zt%@*oQ>Ye%t{TdtrS(s0As&sI3HxuD^{7JFUtlSp4@&qpQTK{0-gX;z-Pbsx+6-ZX zaVwK)bM^|dt0 zQRrGW5{XKHk)-SSe>9H5l_WZ6fB1%l17QnEt;6m>Y>xJF)mnGy3uYK)?;aOdUOmfc zQLNP*a;?IEcxAW-OqtaU086k#krb1lRow8b=P5!>`O6uC@wrRyh9G? z2UWR;hf%_mVRbqBRYzNLXV!wrbGc*i>p9AJ;o`bb{+raydKOfi&l;|;cJWvcO@Vyj z&V8FAt7EZ*<#kGUAOY-OC+lLUf0az-bB(nl5p&*$;%GE6vHuBL^b@+%vNIi6+mt}< zac8ZaV~!>g`HUQF(NvhmC^#NPR?4klp%9Tn(uni-4P z{pYCHS6`DHmFgD1iRf~;<<+>`@-kQBd2iEyzu(V#*#`EG*!k&@{5eI>l9CjT-a+$x z8KDveLhh>A`Y!L?6+(Fxk35Q;CZc8Do-%rfiErPQ2Ix{A(mt|}^i&)%=)ee<@6W`| z%1IfUx4npV;obkbNQ!qd8I$@aJsqO>K-2+_(R&dZti;A5!7xTN^}Sq=lj>cOk47;t zOo7b8us&fTev59@d!4)zoSOmG`jP_0bg0VIYqOeoUBj7KMkjT@2sVkM*A>!KONwCo!x1 zp7Tfd>}6Pq2ISJ-Mzb(-{|q;eivWKzSYrckkBhgIFl&NzL3Xb6h7tvDug5fS$mnSz$89T;!KM+ zRe1lNFFLEk=X@h6SdoTT$M>=HP`WVC5)T#ATe&{$^z}e*GruJ8)PU(1z9R)3gsoil zejgEX&1-$-`tim=*AsQRH~HkTaB_5vGxEV}e-57?bcJO&t-@RiI-J)h>vMN$oVp(iq9C`3$s@^LYv!tQZ>z7J!>!}Y4iNhTya)tyV^I;(W;uZH-03y56_36 zh@`C^XZ#pBt~x}ReX6S~PW7rVK`*PgD)j%^%>mtueB$#1MRAr!Oi4E?m!uY+5VAJ# za$nOKvlqcMAu0DbS*dj`@jG1TR=o)aS_BcEg6c*6wxZ3y3sY1;GY}=6}yc< z9FL~G6a#}5#C~SrD$?QLHn`|R_ovzhXE6Cpr2>2gN8=J<=@@CclX7yzGUS!J*Y-lz zrr%kkc4dGv?_jr7)#c|Y^yzH-v0hK}A{mPg3!_D?60R@W$p&c=d)MxC2#DFHm5JRC zRVDkoO}ME^Ps)L!D!;;7t`*Dftk@rucdjr;=y6YvQBk>zd_jjzgcM`;LM_KiI8B#G zDoV+SlOe~o>OJb_o~@16EbKUD*CkcfSaUme5lmCo7fn>P%dlwFw9;3&bbvAB!)dcV zQBYaoNm=M21aY2lAac4yO+>(CoV7O-7Xp%q=B&RfWO{KhXc-&Rv>kk_Pe?d!#kmOn zr{#WeF{^{;IKzMNZWqxsc?YU5mbzx8kN0$KGM9^fIW)z3{q|`#r;b`314mWeq3!i| zuRAF8tF1YD+jPm&xy`n00NYIV zFY(N}TxS{Du-et~^3g9d*bi%3W#uDAcL$~$Pa-L1YtNu?xu>Pjeba?hYd!#a>{gs^3zQJt2 zN+P+i?7N`G+{TXi$?W7^rm0fSZCVt=2G)6>gWcHLNa7(%!)gt;^JP=)n#~Kfz0Y!h zEDfRcbxT>X;pIdwYpUPfBPl7=)|Wg+;5B0p95M;i7;AlalNa_;Tf{cqjBvNzexM@| zSU=(-oqE)va~mI-XNi{Wjyh#-V3k$yg_fq}r%^G;m-4x+zuc#B7U`~Bdr|xRMLlGV z=32}rwd|SBNaZx>VYQrlN{N7tD7X;DPwXnBO6rUmEgjDNku z5mxNVg&wa)RE3bAclT~9aQuLJy_^AIIZ`TD}xb=MyqPW>0M@t6H)S0 z$3Uu?o;NkCRm7Wh%Jj14CTPtBFFa@1R9X_pB(6%1r7n^qQb_W)QaCp<4&ezG^Odv= zx6#>&!>_!9z@eB(rrl7XAAa zg#+Wp+UFzozmaEWpmsX}T1QHJT92#G`$YL~GZ}v3*R}3_5*1uJS2hq{aQUfYf1^2Q zUis)@_8AND!{0R)1B+@MPq${EfSKRUuMO0154*l7Wnj{GjE5LEf6=kMKRzcwHuGMm zAUE)YjOsVZ>d2)fW$nNIQamloA6HwZ6`AX?GxV23zOYl2CKg8}JOZmTir=3;*}uBS zGvv;9huj!qqAd(J(=Ju=!86&%A{?n{TjWveV{v#F|Cpm)dL{l_aH!mn`!>jHX7jUs z)$G+hd#17+q3A>%ix)SOj34~U#|I8tH<1J>xhg-L7*xB!_R+%oVk?=3hEz)Le$(sW zmJ9ju>7br#6*p+q>E9Lu=knOe-WE2pZiYm+X*Sr-!FX#w*+G%eKIr`b>U6+I{qB!u og3nOziT-Q|`T2 Date: Mon, 20 Nov 2023 18:30:39 +0000 Subject: [PATCH 08/24] Saved new PDF of paper --- vignettes/articles/paper.pdf | Bin 216590 -> 216590 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/vignettes/articles/paper.pdf b/vignettes/articles/paper.pdf index 2edd8e77b6a04345e605a8285d5de537716911a5..6209f315666480b0fcf45dbd0ee7bcbb51db0703 100644 GIT binary patch delta 265 zcmeC1!`nB9w_yuo{Q({$gAhXtD`Nv7ikiN0AEU%{{X>ib+czIzY-i#|lAP{(n9&eL zpz$!HF|xq+{f8MP7*z~Y3@wb33@vn1l1&VCO;VCmbuE%j%yi8YEsP9+ILXXBt^M~A z#_hk4FwJaIH8L=?Fg5^MuBo8!o1fy6Sdyxs;bLWEU}S7)2$S5t)1A4T+0ES4z{1(d w(ap`$$i>On#njBg+1bL$#nsW(&CJcn#llX(hOm;@=^NiO$!(wF&0NI<07LIf9smFU delta 265 zcmeC1!`nB9w_yuo{Q({Wix5LID^n9I1B7 zQ3M(fGa4fcY~O#FQG!t=(Za~g$RIIQH__PARM#ZU$V}J5#4K6Y#LURdJkdB6C}7_H z`v~Lq-$$5cHmMp|7@C=y04>*4(D%(xaY-ymRnTy;GBPkSHZ+7uZr|z7T+Zxf?Brx% yXyR;PVCZP-YHHwY?&{)X;_7JNZ0T%bX6fo`r(i=^N$m8E@0sMbPw{51VgdjaSV~y{ From 903dfb4cb96af31f9c1ded286450c370391c4f16 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Tue, 21 Nov 2023 23:12:06 -0500 Subject: [PATCH 09/24] Update convertPedigree.R added two t cross product solutions --- DESCRIPTION | 4 ++-- NEWS.md | 5 ++++- R/convertPedigree.R | 33 +++++++++++++++++++++++------- man/ped2add.Rd | 8 +++++++- man/ped2cn.Rd | 8 +++++++- man/ped2com.Rd | 6 ++++++ man/ped2mit.Rd | 8 +++++++- tests/testthat/test-network.R | 38 +++++++++++++++++++++++++++++++++++ 8 files changed, 97 insertions(+), 13 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 99982c2..2c964a4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: BGmisc Title: An R Package for Extended Behavior Genetics Analysis -Version: 1.1.0 -Date: 2023-11-06 +Version: 1.1.1 +Date: 2023-11-22 Authors@R: c(person("S. Mason", "Garrison", email = "garrissm@wfu.edu", role = c("aut", "cre"), comment=c(ORCID = "0000-0002-4804-6003")), person(c("Michael", "D."), "Hunter", role = "aut", comment=c(ORCID = "0000-0002-3651-6709")), diff --git a/NEWS.md b/NEWS.md index e57bafc..eaed1fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ +# BGmisc 1.1.1 +* Added alternative variants of the transpose that might allow for larger matrices + # BGmisc 1.1.0 -* Added ability to simulate twins, trance paternal and maternal lines, and harry potter pedigree +* Added ability to simulate twins, trace paternal and maternal lines, and harry potter pedigree # BGmisc 1.0.1 * Hot fix to resolve plotPedigree wrapper function breaking for pedigrees that contained multiple families diff --git a/R/convertPedigree.R b/R/convertPedigree.R index c4d49da..deb4d01 100644 --- a/R/convertPedigree.R +++ b/R/convertPedigree.R @@ -9,6 +9,8 @@ #' @param gc logical. If TRUE, do frequent garbage collection via \code{\link{gc}} to save memory #' @param flatten.diag logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones #' @param standardize.colnames logical. If TRUE, standardize the column names of the pedigree dataset +#' @param alt.tcross1 logical. If TRUE, use an alternative method for computing the transpose +#' @param alt.tcross2 logical. If TRUE, use an alternative method for computing the transpose #' @param ... additional arguments to be passed to \code{\link{ped2com}} #' @details The algorithms and methodologies used in this function are further discussed and exemplified in the vignette titled "examplePedigreeFunctions". #' @export @@ -20,6 +22,8 @@ ped2com <- function(ped, component, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, + alt.tcross1 = FALSE, + alt.tcross2 = FALSE, ...) { # Validate the 'component' argument and match it against predefined choices component <- match.arg(tolower(component), @@ -169,7 +173,15 @@ ped2com <- function(ped, component, if (verbose) { cat("Doing tcrossprod\n") } - r <- Matrix::tcrossprod(r2) + if(alt.tcross1){ + cat("Doing alt tcrossprod crossprod t \n") + r <- crossprod(t(as.matrix(r2))) + }else if(alt.tcross2){ + cat("Doing alt tcrossprod %*% t \n") + r <- r2 %*% t(as.matrix(r2)) + }else{ + r <- Matrix::tcrossprod(r2) + } if (component == "generation") { return(gen) } else { @@ -194,7 +206,8 @@ ped2com <- function(ped, component, #' @export #' -ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE) { +ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, + alt.tcross1 = FALSE, alt.tcross2 = FALSE) { ped2com( ped = ped, max.gen = max.gen, @@ -203,7 +216,9 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA gc = gc, component = "additive", flatten.diag = flatten.diag, - standardize.colnames = standardize.colnames + standardize.colnames = standardize.colnames, + alt.tcross1 = alt.tcross1, + alt.tcross2 = alt.tcross2 ) } @@ -213,7 +228,7 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA #' @export #' @aliases ped2mt #' -ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE) { +ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, alt.tcross1 = FALSE, alt.tcross2 = FALSE) { ped2com( ped = ped, max.gen = max.gen, @@ -222,7 +237,9 @@ ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALS gc = gc, component = "mitochondrial", flatten.diag = flatten.diag, - standardize.colnames = standardize.colnames + standardize.colnames = standardize.colnames, + alt.tcross1 = alt.tcross1, + alt.tcross2 = alt.tcross2 ) } @@ -234,7 +251,7 @@ ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALS #' @details The algorithms and methodologies used in this function are further discussed and exemplified in the vignette titled "examplePedigreeFunctions". #' @export #' -ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE) { +ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, alt.tcross1 = FALSE, alt.tcross2 = FALSE) { ped2com( ped = ped, max.gen = max.gen, @@ -243,7 +260,9 @@ ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FAL gc = gc, component = "common nuclear", flatten.diag = flatten.diag, - standardize.colnames = standardize.colnames + standardize.colnames = standardize.colnames, + alt.tcross1 = alt.tcross1, + alt.tcross2 = alt.tcross2 ) } diff --git a/man/ped2add.Rd b/man/ped2add.Rd index 920e670..c5499bd 100644 --- a/man/ped2add.Rd +++ b/man/ped2add.Rd @@ -11,7 +11,9 @@ ped2add( verbose = FALSE, gc = FALSE, flatten.diag = FALSE, - standardize.colnames = TRUE + standardize.colnames = TRUE, + alt.tcross1 = FALSE, + alt.tcross2 = FALSE ) } \arguments{ @@ -30,6 +32,10 @@ generations as there are in the data.} \item{flatten.diag}{logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones} \item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset} + +\item{alt.tcross1}{logical. If TRUE, use an alternative method for computing the transpose} + +\item{alt.tcross2}{logical. If TRUE, use an alternative method for computing the transpose} } \description{ Take a pedigree and turn it into an additive genetics relatedness matrix diff --git a/man/ped2cn.Rd b/man/ped2cn.Rd index 7f5c4e6..90d5bd4 100644 --- a/man/ped2cn.Rd +++ b/man/ped2cn.Rd @@ -11,7 +11,9 @@ ped2cn( verbose = FALSE, gc = FALSE, flatten.diag = FALSE, - standardize.colnames = TRUE + standardize.colnames = TRUE, + alt.tcross1 = FALSE, + alt.tcross2 = FALSE ) } \arguments{ @@ -30,6 +32,10 @@ generations as there are in the data.} \item{flatten.diag}{logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones} \item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset} + +\item{alt.tcross1}{logical. If TRUE, use an alternative method for computing the transpose} + +\item{alt.tcross2}{logical. If TRUE, use an alternative method for computing the transpose} } \description{ Take a pedigree and turn it into a common nuclear environmental relatedness matrix diff --git a/man/ped2com.Rd b/man/ped2com.Rd index 7c4c5f0..3a00a83 100644 --- a/man/ped2com.Rd +++ b/man/ped2com.Rd @@ -13,6 +13,8 @@ ped2com( gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, + alt.tcross1 = FALSE, + alt.tcross2 = FALSE, ... ) } @@ -35,6 +37,10 @@ generations as there are in the data.} \item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset} +\item{alt.tcross1}{logical. If TRUE, use an alternative method for computing the transpose} + +\item{alt.tcross2}{logical. If TRUE, use an alternative method for computing the transpose} + \item{...}{additional arguments to be passed to \code{\link{ped2com}}} } \description{ diff --git a/man/ped2mit.Rd b/man/ped2mit.Rd index 3962f27..3df3075 100644 --- a/man/ped2mit.Rd +++ b/man/ped2mit.Rd @@ -12,7 +12,9 @@ ped2mit( verbose = FALSE, gc = FALSE, flatten.diag = FALSE, - standardize.colnames = TRUE + standardize.colnames = TRUE, + alt.tcross1 = FALSE, + alt.tcross2 = FALSE ) } \arguments{ @@ -31,6 +33,10 @@ generations as there are in the data.} \item{flatten.diag}{logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones} \item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset} + +\item{alt.tcross1}{logical. If TRUE, use an alternative method for computing the transpose} + +\item{alt.tcross2}{logical. If TRUE, use an alternative method for computing the transpose} } \description{ Take a pedigree and turn it into a mitochondrial relatedness matrix diff --git a/tests/testthat/test-network.R b/tests/testthat/test-network.R index 4274a31..2f82e19 100755 --- a/tests/testthat/test-network.R +++ b/tests/testthat/test-network.R @@ -52,6 +52,25 @@ test_that("ped2add produces correct matrix dims, values, and dimnames for hazard expect_equal(dn[[1]], as.character(hazard$ID)) }) +test_that("ped2add produces correct matrix dims, values, and dimnames for alternative transpose", { + data(hazard) + add <- ped2add(hazard, alt.tcross1 = TRUE) + # Check dimension + expect_equal(dim(add), c(nrow(hazard), nrow(hazard))) + # 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_equal(add["5", "6"], .5) + # Check that dimnames are correct + dn <- dimnames(add) + expect_equal(dn[[1]], dn[[2]]) + expect_equal(dn[[1]], as.character(hazard$ID)) +}) +# 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", { data(inbreeding) add <- ped2add(inbreeding) @@ -69,6 +88,25 @@ test_that("ped2add produces correct matrix dims, values, and dimnames for inbree expect_equal(dn[[1]], dn[[2]]) expect_equal(dn[[1]], as.character(inbreeding$ID)) }) + + +test_that("ped2add produces correct matrix dims, values, and dimnames for inbreeding data with alternative transpose", { + data(inbreeding) + add <- ped2add(inbreeding, alt.tcross2 = 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["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", { data(inbreeding) add <- ped2add(inbreeding, flatten.diag = TRUE) From 1a576437aeb94365862a748a86f66472958bfdea Mon Sep 17 00:00:00 2001 From: smasongarrison Date: Wed, 22 Nov 2023 17:20:16 +0000 Subject: [PATCH 10/24] Saved new PDF of paper --- vignettes/articles/paper.pdf | Bin 216590 -> 216590 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/vignettes/articles/paper.pdf b/vignettes/articles/paper.pdf index 6209f315666480b0fcf45dbd0ee7bcbb51db0703..ea44ba1af08ea5612979467c9f39190f8ac14713 100644 GIT binary patch delta 259 zcmeC1!`nB9w_yuo!vSui5JPh-BLgb~^Qh??_c2OL*FVH4uzm9Z#ttSfgxqx3!;D7A z{KmtKCP@74`wufpFe;mwo0=r2CR*qk85o%AnxvU0>L#U{80s2Znwo&*%#u^ve;r}m z{_6?Rc>Lvx@y^C(RPec${Pm&B4(1q~OVTa1hi4UM3Z+jqJ%movLLx)?c|8Mzp{ tnK`>yT3Wa`xfz%l8@m~}IU6{+08Oz|upz7@cKXKmOmf?&cr#Zq0RW29NcjK& delta 259 zcmeC1!`nB9w_yuo!vSuC5JL+qV*?c^VB$i^O?N%aXoSpf zJj`f<#NWREFrx&cvSEs$g;A2Bg>Fi+iJ`7ZN^+{MMY4&Ru6d$`kpU1VnVGl$I>Na9 z*Ab@KO)3V47RClZdo>mGee+XX5=&AQG+eBV42+Bo4UM3Z+jqJ%movMWn;KX+J2|?! tSsJ-G8M~O8SvWgeIJvkwy1JRU8M#>4DcBHJ5<7k4dnUQ Date: Fri, 2 Feb 2024 15:36:17 -0500 Subject: [PATCH 11/24] update from main --- README.Rmd | 8 +++++++- README.md | 11 +++++++++-- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/README.Rmd b/README.Rmd index a2e22b4..eff00d5 100644 --- a/README.Rmd +++ b/README.Rmd @@ -29,7 +29,13 @@ The BGmisc R package offers a comprehensive suite of functions tailored for exte ## Installation -You can install the development version of BGmisc from [GitHub](https://github.com/) with: +You can install the released version of BGmisc from [CRAN](https://cran.r-project.org/) with: + +```r +install.packages("BGmisc") +``` + +To install the development version of BGmisc from [GitHub](https://github.com/) use: ``` r # install.packages("devtools") diff --git a/README.md b/README.md index 49a0db0..d1308aa 100644 --- a/README.md +++ b/README.md @@ -26,8 +26,15 @@ more. ## Installation -You can install the development version of BGmisc from -[GitHub](https://github.com/) with: +You can install the released version of BGmisc from +[CRAN](https://cran.r-project.org/) with: + +``` r +install.packages("BGmisc") +``` + +To install the development version of BGmisc from +[GitHub](https://github.com/) use: ``` r # install.packages("devtools") From 45e71020b14feedc55c3cc5eb325ba3c1762012c Mon Sep 17 00:00:00 2001 From: smasongarrison Date: Fri, 2 Feb 2024 20:36:59 +0000 Subject: [PATCH 12/24] Saved new PDF of paper --- vignettes/articles/paper.pdf | Bin 216590 -> 216592 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/vignettes/articles/paper.pdf b/vignettes/articles/paper.pdf index ea44ba1af08ea5612979467c9f39190f8ac14713..f2e24c329728bf8b26d84413a56ccbccf4022242 100644 GIT binary patch delta 2877 zcmai#X*3j!9>(7x`<_Wt#ukP!jA4c$!q`fdp^~x9*vpJvmN0f9vNpEtqZnJ(vhQR` zmc|l=Z5m98Dmp#^-;ljZU5}N0g+*XZv4RdR=3(=L=Cbv}L=vGQKy}Yw_xasIhtNIT&p_!-JDl?-IYbruPdhb`M48W70JK^5| zR=VlbWB3tc5x0|I&DGMdiZh`y^+#V>9o-zfeY_m;MAnEtvBo|zfU^=nk&Fuk02{Te z0Lt7XU%qV3J!-=}=YCUu*Ih(;jSUd9s=r${T(KVPlAYD6@gD3&yR3+=t=~=Y}i+rPZ?q})ulhY6^c^i&8!53-Ql{v3=Oqch#c^SZS z6B&Izov*aIw;ckmPRVKB?{akTY4-AbwOoE zuLyGXQ5zDO-vywnfx(-_F!OPp$L8wVOx?ela2ri8@=m6%VDh4+-TmN}S8aAfXd>B5 zrlzjHnS45Kr#8}s0{k_26rnKqpSul*sVE>-5b{{^t2O|LEY}6#ZmjJ9gwt{VZ-T7T z4UqXK4eJKT{)0BQcLP8GF>547WqtLs1API8+e^gF*2MC_5+;{zoEEe{4s^#?v0a zI{-kwaj*{{HgGN(xW7Z*O{7yG$@qWaT;?+Tg*Vy$d9v;AnVS|vs2Oq$JliYLta6_q zOSl3m_H%PJpku0n?QJ2m)6>Vk?(TU?cjq6z>tt{jUS*NbX0~WGyUC(i!d|ue7N5q+ zmukl!@^fXxQ0{lq)@XB6%_|Y3n6&aRN?zPm9y^?pg_+l)jbf&5DpM+$gfu?J5tT8` zlhMb_QGMv*1Jmqalwix@w<+g!>(@*zGyw(m9sO+4qR*!$W#@iKWm3j0a0G>jcR7^K zfV7@P;yQe0FyBiP+UF@N;|Tp$S2vg}{ti?0A#p8tojs+d`b`DP^^uUylFX9Ooc`!^OGI%WFYVgcFg0YoU{%_tpZ>V&KSLG&@> zci}Q#W9y}ok4f*(-ExhJ%nVk&->i>s!mfH9ek3MDJ)4ClG>Mb^QX(Edfdp{Hb#YG? zu^TQFKdS6^(68xyn;Ccy?T4cm0x|6jI=swSdzs?rhCx^+#Lx!LlYf+M%tODN{RL8z zv4`buF&4e5c7n4((6jb6ExiunzR@7PNMcPpxzoYW8D`P=>5^^s?l5wBRgFgnM4kvV zK9v!ZMBxU~<4Gc$6U-Jf0g~&L;eFq4BufOkg$6Ys^OZ!FX0Zp_bvZmO4;*LgI&Yko zT1*E)X#O8U+L-ogFERJxq|A+^%RtnkX-{ZQo6u{689J+HYg;g1GUls+%PNSbyE#|D-0U1>9reGCSh>rwBYGT|E2Ch%*1IOoIld{70m8yzZcJOuxV6%;w|vp z_C}EP%9YD8&&NV%7!wyBylybz`D6(t8b}``qvvK{p!6d>xf`Wom-pYd^v^PrzP3aQM+~CmZf~_L`vOU+!MOFilEuYa-WhWHp+GH1X`w+lV;P%OejwX z3GvpcV1_e+{e$uJ0dMz4 zmbFM}&U{D8+ID%uB(E!}ws7k+WLvAGM-MUTB^s|f(!fNANs4#nauKL~QLSAze}=_l zo|*KqCN_2iB>x5uc)1|Bj~-t_;@a0#wamJu^J9;nH@Q`2>q6$GB6OX2x!vnzU#wJ4 zdeh#u+c8HMR}Bl8yvgK+iKUKbq37RSzw?{kaPx5J-`mo-o=W$kR#FiLhr!`61>~O} zdsSG@(A_~B@8c*esjc#d|CibLMvvZ)UKfc%YoT?}@=9oJZ5@~*OdEyNR?RKlrp zt&W1VPoPNF3uD+yd%6nQ_{V%Ab~z2$RKr0?0()#yrP$r*V#BzS)k?AbQ^9QGUx%dc zYKQFYu21B7kskJaj8pUj3bYI`FNhaGJLn6lACHa&*jg~->H`_tE^4uUtHz&^L>J>V zfDg<31`kc~=fB;p8a{-eFMq4Ye{@|mh+$v4vc7+019A9TGjD4YRtn=NL34iA66_Hc za?$_*wRnJNmf=VX82=znRwmTz9&aiAE*@Rr8kVkpx*ZysT3hz6JPNdW($_mJU54D* zCFh=%uvM(iTD8pn)Ge)+t zQ)))`C4}%<;+5As=lk)_`+mIp^WJ;zIrq=KX$2f91sn~%5?CLBJqOdO=(7=v+tb~N zr4zg3F*IM7)(fR_?u#ZE)0=jdAqgL=M>EED#F1@mi}oFuD$l@UcmF{VjTzwmR~3oY z^$UI4t<79kaqB>j^5s1?w)(Y#v*_LZk04iAzC7=wVnChlmnsF?Yu}gRF)JE2{?U6D zosFXlQvKrwnphb|m)_9neHiFSv^JmliRzid+X=yB+ZhtFC0jl2$L-F#y;fQ~Pf$WS zny5W*Aw(hobIvh)TZe>sJ<84rSKQhweQ?|xB{|j?bwPXb=d9KfxC^9YWF_^i2iGjL z+G&tLK?ubu@1|Lpa-cU(PQBEK_{QcL=y5LuXrm}BLFZ$NdSPKr0)b! z=f>^{isZR8ebCg(p*v*OyJhc{;i1MED9=Edp&7Vy(cUNkb|{F^qSUD>_zFo|gdP?4Uz~*@mK-okp2* zZ~;dW`JPhwNrb?h1URiB&Ay{00U#>r#dp6;ugUp9ntha_;#Z)|zZ~mt-DF~BVu)YW zr$(9uePzA5{MjR?D1j+!qnx90TC};=Jn==X>7kR7!dhFyZ%VKUpxaC8ex_r_c8F>T zGa+cH`U#A#vSM`ZO)fU+&c=yiOVJL&H2|Q)q^?2w(>$IB`!2Jz60*~+^vk*DY=K9O z+v-MSd5X!W2KM72rHzDo$9QSq*eKgeduv}G%6GG5+xWNCXVE_&Bzj2ittR?Zg}t*O ze=jRKi{{EpO3(e!-Q@|9`U>TfqqdkUYMkx*N6+gFbu2%eRGMT8D>t_@W*gqw-7l-zGz0I1Sp8$f|Y%@r} z$AE`=JTQog3IqzZRY7P%l{J+Sw+Q0x03pJ3AplHzO$Nj>asRJ_U_u34{wEtt1t|W5 zC3R8(LI6oPLQU1((@h-$RaRDmsCpsXAa^`fRUj}8HP!!UaCc8H((f+75CEV~8tev0 z_MU$9LUxC+m%;?YvTKL193rW@>`X;2Vi%N#GJm95+;1_j$4=XR+Y30_@qm;xO^@?c zN`?0ihPV z)g`fvUtuVFIJ|2$Ekmt=ctb@>pB*jje{GYIC_V18)1*=*nWHBME_9r+0=l4J-w=F?hj{CP&^-vrS1X3(uGQ#VeI(aV3JDlZzIuE8*t2 zG>+>-6I9_=W|2d36nDKXZf*Cx-OdoC+M{NBMA&yeLnpMbZ7E!LHc2G!HLPg!zLC4z zpogG2j@aW7me_Y~ja?;$mEnO^is{Q6a(xp>fpx%_asyKH4-EL-oUX55*=S6A*atw? zIk97Xi;YZZLrCif0;*A#YhjmGaGAq&&|lJ$PX4qUd=BghswxR0TtF<&!wq_sC8JhX zA|j*gnM;Mtm->ASf$nPjB6V@&2U?rFj^_#6Q=-+IQ29p*acjkkn$52`I<4BBs`D{3 zMXL>&%Xxu~-c6N7l9tQy4p&fQMoU6RF?MD!RO|y_eFJ`@lMC}$CRim}u4DJ`nks=Otq36h0CArsAr8>TWRD?gcs&Sa*S!n z#=9pVoRA#V(<&;v;vTu%h9NZki;VnEq%65?vQEv)o@P zboUFDW2A2cvPwe+@dBvXfc$Y^HcyJ}93mG}im zNPwBbemastuh1}w4dy1vCnyJH44kUp8EQ=8CSFR@=7Ojj;tnj}D7Gcvm1Y~Y3C1;F zlE69OC&!;e9vAY(ipiVF)qgch-#j5E5LgP-GxIzeM?&I_aDFoAy_WzLl14y*I5NV8*xg zUv?R*4Pzt{wFaAkOx9_M{$L-`MwteK>ZxD1T&;7gy4g}lgMJaW#=HSBrmJ zh^_w3V*2f%pG41OYHgH-si;7qDu_RGhqxstu4Hl7!@w=XQ(V^I&&WdmOC+@$Ge2N9 zx@rJL!l4E*BRJAPLqpv_-$)q_gBd9sA(izF{-o%LYyW?XGht4MSqzI%5!cZX{~K(7 zzxqSE)VP_6-PQ9w+qw7JQLrYP^}I<{+GT}^+|-?5g{FZE`$R&vAW#6pev8QJ$A=&3 z9xI>|eFD;2sw}whWcbw@KOR|+eew%KZu*v1pw7RBPYPf#@8t(cDqeI@;1u3BSeNGD z{>B39YCho*;r>#-(XFfpCCDU;Qd*9731MLwH;V0&Fvf z=kT97nns)ODVE)?*eXZj6cc|foqq=26$ig@)4BXuXpyYn8>hZVxzroa>_a~-us$smww6IYp<$@ZT? zdn2c`O3vJ;+*Su=e`-Fb8wQ@xgM5!+4q_E{(;{|W_rZN_U`f#zSYMbrzp^~mw2U=< z@5MRH1MZ=;vG<Csw51PJQolywhYQ@a_iWVy~|0^khG5L8OGwKMuG4QExYfKWP^OObg!5t(t zfV19~GGq_E@kmgj{=+xqc6O6|o(=BTrs-1(nCZmB*xm?fd9cB6!)iI`&jQs)yk{VYT3sb!`4TY5K!Q(=EC0mP W?a_C_iUspURydoKl%b^&+rI&rCP$zE From 24085daa68068ad6b4a9b9adb91d2d7f1741da66 Mon Sep 17 00:00:00 2001 From: smasongarrison Date: Wed, 21 Feb 2024 22:45:13 +0000 Subject: [PATCH 13/24] Saved new PDF of paper --- .../{draft-pdf.yml => draft-pdf.Xml} | 0 vignettes/articles/paper.pdf | Bin 217964 -> 218000 bytes 2 files changed, 0 insertions(+), 0 deletions(-) rename .github/workflows/{draft-pdf.yml => draft-pdf.Xml} (100%) diff --git a/.github/workflows/draft-pdf.yml b/.github/workflows/draft-pdf.Xml similarity index 100% rename from .github/workflows/draft-pdf.yml rename to .github/workflows/draft-pdf.Xml diff --git a/vignettes/articles/paper.pdf b/vignettes/articles/paper.pdf index c17727aa67978066014bfb866a3d57742216e420..29a8356f78339d9c4e860f857b65c102a1a23faf 100644 GIT binary patch delta 9041 zcmai&Q*a%CxAkM&cGK9lZReyh8smhGPGcJQ_NniJc$)3~wk|C>AW&Am_eX|Mg8 z^{`*|%$jvxik?`8{<8@>#Tl9tTo(_64_f@Dn84DC-qUM33o^5cS_}FECCa@i>F@r} zIb0n%Svj_^{oqQTlu@bK!&`Ou=M9ICF;mnU0~=*UvQ%Di-Pg2_&uQ`b>5nI{cz`ly z8NlSD1V=ZpJO!v^Ypqt0T8FI$dc9wF*$xGp3~9e!S^H01Xt6T(BY!GIyeB1rK$0)) zRUwa8+ktINxkCJsaQJ(tui|`&ckj#d)3sW`XF_mf$OcNJ)dn{_2ZA-?eBN0 z6yM4Tt(%|-)s_%;shZNFIZ3pC*X19kHPnc#FmyroC_mmRg#tc=kWg;+DltcEqXxId@g~6>5Y5DSTqFx?! z;o{KXEcmyMd!V$oin6{&qrPhU$oD*G?J@a;fa_eLiC|Co8NlPN&~_l09BvJ-Vsu%> zfy2EtCr?|hKg|#vf%}HEQn%$yCxf%&P5Jud3UZcHB^ zz878AFNXjt@;!D~SeU9&akUKmu(XoSE}50|0)_fr`~PN=!LO~Ly3EVkND#9VxBji^ zSD@n31U!orxZcSdT5gQ?lU&zjpeVs*p3m5Z%@z}n_BFhzw1RHcnS!Q0>+~A}j6(%y zGAC&h9cZBl=Vx_pk)YD79kX}bur*yBv(#I%rI$30E9aL-(bPfi$D4dSsxMZ-QAXo` zx2)|PzBlr7X|tgy>7EgSQeYgk;>V0%18S691e^%Ag@ z`vv_P0NJs0TvaPIHYH2)jTOlVf$j4u^y9XH5ZXe&9@{G9LD+{GCH*rWsU^j zX3bTjz>c|Hmpfi&6~&Ap3xhS zh%tT2*;SC7Ds)?7<-W2nR@f0YX3+dag($i`u&CDw$%WO)P^|yp!pM@$H(bn1;F{++ z=~s4+03XzNTH>gx#L;q*Y8Gf*voxOdEO+ADUwq>~@+;b2`Lsf-W zWf7FTU^V1kSb}cp8a}l~98tCJivH8x0Vg9N9U5B2*8N_)^BBs_%-AGrgQYoIQ^5w$ z(>)at*nM*#(7^X-qofa?j-s8n*HY1 z(%)G>(*=Zsa01dIYl}=>DWt&HYI3lsV`0c>PlIDOJQQxn)t+kO^+VtD;!ta7`O6YI=6T#tqP= zF7@F`B1(mVpm)aj>$#VW-&e|F0AQnhEL!tgdckU zTfSuu?bIC^?i1Zr&n)Z{Sl@)7+5x{Ll^2=a`4rFxP}swtun3%X1yG&JbAY%H#Ze4m zVw=QXBB0j82vhjz8R_MPyUWo2V*KJ_;6O0&pL?APgH9>2f|NJzP95F22g5gBpKd9Y>&Zqkz}@@tkWNew5+2qn!qkTxQg+8X#?jLQMniYDe{B z7$te`^j|Y2a(DS?HI$-vA;X><=QX1gW(BsT(iN6iW7-3C(xb%4Gd%#WOxnFOJW+}U zO%}s5Rh`OFdrD5<;hQJ{#XF{$O_|wmKEP!12I!4VzPN6?c}EBS9)J3)sD;~qq7GPR z9if4a7d{3&o6+Qco4)(^@~ zci_r73hvbzG= za22riC8NKP;Sjni_#=f9HK(T2Alr3INO&~eah!G@cOKEd#C zUAPXzB&_fglPJ;*2^GpCH>M5ROynsM_hDJLKn1@Hec62H%u12{ve@cA_N8StLQko> z3eUl8)l(+7p8+FePzEmvyp~}}(>zeWF*71usItYG(S!q~#c*}PdiU*eU-5JV2l9a} zpOY{Y*32p8_X-k*5ZU33_v9C{`YQ;HO{RXDF$}Gp?9Ns#8yfz^9lFyvmtWWK(k>WM z5H~J;l5pv3grntf+s*MI80Xpe{dv+*w0s^Yo0B}%7nbb|rrfA$bL|vq7goqkHZ@AV zpeKjqKZufvX3u9S%F>fFSHJEh$SeZ9qcs9p$ve{PWQVF2hOC=lPGyl6VISF$s*1sQ`V3fksog;?ro;39Y3dwHmm97H7UyRB^Vo^;`( z_YXB&;&wmlJ6E377CTuaxs{a=fqb+`WMl27^8^9_FMPQX-NN4*(%|?`v~0U_r<}@T zhoe-?uiw>6GUoNux5u*ho8Tj6&Nqb)#Gspn3_0ofYiUwJ$Tsp1oOj#MgN59 zGU5U=xq#@(BaD_$KovI<+3DNPbuANm)}RPF$V83>kF8XrSfwu|B3mr}9$p}$bF|^) z!`v={_@YxSDA6c?$#BJ{VevJ~tnJVF&$^`7JHyaB=wE_TFD^}a4 zInZDHnW3$%J$QaIVwpgsCUUcKH{Hm>4b6+J_zc&=eB6yC3C4C-y2;w6BFQZe3yd8d z&%R4^dh*S){Ia^o6rE_EerECM-E^fwotl+Jg=b3cBn>AX%gzPQDia%+XPxE-K3E?( zN@KT{zMt1iZp~af_G7p;>G@`;QH-9jqaY0xos|Tl#+#q_FiqLRw}~4}zbuiEOxgoz zS4wg&v?kBTDe2@CkR6NUH0%)1mNaPFJaye-Q7@bfk*VZ)*)=tT2no8*#mayEj3#04 zi`9?qrFR&b#nKL^ZIJuw3!qQ>MWA07X6 zG_2-;-D~m4sPGvv2@9C(liOL}4qbVNs_%p!xV)N%y@Or3ATVp)hVOij6Om}e40wgV z>&|^YM(A6g20!-U+Fly$^lhV&wbk0-s|l-obN`T<^0m+JQkX1`$yvw z-NsM+DF3}am;4f`V(9r?oF9FSNGX>y6 zl9+A4+{e+ERci5Xudo8@MxfkXn%^KI-J1mC{>{y;Dl8Qo?0qHjsV?GCtmDjIg#ha= zjo+|X;bg&1syJ!aCX=ef|EiFkY80X_8$O6{3>@GUx`|%mD(j8{ItD_)?(C{hnHZQ@ z=xju@V#iO8Rst9I6|15Sjq{i$Z~3Bl@S5dN+yXqq9QRm|g;4wyDG-qVoq#YM?_6a! zZ^Zdm=-BL3(&mdvuchzcOBu^kY&cFgMW(Y3>y@Xg_csBoD`%a14)FLaW*Aj|te=wq z9!0&`1`B>FA(UlkI%rqLJ#Ol~JK^~ZxEY!B-iiIRDH5wjm|3t?W9H|a$Uwms8{IAzUpZ0eiMNo7;c)CEG2qO$mpkhAhAkrH*rgOILbX-|6{}+ zd&7O9I_PKE?x9(OxPdfJk89fA4$jU`h?MICy7EG~(kd})YZDWS$`MSTb% zn3e?~6jKz>jFRV;xz&OZSmMt!!3Zked4_>C(g80bqHSD2PRu$D4T z)H1ex`u+^o`FOm0v;>HA+}v$z-7cr-0*JEL-_P!rUBnkLUrOs=4me;=1SfP)>E~q( zd5u|0uaejbE8e;bM&K-cIg#bQUyxu8h%^H%-${FPVE`{MdQt0ROgZ&eZ@Mv09iGSG zaw{V7kreVE#%@Mk%dVgvmAi*oFyF&_;sMqWZWHGPeBbW@f?tRLB<^!u4RbI1wvG6**N zFR^ozsaV=-3?p^Y?+ezVNQcsscA64msZLt);QD_4`)|cY{PS%K-#TrFO3cjn(!`5G z#(JGsKFaFT;FHSLA!*A2-R3ESSMMy+e8!!0OCN~+Bm}A{oOHNg^`Fp+(7gZMuuK{` zxU35hyyuzzNw|P1eF|jhfGxf#H8K;@rfXc0Cxwfz7P7ZwOiazR0lnujkBvFxwAJU* zm4DHsxf1Q_ItWN?R;e3lveM$9%vkV=R3RxXwwU9#CQAvbh|ISF7?t92n{Zoardh}f z9u*CEAKgfXDDadI!SpylXv%GeX^Uo6{1OR#P}!v930P9*iqO2)2FYnNn##Zb91JOe z{>0Km0BZz6lY$nu>x1p!Z3yb(a3)})JcE8K2;bmH*i&j1I!eu~;f}ALvJn94-7khsKft6#F5;XN$aoamBkfS0_MvEg958m<1Btfc3?lB`k!f!LicNQM=bl z8d~sB6Qk835{_VooPoVP5WN>0ne-yhD2iC8KadJs3i4|M?H90NlslZ!i z{gB_rjDm-^xLZX-wVCBAXb zw*YO7=FaiEX^k98Oo=-uDnIFcWvXN8)(*@`oZtFL+3TU=Xpv>GCE6W$u-B`LHL(%P z^Od!awfsHQ)u*1+Jk0>-FC;YK=tKi_5ZIea*tI6qq|~2xx=X9_o)6;cK^&|M-Of zXu%+sD=jYXPIdC3ZAAM)&%NR0ZG2dWu;(hfId|cBYheocmN>#5I5?M8``-~_y9v_} zc(!0tXQ+ z(6+Eqa>O?4QL(v;ujoZ?vwHSB@96%kJu^ll$m*(*pTUe*oUTF*FrqH_Cxj~Iv>im3 z@{^{jIPKdX5wc6OyQu^ttjR#OF_%>e?$ygmee!I_*7=lks@LNWzn5+SyYW~ zW47I?a`mm}<6i7IN5|=18umdk6Rt_DvYWS-ZiUBXq(OUc{ZJ{7cW^*>%(Lzskls(P*MjPFN{XIJbU3L-8~HSmYn2epjBd)Mo#B z_W0&ZlpG3;;;K!Ufra%8ZIUNm*vDBtT2Y#i5&8=`;R}!<9|jkle9{aQR?o$;5L2%` zh~wmC|Iklur2Ue*l{`XlO#mr(+(~WqWxM7GM$ilkB`>^Nfw{zm z%p**(9tz>>9Y^Y}^%4IXp!Jt;B->zre&W%W>QFt)iV>kHFx;shyCqtD|M}0&z22N9 z^pDw;IqyMg+&s2B#}G7VU5jNqx~00J%6Nem_S5GhHNac19VDItlj!k=M~)~T>hm-^AvzDn9$Fwgsa4@m)Jj;dq@1%KAmcQ6b? z7iY~0bOUp?yT2PU^7r#P9Z8tOIic9H!Lfoih~F|2u0}6rI}z{4ds}tvM8>x_ zQp#ml+_|-tg_X{V?d`^$M;1Ho$Z%IO=5m|9gD)%mI7>jPmV2ZrPzp+?Y_ERX3MW1F zS677~mlwZ1*>#W89@}kheNpnodF((#jEA7gtV9uu9WvH0O_<66#ZE9@#B*o*`^)-j zTXoE6EA2qcu%`MKrSryD&RIN7V1bBX`iPKF-Wua07gqqkOagyno ze!c8-7Xq<;f1YJwzir8o(2{Z*4KSrLk|9(>R?9A$hRU4TFyGTKGhZk{%g4wJj-|so zE#GaT#X(J)*K5H}&-RI!P@Af!Uu4`-T;Z#E<|2V>Gy^+0hMGah*wc#O0Jw7D^V8m{huGQ-E7 zemu2Dxj?o-w9mQ!n^#OKx==rg81lt$kL$Gcw7S zC313FLy0r+ieG)MNe(5it5-CFHqhVKL+>5B+-M?|1&b{mfXuGCjh`bTCUy4X+zJd7 z1fdS7Cuk580fl%MXm$SFoJ`mw9q*TxkXiU8^AC#7d#9muD~!)2eesdzKn9Z_ewVIL zb(FnG*wVReyd}`Kxx0N5@OyVQ;Yn$JfFhvXu%z(7Dji?{j!rD6rMLB-B`$NooXW%Tg%xN=?cwXC73e_i;roBaiP}TiW$}#znKNk=+uv)0 zdMUVFog!Li*Y>>qmql1TkMfXz-;77?vH(Yh*+>Z$-ytQ`YN+|XTN$Sr2&ty?7}R%* zmKGxg`DNzr;fOw6d}C7uGln!EE%d5inj`2Le2k&fBmxy&@jJ~4JBo(yotjheE!%NyJ^=PkgOkjN z`t12cJXBza=F*2I1@*`8VUy$(NW9ICcajL^7YjNwASI-## ztkFdReeV20(>K#{q}L#jf%QU5*^r5n>QmC;9L16(YpO@bPq8Xcp+=#rH?#2ca+SC| z9PZ59nDrHnJqRS`TYf*auQGlN;=P)#(8WJxd$Z^(d?7+>a+RCsXDfu zSjag)?*c>h9$zP4y0f)C1j9v=zn2o_*U^ zaqy@20=ypgRPB#LJPfiuJCmj|Czwr~Z^X;mt_QqT!ze6%Cm2^QLpJpb%1P!G$qk_vQkI9nT-1H4sjFuqPWra@-~!LhDyHrF?F$b2g@yipo5uDl_H4 zJCtRqFZH0{Mj7~C_x_*O=I_;wL)OS3r`M5C588%lf8|3vWP@xItKJQ#q&cvX(# zx58+JvMOAyC}L7B;<5Hbo>g_xJ^dPn;Zofbi?kFYEm|?G^KnT_b4&4yQHlKD7UN`8 z3Rqsj|NcSHmw83UNlm=r8^2Fbu1RG{O2wk2rZgjK3G2mK<&^E@nwB;VwoDdQ6qYb* z6r3h+Q%%@FQGFs`q=DheYQ1$(6S`(oIDYR{^Yg)m`}XJORQK^)9OqFj`XxE{9?UoH zr3@8ZB3zfM?v?#tK+>hM*AXcw2PdMl+xGtiV7^1pSO6Qwo_PfN*-!u*G>$nKICY#% z1>=|M@UPuU0h?_#d=@!B8>0dsc0JCM0nJSf%SDaaU`{X*F33T6B#Cj*?>`daZvYiz z#)${PF+dqN6HM(xF+fgR!W;D0EzvMnwHjNgJNksy|6@;j)UC;Onp5NRH}`4nulINX z6p9mwL+HTWp#X_sZD*8UlpyYw^mK`!_Y2UDkBI07d)PZ?vV@txf*&*e86703tAWm| zfvQ;^LbL#(w+*(j4XLgpTrynu9MYe`AT^`)=<`}ZMxR0IEQAM`b2|pzr^+Rei2{k4 zT9?7f3E!AzBRKt^;GLyv}tefTNJB_bhG7=V^gw69b?~A7{v|_`1Cx9sNmt7)^G&~ zQVt9xKFvzp0aOU0^1lz(0w$IHi;A{~qvT}iNVj5gOp=nn0EJ~f7&SE*eM{o?-th`0t{co^Jl)>sK*3MS$9zbhzr~jv1EbLL-J79ol9Y>2i5Q|!@?f6& z>zBxvjL6$T{^vE5P>!w73rJ4=rBG>t4ss%=S#?k<;PoQG>FbjQ(0$LIw*g=|FmnXi z%3>%zYw?2G*My$H%$QFcq@UfLDhwY_YIL9XOw%8vempm+EmeAhl17`*r_^^!)y% zjx%15^6UeSJWc@6r+Hgcra`1zf(RB_UJfj!HPzJ0~Y z$H%WhSfjZTcTN9A=%Zt0taYLh10l`0)+nl!|G4-AwI#Q+q-Vk}J%7>3P3gf+sHwq= z_uHJ3MDelg*u`cn8;zTInfb0E#2(Js!lD%u9i^*B7A^pwM!30yueYmRz|%o>tjaik zuv)>4OfA#Z>d5gmOi-Xp+Al3}={1^R+0n}{Vo)sb9iwMTez0|`ayYSm?Uob%sLduk z1q!3|$@e%vQF~%!xD_{Q?EyvIP=6Wsq*y^yTEE^cyV6nqbtg|vsEQ+-C}&A9Ua+EG z)=n5(Om3E(#8Hem*n}8L684R%pz%M0XbDA1{hs^jZC7c-%V2! z6Bb%0Q{7NEwJNtg8LK+HcRV1^LI%?q7Bmj{5i8ByER?9_PcNOEcWa_C7f-TO{9{(J zTsQZ^h!+nhKBGlnxb|O1uNZN<{6`72mB}v~gN($%jnKpxeJ`V5jkk*!5m=hDhqQB} zhThrC?9db5^w77?2Y!sh}rsIksm2 zA{8*gs{@APj~*DuSu^$|!TN;3o@~U5TnRsm8-Wg3g3J_%@rrljo^E3V=l&kAiBs42 zJYG8v;)^B9G#TwJ)mH}T+`QR6Ntv#{R4R4*p0lyFQ(V=rHvYM3_zu~0)%$iXKh*fk zHww*|-JRai_d~;_2Ji83d;<4IC^uh$Gbtzl%_6T;jiRz4Y${qMG@h)C4TLXPOAL-OV_avT#Qv#TWu1 zGg6VDKN3dh3m9MRtyEb?{lELhO6+G~6L>aXNAeAl(nc&)G?cwr3n%Cv2-gz>rmB8# z(i42oN>e?Se7L}xdXdm7T`2%aaXf^68&rdl4X-ChunrKal{g<@M4B&p`h42)q&B}F?72>Ia1D`wv zgdv00d2G!paPlr$Y~oE&Hi`NM|X z9|r~B?=v+nUuZc{LYcb{J-ubGba`mzVN9n=^Rn&soh%v)W-8VDb<^g z3DJYr0z7KzsI#64-%%8*c%SgAA{Py;e@=??@aRxa6Y6Bv0A}m`fH-VUyR2oWBDS-V z1fn-cd6vZrNM1XVl~?t@I1yL`G>N44S&8mwd?x7OM|x;jI%=7eLva`E6I4+yVjeXW zyEz$`lAFz>oC;wh*l5H78ka!Q6_<9noDQz>ap_4SZyNiKjo;gD#ys`REQ&j6x+58s zcafbPe;Vt!vMpFxq%FqU)55t1wWhF2!+7!z$149cFk~kcX^Limy@A;Owl%S)i8nWF zw|7>~qy3DAduC9WxFuo-+3i9SpC0uT?=zC8REp_Z$KyA2@LU4`4M64I)ZA5Dwfe@0 z0fbUKrb%-5wl2jP<*dV^-8KCh8bc=DzcpfAF`E9UMnN^lF8OHWNpU`kaD9Hr;QBDF zd8F^l3Qo&SahHJc38*_qgH_SeZARic1(DqBEB3frzbv>+E7u)Kco1^&REd~^p{u3K zc9qyf138W=hT|3BH2rDaV9HZYSf-`9T_kB0X}YDUc1Sh!ZqgddKtK&5gId~{B;&hG z4_b*ZUda>!{SoD$F5r4)IfZa18`A8U0axlrYZ~^S22=}_y(Q#5|7-IsGE;4^bEGS( zEndn@xqKb9$x>Lmt{1dR%Z7<{xVf!a(vz$Y=(qj)z!(%jg3(n+;qL+^KXLk7o>qw{ zHQq74^U3c~^^1tyB%1x2hi{o!QozzRrWU*_qtynZjVYQxu@AvB@^wyp6tYg8Sk8&C zqaWwiTPBbWJy8+fG2Ooz1iS+qnsF35VH?i{F?hUgHiN49qqQ7x@BAW~3R41?EX&^g zAa#<|pR_};h|{1Ivwp~sGRa!5DBS3a4GzpnI9GPo{(#OFuz>Fqbt zrWnHyDKC6vUxOh|%YhV(jQpcTRc6DF1yqE8M3LJ8;fGhGGn=kT@Z`A^e5>leUexgM z!8%epFKUgN(5L%fSr*L`S+fFH2lqBDmy{;kFU<^@M7hqhHmmXZo({(B9~*B1ikg?4 z96Bv*DdQWzYw%4T6rH}Qfs1=*BXY_(exU|#u}SH9{Tp%?_Q6B?Ri<;QTSbRGM_Zk# z*;;M_u#uzWNH6|VDs`WaY)L9~ANt2*3tT%+Vq9QdCjN~L;fQWwm3$8f6I7ROa2)l_ zFBuTYh$+9~i?wXqxFK!7?cz_NgxND;%JYj8FHhY(lD4;Nv#f!~A}eCjJ2OrUEFVZuB*{O;}=cg{#4m*Cuse9Z2n93;WCFl+TpP< zO_hORgaF->_*Xe=%n%t1hU8%>_i=^{lM7=x$E^}Av==f>4NMUBgn)0AAL`?cxvP1! z$yXHRjPyZ=F%ZHDV1`erXuAHy(HxEjkd^Mpy#0qfqD|Nn$f@U{iM#R5%$N4D_>y4< zR>dqVk6F~efM-v~G?Ck7KgSz)l5?x_>$I_G6&xs;lRVOl#IwyT(r)0g@9E>}mB>$B z(|Wk3$R8nc>Bq~Oz1UwukrJP_5^ys{iJ^O#jtO8yS9w60thsxD zCO2c{4RQY6mAKoCAGsrTc z$X2y(i0*i;=Fk>XyWr81t;27;$eEj0u5*|=@1^AJgnP=HGR|t*_Sb?kPfhm(M;a-< z8ulkcjp4RE_>##`VUaNuFoqV~3XRNFi^!HLP-(D;fyI397P3h|o7Ng$@}i;6IhL(7 z1({Qcx)#t^QtbC}hy56sESDtZeRRUNrAn7Nfzw4m_hm+dSs7<(59*9xo>U;quhd+z zEFc|_*2-aWXue)?X<^^9oxrM1&%ejTR6B=DF3k8{Ps(O_Fu#HXKyf6Q6?d%y#*>qI zYdppogIrtXxtdr2iTLEyzF1rfX`c0tC|nC|wfONag*{9RkcYpIsp;vj2SY&H@E+JI zzYa#yZfvht&8K+@OedTrR(=-2vquxPwDZ?=fW*W``j{O1pO$Gv4?4>y>#`OIs!x`Q zv}0Ys&A2xVp7{%av#)xepYjB22>x%`=v|~_o^3&EA0IwJfe>BWP~gWdve_|wNi zr@o-xwx+Kw2=BL-h1^G&ECF2JYaVF$t16xFMO3WSoW8`Syp10$nC&Kd#}4mIv_cWm zBegemi+^YZzXl;=3=Xa^x@epm?6{j=fVVvk_z82?Q+Vst%Bo%9P0RdH@$+$xVXeOh@=b;1`cY4b1id3%h=&0k(3-dqr$KyvV8@Goc`96p%;%cIvZiF+c)Ga#9)mc6( z5Gv?HCuBTv(AV03&Ov<*4#|;NEj9T@@o=fm6ZT8c<|m?Qip8mt-Wx!AYlb5*wccQ835 zmu?GyweFCr!neWKsJA;LP^MK42nm_BrVV}=b1$~_sSE8o7!3CIDn=aAXO5Rft^A^*FR&>^$B!Ve$in%i>VkN7@0y*q`;QWGPb*G1<*L{}^{s zcYIBN`8H1UJChTov93aUQW@Nt&lA%YGf>HGg(mM)&-Rm72X=66>nguo1n^cGD997H{NsnRU52Oyuh>nLH=xP%ian~m8n8YMt!VGwUe^)8UQZBkOmX)RA4gVK#|gMt}L=`<}< z=6i3}A<`S7MA!aB0nv&h$GW*7mOg))OV$`!@`_f!M6UUIHxvr;#szEVt;u%9kY!Ji z1UofjY6=9qx{3&c4w~2tt*b6J6X^sx-JePAec#WynoV>4g&G6Y1I<8_ziBigMWKjY zj%%M*ztff}e&t6n)V($C&@gPj=|tFfn#opwp#6(@$xLCR!U7owLCOL+`ToD|E7N*5 zPMb2AA6G{6q$#jV;5Th^c;{pf?tXKcdaDL$Q~XAWO(4?(*;%GH;G@@6?VhU<=f9OO z$|q`Dqpqsz;+$j>CRRb72KFvkHZF3k#6*ssMo4Xx?R!SdbBco9WUA??T^VDOsy!dw zAN|zl89`xd^k}$g?S3x@Z5W(OZO$wkv<0ZXkl48-*vXP+Z+L;rzv&nXy3HK@e+L$V z08!rXAd_H7LO}CwV~7o`C2oBj<`h)4N3ahX?ZSe!hjW%rJ-RA81$7UEYyGe{qjpBn zr}0_yRwHV4xA{sa?5mzXCaU|qx{3b%?}4qt=wS35(-jlv;X(MQ@xqD)WX7B*Q=}3i zxc`L7vOb&^LLof^Z+>#0ep^HBv%4>~apB$zg>qow1h}=s18Gbd#Ug7EbR}fOjtxT_ zhwa7KGmO!g6G>_2;e(%K79}{@^fBfojo&Bckm+!N1$wdbTl-7&cJfuLL>}|{u!G10NyDy4CPt0xdoZYTucgRG z^TT=7BP!st3f(k;8P7cv1;l1x+o|8XqpP3@U@BNa8Eb zyt|s7X)EFCp$oH=ZGU9mn&q*#Lpwa-`Sb-<(Bze`57w; zNIVLVJHCpq7?ibNotr!?I_cwk~P}8WWD_7)5paB2z4!eBIZj1)3~!u5T65ibVE*jj`afU)Ot${_bJI zgF3sGwyCq2A2$1F#vS_^{q&X>yFbMOMgkubz-EuAEcM54RLinRFLXb=(GS^#0H8z6 zYeW_sYAt89H@%FW*dbhrru^7j&P@}V&A_`dvlIs}-{eb+udNRmK%LUYWA}?)y2e9E z#%-nWOaZKEmVTun)M+@)TxFN;NA|D{@} zCHh+9i0Y+W;lvG!kQVf&fM)fC*vG@aiOQ8anz<)OJQ??{{wvkcW#~cCfKwf}36exJ zmss%0$Uf(Qo3u^JUzybclzV~|)=SOswEG2qlEfx_B)cQpbFFJg2!vJRBpN}?y|zjl zZ@*-%U4#?mnOTN^(i&De6*dh$}9OhY+>nCz*m2e$uv) ze|(8Em5pbXAJrL$7AZXIfPD+g_A%U|tCxm&@(bS2^`GWXu1DX@_p<2WBHWkRm@KR+ zfn3h!$(L4}!0mX#i+Ah$&(%i$%2>IiV)z0sQ}$n`0ceTFNga`VzUZn3iV1g}d>M*= zjtK8W7{dr9Ce8tyVPN`Ii-he(sJ?&8D zOcko$_;Y2J3gnr%&3A>^3C-alD&d2G3X{k|Q$bSS0|Xg>3ACI!1gxj7@y!r~teFl_ zf9piyszpS8S*pEknur!ypa?k~PImVv_l9tasc!ZD^CSQ3aR*VB@-Ny38y(BcOf6!7 zmtI$G3%ou2ZmYf>5(ulF9%PR)4pR!UuL-@v_8VVmCK_a-QXdkmI`6r=p|Yxw0tJw? zIT(T%HLd`SeE=sBaLWO=RYei}cI8CtVk~itr2)9Aq*=1`csBSYZwu8y!iNJOnsah_ zE#{|jhsVT<6|jyq2M~If+7R;>p6MS&%@HfQ-EIU(G)8~l2-t7pq8JhLmL@>_Dl ztxHv2K&~p))@IW2_j2bw5!PD9L~gSc=*q^MEe)V(_LndPLPqY4`OR-v_O!R@-@n4I z?fa+U*w(X!fSo?8T3`Oka?1B20x)GwR-&NkU!qLRjY#U6l5P2kq4xmGK4Br!HV-yF zp`X3p+Nl9cKUOc{VQ_;=iB}Qa>^gNZ96VGV7AMNl9I6}j`-6CGl6*7CN1W?>m9|1p z?DYX8C-8rKGTTOAk}++?_uq)t1-qQ(oHwuoAjiUvQIR4sk&0{0pZ&+M&8dQAq~i*R zGqs~~S{vi)w}$=9JzXKQ)yu@7%IML84%?+vsXSu zK4kD*!bwPt*81L&6|I}=E6?6;Un<+7>2U#E#TF&SewD;%1KpY7EO*aFqEK1RAB{Dq z`HyV5lWQrMv7OP}tkpG2+QFjM$|;JJj)#YF$JdNt#@rfj1cSQgCflrh2Lu9~6=Gt_ zOz{gvaOm0$GYcvKjDTb)HJ`8mZ`~)v5{jnWF~UiiCWYMM6ZH?}ggIXlf%Q_|86v>V z9i=*4e2x;z1A>OLAb%6l;Cj1FMZ{X(q2f*dt%2nb@6y-jSnzD~_@_!XH~~;S{y9aE z`=a>t;%7uQA7E0-k~RL>oeM_W8vh*51t@>SL+4KeAY0U1xbMimDhmX>P%Tg3rF++`9*>{)1Z*r-eMttb0V|x zsI&3%bMo?YukNL>u4p?!oa{dRQi`RBG{!hnfm}+?DbH*x<`I82 zraBa-HexMO8Pk?l{x&3C`WI#Pr^ZGg70U{8ba#5IS{6ahdTf4P)=ytu$$Zyj+TMFoK-Bdv34;&*s1O-<^@1SMBFbFve_!I?1!W>uy-TQ)! zCCkbZa!Zxbra{a&PAMHC;v~O^{lXt!joYYL9seS3I!SjCT*>gR;JuEO8X#_vT&q59 zi+IRr?G5Q{%_Y8-Htv5HKMwnehva(k1j6d>B>mU=Z!5V-fRBG;#N~(9;&wg2!|ut~ zV`WqeptLx2z%!Fus}y*w@x+Sigb@*Wvm#_)yW`;a=49kZBJzHJ|8R2?!rB|w7%`{; z457m_M+MMXQHd;#t>1!Ndr7W5C3@=d=&t7FZ(Fb)h*#)5-jbNZu|C((lbkqWpcZgS zQW`}8ku=0V33M;dg-gW4^<)5qjb@^XRHWMSA&(ye-{dD}F>tUEK0OYdJx5oJ->|28PC z974Ejds_yE$5AP){kQaBq8r2on7~z%dCZausZW)oE5~AxIyYOop4fnHg^N#g@8~zz zzJ?pi?(Nuom&BN|Dann2MRomeH57luqn>S^TviW`Eniut@f3j#A!{*Pb$uW4Sj-Ja zGPq$3@i~`oZ+@N6$b$d&V4ZWS+~&_ah;2Fc`50o)?RmTPqMG(eoPbJfSb2B~h zA7dx$J7y0=?%YrK4AKC7qvOGOOVylQuO%eVx)XueAi0npTTGLlYX*um-4rN@{@gmy za3hU&1KjP6ZTH#CJ(i35G}Jy?Q(k`kUVJyr`EZba@AGnN^BO4RP)1U^%RR;vc`3oP z(rAEi_eXm&>lek>6w1hh%g$BiV>hobT)7eRriI4__=DJvpER<{W0xRS0MH;I zaGqZVHy8lE&%E8m&FNtTQL8|Eic4{E@$yMYaY;$CvWoF=@JNVB@$ibXN^!IO=h^xA zgvkW||4KkRD$taW9RJgI0P00~mH1yoe{S6Jq)T~XLlMr|QOa7Nn{)rH1*9^!8aB%LL zjyiB&(Kb_6G*+l?cr>l5TiL94T+zaXTKm1@vx{Vc+FS+N_hUl`Ao)3HzfC;-HD-3N z^cs2kOAcjlp7vr0HHF1I5HY{n%R`FE1%4W$(uP1HhgCJfC>b!-hB`}xlqbh(H2!Wb zj>;G*MjK*E8;nzrDQAL{I$*nIsu-ASv`p~3o`&7bUi$+OdQ`s>v97!n`)?UzRuE@* z;seY-7A{EWPjue{KuJV{<@UaoN?7)P#2R10eOq*v<;Ev`z}fTyPg7StDLM6~UHy39 zR~N%k7e|pO#62${X%(mB6h#6@K-Z6NTrCE|I@IH|4v?G%1=K?m7>jTYDXqcQ)Mu8u zNXHAf(&;*ajF`O+F@x>gx3ceeys>@v@$cF8^U0#)srYXJCu8}P9`Q>ZyoAUo&$}4B zCoG=@E#*qj0Yo7~3eWEk{TLBc^Dn0_{T`e3MsTf)3A4(GuGe025)aAL0eo>rIXN4C$m2e0%w_N+PpXwJHZ1cZ>+qC)YOv7 HQi%Tx?2l-m From b5713596cb1b951a1de2a159311c1e6ccd5228ba Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Thu, 22 Feb 2024 12:37:34 -0500 Subject: [PATCH 14/24] adding package down website --- .Rbuildignore | 3 +++ .github/workflows/pkgdown.yaml | 48 ++++++++++++++++++++++++++++++++++ .gitignore | 1 + DESCRIPTION | 2 +- README.Rmd | 5 ++-- _pkgdown.yml | 4 +++ man/BGmisc-package.Rd | 1 + 7 files changed, 60 insertions(+), 4 deletions(-) create mode 100644 .github/workflows/pkgdown.yaml create mode 100644 _pkgdown.yml diff --git a/.Rbuildignore b/.Rbuildignore index 1245469..cb0953f 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -15,3 +15,6 @@ ^\.lintr$ ^CODE_OF_CONDUCT\.md$ ^CONTRIBUTING\.md$ +^_pkgdown\.yml$ +^docs$ +^pkgdown$ diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml new file mode 100644 index 0000000..a7276e8 --- /dev/null +++ b/.github/workflows/pkgdown.yaml @@ -0,0 +1,48 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + release: + types: [published] + workflow_dispatch: + +name: pkgdown + +jobs: + pkgdown: + runs-on: ubuntu-latest + # Only restrict concurrency for non-PR jobs + concurrency: + group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::pkgdown, local::. + needs: website + + - name: Build site + run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) + shell: Rscript {0} + + - name: Deploy to GitHub pages 🚀 + if: github.event_name != 'pull_request' + uses: JamesIves/github-pages-deploy-action@v4.5.0 + with: + clean: false + branch: gh-pages + folder: docs diff --git a/.gitignore b/.gitignore index d14ab3b..9d9975f 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ BGmisc.code-workspace .lintr tests/testthat/Rplots.pdf +docs diff --git a/DESCRIPTION b/DESCRIPTION index 5525561..f547d85 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: BGmisc Title: An R Package for Extended Behavior Genetics Analysis Version: 1.2.0 -URL: https://github.com/R-Computing-Lab/BGmisc/ +URL: https://github.com/R-Computing-Lab/BGmisc/, https://r-computing-lab.github.io/BGmisc/ BugReports: https://github.com/R-Computing-Lab/BGmisc/issues Authors@R: c(person("S. Mason", "Garrison", email = "garrissm@wfu.edu", role = c("aut", "cre"), comment=c(ORCID = "0000-0002-4804-6003")), diff --git a/README.Rmd b/README.Rmd index 8a52e82..27dfc15 100644 --- a/README.Rmd +++ b/README.Rmd @@ -40,17 +40,16 @@ install.packages("BGmisc") To install the development version of BGmisc from [GitHub](https://github.com/) use: ```r +# If devtools is not installed, uncomment the line below to install it before installing BGmisc. # install.packages("devtools") devtools::install_github("R-Computing-Lab/BGmisc") ``` ## Citation - If you use BGmisc in your research or wish to refer to it, please cite the following paper: - ```{r eval=TRUE, comment=NA} -citation(package="BGmisc") +citation(package = "BGmisc") ``` diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 0000000..3ee3892 --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,4 @@ +url: https://r-computing-lab.github.io/BGmisc/ +template: + bootstrap: 5 + diff --git a/man/BGmisc-package.Rd b/man/BGmisc-package.Rd index 2be080d..963688f 100644 --- a/man/BGmisc-package.Rd +++ b/man/BGmisc-package.Rd @@ -12,6 +12,7 @@ The BGmisc R package offers a comprehensive suite of functions tailored for exte Useful links: \itemize{ \item \url{https://github.com/R-Computing-Lab/BGmisc/} + \item \url{https://r-computing-lab.github.io/BGmisc/} \item Report bugs at \url{https://github.com/R-Computing-Lab/BGmisc/issues} } From c80b9643f00a6ca8f97cf8c2577f50779b203776 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Fri, 23 Feb 2024 11:23:52 -0500 Subject: [PATCH 15/24] prepping for rcran update --- cran-comments.md | 14 +-- tests/testthat/test-network.R | 2 +- vignettes/pedigree.Rmd | 22 ++-- vignettes/pedigree.html | 217 +++++++++++++++++----------------- 4 files changed, 122 insertions(+), 133 deletions(-) diff --git a/cran-comments.md b/cran-comments.md index a26dd32..e481b99 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -2,15 +2,15 @@ Description ----------------------------------------------- -This is a hotfix for the BGmisc package, as we discovered that the plotPedigree wrapper function broke for pedigrees that contained multiple families. +This update reflects a substantial improvement in the codebase as part of the peer review process for JOSS, including the addition of numerous function checks, increased code coverage to 85%, and the replacement of sapply usage. We also added a new function to simulate twins and the ability to trace paternal and maternal lines. We also added a Harry Potter pedigree. + Test Environments ----------------------------------------------- -1. Local OS: Windows 10, R version 4.2.3 -2. Local OS: Windows 10, R version 4.3.1 -3. **GitHub Actions**: - - [Link](https://github.com/R-Computing-Lab/BGmisc/actions/runs/6317831880) +1. Local OS: Windows 11, R version 4.3.2 +2. **GitHub Actions**: + - [Link](https://github.com/R-Computing-Lab/BGmisc/actions/runs/8008686394) - macOS (latest version) with the latest R release. - Windows (latest version) with the latest R release. - Ubuntu (latest version) with: @@ -20,8 +20,8 @@ Test Environments ## R CMD check results -──────────────────────── BGmisc 1.0.1 ──── -Duration: 1m 1.4s +── R CMD check results BGmisc 1.2.0 ──── +Duration: 1m 0.6s 0 errors ✔ | 0 warnings ✔ | 0 notes ✔ diff --git a/tests/testthat/test-network.R b/tests/testthat/test-network.R index 7af6e05..d5ecbfe 100755 --- a/tests/testthat/test-network.R +++ b/tests/testthat/test-network.R @@ -175,6 +175,6 @@ test_that("ped2maternal/paternal produces correct matrix dims", { pat <- ped2paternal(hazard) expect_equal(dim(pat), c(nrow(hazard), ncol(hazard)+1)) - expect_less_than(cor(pat$patID, mat$matID), 1) + expect_lt(cor(pat$patID, mat$matID), 1) }) diff --git a/vignettes/pedigree.Rmd b/vignettes/pedigree.Rmd index 00df241..aa029e1 100644 --- a/vignettes/pedigree.Rmd +++ b/vignettes/pedigree.Rmd @@ -15,28 +15,20 @@ knitr::opts_chunk$set( options(rmarkdown.html_vignette.check_title = FALSE) ``` - # Introduction -This vignette provides a detailed guide to the pedigree-related functions within the `BGmisc` package. - -## Loading Required Libraries - -```{r setup} -library(BGmisc) -``` - -# Simulating Pedigrees - - - Unlike Tolstoy, where *only* happy families are alike, all pedigrees are alike -- or at least, all simulated pedigrees are alike. The `simulatePedigree` function generates a pedigree with a user-specified number of generations and individuals per generation. This function provides users the opportunity to test family models in pedigrees with a customized pedigree length and width. These pedigrees can be simulated as a function of several parameters, including the number of children per mate, generations, sex ratio of newborns, and mating rate. Given that large family pedigrees are difficult to collect or access, simulated pedigrees serve as an efficient tool for researchers. These simulated pedigrees are useful for building family-based statistical models, and evaluating their statistical properties, such as power, bias, and computational efficiency. -To illustrate this, let us generate a pedigree. This pedigree has a total of four generations, in which each person who "mates", grows a family with four offspring. In our scenario, the number of male and female newborns is equal. In this illustration 70% of individuals will mate and bear offspring. Such a pedigree structure can be simulated by running: + +To illustrate this functionality, let us generate a pedigree. This pedigree has a total of four generations (`Ngen`), in which each person who "mates", grows a family with four offspring (`kpc`). In our scenario, the number of male and female newborns is equal, but can be adjusted via (`sexR`). In this illustration 70% of individuals will mate and bear offspring (`marR`). Such a pedigree structure can be simulated by running the following code: ```{r} + +## Loading Required Libraries +library(BGmisc) + set.seed(5) df_ped <- simulatePedigree( kpc = 4, @@ -58,7 +50,7 @@ The columns represents the individual's family ID, the individual's personal ID, ## Plotting Pedigree -Pedigrees are visual diagrams that represent family relationships across generations. They are commonly used in genetics to trace the inheritance of specific traits or conditions. This vignette will guide you through visualizing simulated pedigrees using the `plotPedigree` function. This function is a wrapper function for Kinship2's base R plotting. +Pedigrees are visual diagrams that represent family relationships across generations. They are commonly used in genetics to trace the inheritance of specific traits or conditions. This vignette will guide you through visualizing simulated pedigrees using the `plotPedigree` function. This function is a wrapper function for `Kinship2`'s base R plotting. ### Single Pedigree Visualization diff --git a/vignettes/pedigree.html b/vignettes/pedigree.html index 18ad2f0..0b13234 100644 --- a/vignettes/pedigree.html +++ b/vignettes/pedigree.html @@ -343,15 +343,6 @@

Pedigree Simulation and Visualization with

Introduction

-

This vignette provides a detailed guide to the pedigree-related -functions within the BGmisc package.

-
-

Loading Required Libraries

-
library(BGmisc)
-
-
-
-

Simulating Pedigrees

Unlike Tolstoy, where only happy families are alike, all pedigrees are alike – or at least, all simulated pedigrees are alike. The simulatePedigree function generates a pedigree with a @@ -366,41 +357,47 @@

Simulating Pedigrees

building family-based statistical models, and evaluating their statistical properties, such as power, bias, and computational efficiency.

-

To illustrate this, let us generate a pedigree. This pedigree has a -total of four generations, in which each person who “mates”, grows a -family with four offspring. In our scenario, the number of male and -female newborns is equal. In this illustration 70% of individuals will -mate and bear offspring. Such a pedigree structure can be simulated by -running:

-
set.seed(5)
-df_ped <- simulatePedigree(
-  kpc = 4,
-  Ngen = 4,
-  sexR = .5,
-  marR = .7
-)
-summary(df_ped)
-#>      fam                  ID              gen            dadID       
-#>  Length:57          Min.   : 10011   Min.   :1.000   Min.   : 10012  
-#>  Class :character   1st Qu.: 10036   1st Qu.:3.000   1st Qu.: 10024  
-#>  Mode  :character   Median :100312   Median :3.000   Median : 10037  
-#>                     Mean   : 59171   Mean   :3.298   Mean   : 42859  
-#>                     3rd Qu.:100416   3rd Qu.:4.000   3rd Qu.:100311  
-#>                     Max.   :100432   Max.   :4.000   Max.   :100320  
-#>                                                      NA's   :13      
-#>      momID             spt             sex           
-#>  Min.   : 10011   Min.   : 10011   Length:57         
-#>  1st Qu.: 10022   1st Qu.: 10025   Class :character  
-#>  Median : 10036   Median : 10036   Mode  :character  
-#>  Mean   : 42859   Mean   : 40124                     
-#>  3rd Qu.:100316   3rd Qu.:100311                     
-#>  Max.   :100318   Max.   :100320                     
-#>  NA's   :13       NA's   :33
+

To illustrate this functionality, let us generate a pedigree. This +pedigree has a total of four generations (Ngen), in which +each person who “mates”, grows a family with four offspring +(kpc). In our scenario, the number of male and female +newborns is equal, but can be adjusted via (sexR). In this +illustration 70% of individuals will mate and bear offspring +(marR). Such a pedigree structure can be simulated by +running the following code:

+

+## Loading Required Libraries
+library(BGmisc)
+
+set.seed(5)
+df_ped <- simulatePedigree(
+  kpc = 4,
+  Ngen = 4,
+  sexR = .5,
+  marR = .7
+)
+summary(df_ped)
+#>      fam                  ID              gen            dadID       
+#>  Length:57          Min.   : 10011   Min.   :1.000   Min.   : 10012  
+#>  Class :character   1st Qu.: 10036   1st Qu.:3.000   1st Qu.: 10024  
+#>  Mode  :character   Median :100312   Median :3.000   Median : 10037  
+#>                     Mean   : 59171   Mean   :3.298   Mean   : 42859  
+#>                     3rd Qu.:100416   3rd Qu.:4.000   3rd Qu.:100311  
+#>                     Max.   :100432   Max.   :4.000   Max.   :100320  
+#>                                                      NA's   :13      
+#>      momID             spt             sex           
+#>  Min.   : 10011   Min.   : 10011   Length:57         
+#>  1st Qu.: 10022   1st Qu.: 10025   Class :character  
+#>  Median : 10036   Median : 10036   Mode  :character  
+#>  Mean   : 42859   Mean   : 40124                     
+#>  3rd Qu.:100316   3rd Qu.:100311                     
+#>  Max.   :100318   Max.   :100320                     
+#>  NA's   :13       NA's   :33

The simulation output is a data.frame with 57 rows and 7 columns. Each row corresponds to a simulated individual.

-
df_ped[21, ]
-#>      fam     ID gen dadID momID    spt sex
-#> 21 fam 1 100312   3 10024 10022 100317   M
+
df_ped[21, ]
+#>      fam     ID gen dadID momID    spt sex
+#> 21 fam 1 100312   3 10024 10022 100317   M

The columns represents the individual’s family ID, the individual’s personal ID, the generation the individual is in, the IDs of their father and mother, the ID of their spouse, and the biological sex of the @@ -412,14 +409,14 @@

Plotting Pedigree

inheritance of specific traits or conditions. This vignette will guide you through visualizing simulated pedigrees using the plotPedigree function. This function is a wrapper function -for Kinship2’s base R plotting.

+for Kinship2’s base R plotting.

Single Pedigree Visualization

To visualize a single simulated pedigree, use the plotPedigree() function.

-
# Plot the simulated pedigree
-plotPedigree(df_ped)
-

+
# Plot the simulated pedigree
+plotPedigree(df_ped)
+

#> Did not plot the following people: 10032
 #> $plist
 #> $plist$n
@@ -538,70 +535,70 @@ 
Visualizing Multiple Pedigrees Side-by-Side

 
If you wish to compare different pedigrees side by side, you can plot
 them together. For instance, let’s visualize pedigrees for families
 spanning three and four generations, respectively.

-
set.seed(8)
-# Simulate a family with 3 generations
-df_ped_3 <- simulatePedigree(Ngen = 3)
-
-# Simulate a family with 4 generations
-df_ped_4 <- simulatePedigree(Ngen = 4)
-
-# Set up plotting parameters for side-by-side display
-par(mfrow = c(1, 2))
-
-# Plot the 3-generation pedigree
-plotPedigree(df_ped_3, width = 3)
-#> $plist
-#> $plist$n
-#> [1] 2 5 6
-#> 
-#> $plist$nid
-#>      [,1] [,2] [,3] [,4] [,5] [,6]
-#> [1,]    2    1    0    0    0    0
-#> [2,]    3    5    4    6    7    0
-#> [3,]    8   10   11    9   12   13
-#> 
-#> $plist$pos
-#>              [,1]     [,2] [,3] [,4] [,5] [,6]
-#> [1,] 1.166667e+00 2.166667    0    0    0    0
-#> [2,] 2.047042e-09 1.000000    2    3    4    0
-#> [3,] 0.000000e+00 1.000000    2    3    4    5
-#> 
-#> $plist$fam
-#>      [,1] [,2] [,3] [,4] [,5] [,6]
-#> [1,]    0    0    0    0    0    0
-#> [2,]    1    1    0    0    1    0
-#> [3,]    2    2    2    4    4    4
-#> 
-#> $plist$spouse
-#>      [,1] [,2] [,3] [,4] [,5] [,6]
-#> [1,]    1    0    0    0    0    0
-#> [2,]    0    1    0    1    0    0
-#> [3,]    0    0    0    0    0    0
-#> 
-#> 
-#> $x
-#>  [1] 2.166667e+00 1.166667e+00 2.047042e-09 2.000000e+00 1.000000e+00
-#>  [6] 3.000000e+00 4.000000e+00 0.000000e+00 3.000000e+00 1.000000e+00
-#> [11] 2.000000e+00 4.000000e+00 5.000000e+00
-#> 
-#> $y
-#>  [1] 1 1 2 2 2 2 2 3 3 3 3 3 3
-#> 
-#> $boxw
-#> [1] 0.2006421
-#> 
-#> $boxh
-#> [1] 0.0565539
-#> 
-#> $call
-#> kinship2::plot.pedigree(x = p3, cex = cex, col = col, symbolsize = symbolsize, 
-#>     branch = branch, packed = packed, align = align, width = width, 
-#>     density = density, angle = angle, keep.par = keep.par, pconnect = pconnect, 
-#>     mar = mar)
-
-# Plot the 4-generation pedigree
-plotPedigree(df_ped_4, width = 1)

-

+
set.seed(8)
+# Simulate a family with 3 generations
+df_ped_3 <- simulatePedigree(Ngen = 3)
+
+# Simulate a family with 4 generations
+df_ped_4 <- simulatePedigree(Ngen = 4)
+
+# Set up plotting parameters for side-by-side display
+par(mfrow = c(1, 2))
+
+# Plot the 3-generation pedigree
+plotPedigree(df_ped_3, width = 3)
+#> $plist
+#> $plist$n
+#> [1] 2 5 6
+#> 
+#> $plist$nid
+#>      [,1] [,2] [,3] [,4] [,5] [,6]
+#> [1,]    2    1    0    0    0    0
+#> [2,]    3    5    4    6    7    0
+#> [3,]    8   10   11    9   12   13
+#> 
+#> $plist$pos
+#>              [,1]     [,2] [,3] [,4] [,5] [,6]
+#> [1,] 1.166667e+00 2.166667    0    0    0    0
+#> [2,] 2.047042e-09 1.000000    2    3    4    0
+#> [3,] 0.000000e+00 1.000000    2    3    4    5
+#> 
+#> $plist$fam
+#>      [,1] [,2] [,3] [,4] [,5] [,6]
+#> [1,]    0    0    0    0    0    0
+#> [2,]    1    1    0    0    1    0
+#> [3,]    2    2    2    4    4    4
+#> 
+#> $plist$spouse
+#>      [,1] [,2] [,3] [,4] [,5] [,6]
+#> [1,]    1    0    0    0    0    0
+#> [2,]    0    1    0    1    0    0
+#> [3,]    0    0    0    0    0    0
+#> 
+#> 
+#> $x
+#>  [1] 2.166667e+00 1.166667e+00 2.047042e-09 2.000000e+00 1.000000e+00
+#>  [6] 3.000000e+00 4.000000e+00 0.000000e+00 3.000000e+00 1.000000e+00
+#> [11] 2.000000e+00 4.000000e+00 5.000000e+00
+#> 
+#> $y
+#>  [1] 1 1 2 2 2 2 2 3 3 3 3 3 3
+#> 
+#> $boxw
+#> [1] 0.2006421
+#> 
+#> $boxh
+#> [1] 0.0565539
+#> 
+#> $call
+#> kinship2::plot.pedigree(x = p3, cex = cex, col = col, symbolsize = symbolsize, 
+#>     branch = branch, packed = packed, align = align, width = width, 
+#>     density = density, angle = angle, keep.par = keep.par, pconnect = pconnect, 
+#>     mar = mar)
+
+# Plot the 4-generation pedigree
+plotPedigree(df_ped_4, width = 1)

+

 
#> $plist
 #> $plist$n
 #> [1]  2  5 10 12

From a11e9aef86990f57a55bfe20494f31c6806b175e Mon Sep 17 00:00:00 2001
From: Mason Garrison 
Date: Mon, 26 Feb 2024 16:49:45 -0500
Subject: [PATCH 16/24] Create checkParents.X

---
 R/checkParents.X | 154 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 154 insertions(+)
 create mode 100644 R/checkParents.X

diff --git a/R/checkParents.X b/R/checkParents.X
new file mode 100644
index 0000000..d6cea52
--- /dev/null
+++ b/R/checkParents.X
@@ -0,0 +1,154 @@
+# Challenge: Missing parents: If one parent is missing and the other one isn't, this needs to be handled somehow. Firstly, I think it can cause certain ways of estimating relatedness to give wrong numbers. And secondly, it requires us to make guesses in cases where e.g. two people have the same mother and missing fathers: They could then be either half-sibs, if the missing fathers are different people, or full sibs if not. This then also affects relatedness for their descendants.
+
+#' Validates and Optionally Repairs Parent IDs in a Pedigree Dataframe
+#'
+#' This function takes a pedigree object and performs two main tasks:
+#' 1. Checks for the validity of parent IDs, specifically looking for instances where only one parent ID is missing.
+#' 2. Optionally repairs the missing parent IDs based on a specified logic.
+#'
+#' @param ped A dataframe representing the pedigree data with columns 'ID', 'dadID', and 'momID'.
+#' @param verbose A logical flag indicating whether to print progress and validation messages to the console.
+#' @param repair A logical flag indicating whether to attempt repairs on missing parent IDs.
+#'
+#' @return Depending on the value of `repair`, either a list containing validation results or a repaired dataframe is returned.
+#' @examples
+#' \dontrun{
+#' ped <- data.frame(ID = 1:4, dadID = c(NA, 1, 1, 2), momID = c(NA, NA, 2, 2))
+#' checkParentIDs(ped, verbose = TRUE, repair = FALSE)
+#' }
+#' @export
+checkParentIDs <- function(ped, verbose = FALSE, repair = FALSE) {
+  # Standardize column names in the input dataframe
+  ped <- standardize_colnames(ped)
+
+  # Initialize a list to store validation results
+  validation_results <- list()
+
+  if (verbose) {
+    cat("Step 1: Checking for missing parents...\n")
+  }
+
+  # Identify missing fathers and mothers
+  missing_fathers <- ped$ID[which(is.na(ped$dadID) & !is.na(ped$momID))]
+  missing_mothers <- ped$ID[which(!is.na(ped$dadID) & is.na(ped$momID))]
+
+  # Update the validation_results list
+  if (length(missing_fathers) > 0) {
+    validation_results$missing_fathers <- missing_fathers
+  }
+  if (length(missing_mothers) > 0) {
+    validation_results$missing_mothers <- missing_mothers
+  }
+
+  # If no missing parents are found
+  if (length(validation_results) == 0) {
+    if (verbose) {
+      cat("No missing single parents found.\n")
+    }
+    validation_results$missing_parents <- FALSE
+  }
+  # If missing parents are found
+  else {
+    if (verbose) {
+      cat("Missing single parents found.\n")
+    }
+    validation_results$missing_parents <- TRUE
+  }
+
+  if (verbose) {
+    cat("Step 2: Determining the if moms are the same sex and dads are same sex\n")
+  }
+
+  # Determine the most frequent sex for moms and dads
+  most_frequent_sex_mom <- names(sort(table(ped$sex[ped$ID %in% ped$momID]), decreasing = TRUE))[1]
+  most_frequent_sex_dad <- names(sort(table(ped$sex[ped$ID %in% ped$dadID]), decreasing = TRUE))[1]
+
+  # are all moms/dads the same sex?
+  validation_results$mom_sex <- unique(ped$sex[ped$ID %in% ped$momID])
+  validation_results$dad_sex <- unique(ped$sex[ped$ID %in% ped$dadID])
+
+  # Store the most frequent sex for moms and dads
+  if (is.numeric(ped$sex)) {
+    validation_results$female_var <- as.numeric(most_frequent_sex_mom)
+    validation_results$male_var <- as.numeric(most_frequent_sex_dad)
+  } else if (is.character(ped$sex) | is.factor(ped$sex)) {
+    validation_results$female_var <- most_frequent_sex_mom
+    validation_results$male_var <- most_frequent_sex_dad
+  } else {
+    print("You should never see this. If you do, then you have a problem with the data type of the sex variable")
+  }
+
+  # verbose
+  if (length(validation_results$mom_sex) == 1) {
+    if (verbose) {
+      cat(paste0(
+        "All moms are '",
+        validation_results$female_var,
+        "'.\n"
+      ))
+    }
+    validation_results$female_moms <- TRUE
+  } else {
+    validation_results$female_moms <- FALSE
+  }
+
+  if (length(validation_results$dad_sex) == 1) {
+    if (verbose) {
+      cat(paste0(
+        "All dads are '",
+        validation_results$male_var,
+        "'.\n"
+      ))
+    }
+    validation_results$male_dads <- TRUE
+  } else {
+    validation_results$male_dads <- FALSE
+  }
+  # Check for inconsistent gender roles
+  wrong_sex_moms <- ped$ID[which(ped$sex[ped$ID %in% ped$momID] != validation_results$female_var)]
+  wrong_sex_dads <- ped$ID[which(ped$sex[ped$ID %in% ped$dadID] != validation_results$male_var)]
+
+
+
+  # Are any parents in both momID and dadID?
+  momdad <- intersect(ped$dadID, ped$momID)
+  if (length(momdad) > 0) {
+    validation_results$parents_in_both <- momdad
+  }
+
+
+  male_moms <- ped$ID[which(ped$dadID & !is.na(ped$momID))]
+
+  if (repair) {
+    if (verbose) {
+      cat("Validation Results:\n")
+      print(validation_results)
+      cat("Step 2: Attempting to repair missing parents...\n")
+    }
+    cat("REPAIR IN EARLY ALPHA\n")
+    # Initialize a list to track changes made during repair
+    changes <- list()
+
+    # [Insert logic to repair parent IDs here]
+
+    # Update the pedigree dataframe after repair
+    repaired_ped <- ped
+
+    if (verbose) {
+      cat("Changes Made:\n")
+      print(changes)
+    }
+    return(repaired_ped)
+  } else {
+    return(validation_results)
+  }
+}
+#' Repair Parent IDs
+#'
+#' This function repairs parent IDs in a pedigree.
+#' @param ped A pedigree object
+#' @param verbose A logical indicating whether to print progress messages
+#' @return A corrected pedigree
+repairParentIDs <- function(ped, verbose = FALSE) {
+  checkParentIDs(ped = ped, verbose = verbose, repair = TRUE)
+}

From 7a3b6639cbfdcc94de2433f3cebdfa65fa255ef0 Mon Sep 17 00:00:00 2001
From: Mason Garrison 
Date: Fri, 1 Mar 2024 16:57:03 -0500
Subject: [PATCH 17/24] Falconer's formula

---
 R/formula.R                                 | 30 +++++++++++++++++++++
 man/calculateH.Rd                           | 25 +++++++++++++++++
 tests/testthat/test-relatedness-functions.R | 28 +++++++++++++++++++
 3 files changed, 83 insertions(+)
 create mode 100644 man/calculateH.Rd

diff --git a/R/formula.R b/R/formula.R
index 03c897f..a7c2627 100644
--- a/R/formula.R
+++ b/R/formula.R
@@ -87,3 +87,33 @@ inferRelatedness <- function(obsR, aceA = .9, aceC = 0, sharedC = 0) {
   calc_r <- (obsR - sharedC * aceC) / aceA
   return(calc_r)
 }
+
+#' Falconer's Formula
+#' Use Falconer's formula to solve for H using the observed correlations for two groups of any two relatednesses.
+#' @param r1 Relatedness coefficient of the first group.
+#' @param r2 Relatedness coefficient of the second group.
+#' @param obsR1 Observed correlation between members of the first group.
+#' @param obsR2 Observed correlation between members of the second group.
+#'
+#' @return Heritability estimates (`heritability_estimates`).
+
+calculateH <- function(r1, r2, obsR1, obsR2) {
+  # Check for equal relatedness coefficients to avoid division by zero
+  if (any(r1 - r2 == 0)) {
+    stop("Relatedness coefficients r1 and r2 must not be equal for any pair.")
+  }
+
+  # Calculate heritability estimates (H^2) for all pairs
+  heritability_estimates <- (obsR1 - obsR2) / (r1 - r2)
+  # Check for unrealistic heritability estimates and warn the user
+  if (any(heritability_estimates < 0)) {
+    warning("Some calculated heritability values are negative, which may indicate non-genetic influences or measurement errors.")
+  }
+
+  if (any(heritability_estimates > 1)) {
+    warning("Some calculated heritability values are greater than 1, which may suggest overestimation or errors in the observed correlations or relatedness coefficients.")
+  }
+
+
+  return(heritability_estimates)
+}
diff --git a/man/calculateH.Rd b/man/calculateH.Rd
new file mode 100644
index 0000000..9fe2415
--- /dev/null
+++ b/man/calculateH.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/formula.R
+\name{calculateH}
+\alias{calculateH}
+\title{Falconer's Formula
+Use Falconer's formula to solve for H using the observed correlations for two groups of any two relatednesses.}
+\usage{
+calculateH(r1, r2, obsR1, obsR2)
+}
+\arguments{
+\item{r1}{Relatedness coefficient of the first group.}
+
+\item{r2}{Relatedness coefficient of the second group.}
+
+\item{obsR1}{Observed correlation between members of the first group.}
+
+\item{obsR2}{Observed correlation between members of the second group.}
+}
+\value{
+Heritability estimates (`heritability_estimates`).
+}
+\description{
+Falconer's Formula
+Use Falconer's formula to solve for H using the observed correlations for two groups of any two relatednesses.
+}
diff --git a/tests/testthat/test-relatedness-functions.R b/tests/testthat/test-relatedness-functions.R
index a2f4108..c3eedc0 100644
--- a/tests/testthat/test-relatedness-functions.R
+++ b/tests/testthat/test-relatedness-functions.R
@@ -33,3 +33,31 @@ test_that("inferRelatedness performs as expected", {
     "aceA and aceC must be proportions between 0 and 1"
   )
 })
+
+
+# Test 1: Basic Functionality Test
+test_that("calculateH returns correct heritability estimates", {
+  expect_equal(calculateH(0.5, 0.25, 0.4, 0.2), 0.8)
+  expect_equal(calculateH(0.5, 0.125, 0.5, 0.25), 2/3, tolerance = 1e-8)
+})
+
+# Test 2: Vectorized Input Test
+test_that("calculateH handles vectorized inputs correctly", {
+  r1 <- c(0.5, 0.25)
+  r2 <- c(0.25, 0.125)
+  obsR1 <- c(0.4, 0.3)
+  obsR2 <- c(0.2, 0.1)
+  expected <- c(0.8, 1.6)
+  expect_equal(calculateH(r1, r2, obsR1, obsR2), expected)
+})
+
+# Test 3: Equal Relatedness Coefficients Test
+test_that("calculateH stops for equal relatedness coefficients", {
+  expect_error(calculateH(0.5, 0.5, 0.4, 0.2), "Relatedness coefficients r1 and r2 must not be equal for any pair.")
+})
+
+# Test 4: Negative and Positive Correlation Test
+test_that("calculateH handles both negative and positive correlations", {
+  expect_equal(calculateH(0.5, 0.25, -0.4, -0.2), -0.8)
+  expect_equal(calculateH(0.5, 0.25, 0.2, -0.1), 1.2)
+})

From 7e22aa6c39dbd85971b78a297145c8335e3490be Mon Sep 17 00:00:00 2001
From: Mason Garrison 
Date: Tue, 5 Mar 2024 18:40:10 -0500
Subject: [PATCH 18/24] typing

---
 .gitignore  | 6 +-----
 .lintr      | 2 ++
 DESCRIPTION | 7 ++++---
 3 files changed, 7 insertions(+), 8 deletions(-)
 create mode 100644 .lintr

diff --git a/.gitignore b/.gitignore
index 9d9975f..3f8093b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,13 +4,9 @@ R/plane.txt
 R/.Rhistory
 .Rhistory
 paper/paper.html
-inst/doc
-/doc/
 /Meta/
 *.knit.md
 vignettes/articles/paper.html
 BGmisc.code-workspace
-.lintr
-
 tests/testthat/Rplots.pdf
-docs
+
diff --git a/.lintr b/.lintr
new file mode 100644
index 0000000..10e49fe
--- /dev/null
+++ b/.lintr
@@ -0,0 +1,2 @@
+linters: linters_with_defaults(line_length_linter(120),commented_code_linter = NULL,object_name_linter = object_name_linter(styles = c("snake_case", "symbols"))) # see vignette("lintr")
+encoding: "UTF-8"
diff --git a/DESCRIPTION b/DESCRIPTION
index 17c3eee..87bd776 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: BGmisc
 Title: An R Package for Extended Behavior Genetics Analysis
 Version: 1.2.0
 Authors@R: c(
-    person("S. Mason", "Garrison", , "garrissm@wfu.edu", role = c("aut", "cre"),
+    person("S. Mason", "Garrison", , email= "garrissm@wfu.edu", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-4804-6003")),
     person(c("Michael", "D."), "Hunter", role = "aut",
            comment = c(ORCID = "0000-0002-3651-6709")),
@@ -10,8 +10,9 @@ Authors@R: c(
            comment = c(ORCID = "0000-0002-2841-5529")),
     person(c("Rachel", "N."), "Good", role = "aut",
            comment = c(ORCID = "0000-0000-0000-0000")),
-    person(c("Jonathan", "D."), "Trattner", role = "aut",
-           comment = c(ORCID = "0000-0002-1097-7603")),
+    person(c("Jonathan", "D."), "Trattner", role = "aut", email = "code@jdtrat.com", 
+           comment = c(ORCID = "0000-0002-1097-7603",
+                       url = "https://www.jdtrat.com/")),
     person(c("S.", "Alexandra"), "Burt", role = "aut",
            comment = c(ORCID = "0000-0001-5538-7431"))
   )

From 21bd2ecb0c194977a52fc8581b9d7d6a061bb41e Mon Sep 17 00:00:00 2001
From: Mason Garrison 
Date: Thu, 21 Mar 2024 11:01:30 -0400
Subject: [PATCH 19/24] Update convertPedigree.R

prep for merging
---
 CODE_OF_CONDUCT.md            |  8 ++++----
 R/convertPedigree.R           | 30 +++++++++++++++---------------
 cran-comments.md              |  6 ++----
 man/ped2add.Rd                |  8 ++++----
 man/ped2cn.Rd                 |  8 ++++----
 man/ped2com.Rd                |  8 ++++----
 man/ped2mit.Rd                |  8 ++++----
 tests/testthat/test-network.R |  4 ++--
 8 files changed, 39 insertions(+), 41 deletions(-)

diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md
index f6002f7..3e8d15a 100644
--- a/CODE_OF_CONDUCT.md
+++ b/CODE_OF_CONDUCT.md
@@ -60,7 +60,7 @@ representative at an online or offline event.
 
 Instances of abusive, harassing, or otherwise unacceptable behavior may be
 reported to the community leaders responsible for enforcement at
-garrissm@wfu.edu.
+[garrissm@wfu.edu](mailto:garrissm@wfu.edu).
 All complaints will be reviewed and investigated promptly and fairly.
 
 All community leaders are obligated to respect the privacy and security of the
@@ -116,7 +116,7 @@ the community.
 
 This Code of Conduct is adapted from the [Contributor Covenant][homepage],
 version 2.0, available at
-https://www.contributor-covenant.org/version/2/0/code_of_conduct.html.
+.
 
 Community Impact Guidelines were inspired by [Mozilla's code of conduct
 enforcement ladder](https://github.com/mozilla/diversity).
@@ -124,5 +124,5 @@ enforcement ladder](https://github.com/mozilla/diversity).
 [homepage]: https://www.contributor-covenant.org
 
 For answers to common questions about this code of conduct, see the FAQ at
-https://www.contributor-covenant.org/faq. Translations are available at
-https://www.contributor-covenant.org/translations.
+. Translations are available at
+.
diff --git a/R/convertPedigree.R b/R/convertPedigree.R
index b3f86dc..ca74521 100644
--- a/R/convertPedigree.R
+++ b/R/convertPedigree.R
@@ -9,8 +9,8 @@
 #' @param gc logical. If TRUE, do frequent garbage collection via \code{\link{gc}} to save memory
 #' @param flatten.diag logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones
 #' @param standardize.colnames logical. If TRUE, standardize the column names of the pedigree dataset
-#' @param alt.tcross1 logical. If TRUE, use an alternative method for computing the transpose
-#' @param alt.tcross2 logical. If TRUE, use an alternative method for computing the transpose
+#' @param tcross.alt.crossprod logical. If TRUE, use alternative method of using Crossprod function for computing the transpose
+#' @param tcross.alt.star logical. If TRUE, use alternative method of using %*% for computing the transpose
 #' @param ... additional arguments to be passed to \code{\link{ped2com}}
 #' @details The algorithms and methodologies used in this function are further discussed and exemplified in the vignette titled "examplePedigreeFunctions".
 #' @export
@@ -22,8 +22,8 @@ ped2com <- function(ped, component,
                     gc = FALSE,
                     flatten.diag = FALSE,
                     standardize.colnames = TRUE,
-                    alt.tcross1 = FALSE,
-                    alt.tcross2 = FALSE,
+                    tcross.alt.crossprod = FALSE,
+                    tcross.alt.star = FALSE,
                     ...) {
   # Validate the 'component' argument and match it against predefined choices
   component <- match.arg(tolower(component),
@@ -173,10 +173,10 @@ ped2com <- function(ped, component,
   if (verbose) {
     cat("Doing tcrossprod\n")
   }
-  if(alt.tcross1){
+  if(tcross.alt.crossprod){
     cat("Doing alt tcrossprod crossprod t \n")
     r <-    crossprod(t(as.matrix(r2)))
-    }else if(alt.tcross2){
+    }else if(tcross.alt.star){
 	  cat("Doing alt tcrossprod %*% t \n")
      r <-       r2 %*% t(as.matrix(r2))
   }else{
@@ -207,7 +207,7 @@ ped2com <- function(ped, component,
 #' @export
 #'
 ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE,
-                    alt.tcross1 = FALSE, alt.tcross2 = FALSE) {
+                    tcross.alt.crossprod = FALSE, tcross.alt.star = FALSE) {
   ped2com(
     ped = ped,
     max.gen = max.gen,
@@ -217,8 +217,8 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA
     component = "additive",
     flatten.diag = flatten.diag,
     standardize.colnames = standardize.colnames,
-    alt.tcross1 = alt.tcross1,
-    alt.tcross2 = alt.tcross2
+    tcross.alt.crossprod = tcross.alt.crossprod,
+    tcross.alt.star = tcross.alt.star
   )
 }
 
@@ -228,7 +228,7 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA
 #' @export
 #' @aliases ped2mt
 #'
-ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, alt.tcross1 = FALSE, alt.tcross2 = FALSE) {
+ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, tcross.alt.crossprod = FALSE, tcross.alt.star = FALSE) {
   ped2com(
     ped = ped,
     max.gen = max.gen,
@@ -238,8 +238,8 @@ ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALS
     component = "mitochondrial",
     flatten.diag = flatten.diag,
     standardize.colnames = standardize.colnames,
-    alt.tcross1 = alt.tcross1,
-    alt.tcross2 = alt.tcross2
+    tcross.alt.crossprod = tcross.alt.crossprod,
+    tcross.alt.star = tcross.alt.star
   )
 }
 
@@ -251,7 +251,7 @@ ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALS
 #' @details The algorithms and methodologies used in this function are further discussed and exemplified in the vignette titled "examplePedigreeFunctions".
 #' @export
 #'
-ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, alt.tcross1 = FALSE, alt.tcross2 = FALSE) {
+ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, tcross.alt.crossprod = FALSE, tcross.alt.star = FALSE) {
   ped2com(
     ped = ped,
     max.gen = max.gen,
@@ -261,8 +261,8 @@ ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FAL
     component = "common nuclear",
     flatten.diag = flatten.diag,
     standardize.colnames = standardize.colnames,
-    alt.tcross1 = alt.tcross1,
-    alt.tcross2 = alt.tcross2
+    tcross.alt.crossprod = tcross.alt.crossprod,
+    tcross.alt.star = tcross.alt.star
   )
 }
 
diff --git a/cran-comments.md b/cran-comments.md
index a26dd32..2b62532 100644
--- a/cran-comments.md
+++ b/cran-comments.md
@@ -1,11 +1,9 @@
 
-Description
------------------------------------------------
+# Description
 
 This is a hotfix for the BGmisc package, as we discovered that the plotPedigree wrapper function broke for pedigrees that contained multiple families.
 
-Test Environments
------------------------------------------------
+# Test Environments
 
 1. Local OS: Windows 10, R version 4.2.3
 2. Local OS: Windows 10, R version 4.3.1
diff --git a/man/ped2add.Rd b/man/ped2add.Rd
index c5499bd..dc84cd9 100644
--- a/man/ped2add.Rd
+++ b/man/ped2add.Rd
@@ -12,8 +12,8 @@ ped2add(
   gc = FALSE,
   flatten.diag = FALSE,
   standardize.colnames = TRUE,
-  alt.tcross1 = FALSE,
-  alt.tcross2 = FALSE
+  tcross.alt.crossprod = FALSE,
+  tcross.alt.star = FALSE
 )
 }
 \arguments{
@@ -33,9 +33,9 @@ generations as there are in the data.}
 
 \item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset}
 
-\item{alt.tcross1}{logical. If TRUE, use an alternative method for computing the transpose}
+\item{tcross.alt.crossprod}{logical. If TRUE, use alternative method of using Crossprod function for computing the transpose}
 
-\item{alt.tcross2}{logical. If TRUE, use an alternative method for computing the transpose}
+\item{tcross.alt.star}{logical. If TRUE, use alternative method of using %*% for computing the transpose}
 }
 \description{
 Take a pedigree and turn it into an additive genetics relatedness matrix
diff --git a/man/ped2cn.Rd b/man/ped2cn.Rd
index 90d5bd4..c4c1b5b 100644
--- a/man/ped2cn.Rd
+++ b/man/ped2cn.Rd
@@ -12,8 +12,8 @@ ped2cn(
   gc = FALSE,
   flatten.diag = FALSE,
   standardize.colnames = TRUE,
-  alt.tcross1 = FALSE,
-  alt.tcross2 = FALSE
+  tcross.alt.crossprod = FALSE,
+  tcross.alt.star = FALSE
 )
 }
 \arguments{
@@ -33,9 +33,9 @@ generations as there are in the data.}
 
 \item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset}
 
-\item{alt.tcross1}{logical. If TRUE, use an alternative method for computing the transpose}
+\item{tcross.alt.crossprod}{logical. If TRUE, use alternative method of using Crossprod function for computing the transpose}
 
-\item{alt.tcross2}{logical. If TRUE, use an alternative method for computing the transpose}
+\item{tcross.alt.star}{logical. If TRUE, use alternative method of using %*% for computing the transpose}
 }
 \description{
 Take a pedigree and turn it into a common nuclear environmental relatedness matrix
diff --git a/man/ped2com.Rd b/man/ped2com.Rd
index 3a00a83..0bb3269 100644
--- a/man/ped2com.Rd
+++ b/man/ped2com.Rd
@@ -13,8 +13,8 @@ ped2com(
   gc = FALSE,
   flatten.diag = FALSE,
   standardize.colnames = TRUE,
-  alt.tcross1 = FALSE,
-  alt.tcross2 = FALSE,
+  tcross.alt.crossprod = FALSE,
+  tcross.alt.star = FALSE,
   ...
 )
 }
@@ -37,9 +37,9 @@ generations as there are in the data.}
 
 \item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset}
 
-\item{alt.tcross1}{logical. If TRUE, use an alternative method for computing the transpose}
+\item{tcross.alt.crossprod}{logical. If TRUE, use alternative method of using Crossprod function for computing the transpose}
 
-\item{alt.tcross2}{logical. If TRUE, use an alternative method for computing the transpose}
+\item{tcross.alt.star}{logical. If TRUE, use alternative method of using %*% for computing the transpose}
 
 \item{...}{additional arguments to be passed to \code{\link{ped2com}}}
 }
diff --git a/man/ped2mit.Rd b/man/ped2mit.Rd
index 3df3075..ac0f677 100644
--- a/man/ped2mit.Rd
+++ b/man/ped2mit.Rd
@@ -13,8 +13,8 @@ ped2mit(
   gc = FALSE,
   flatten.diag = FALSE,
   standardize.colnames = TRUE,
-  alt.tcross1 = FALSE,
-  alt.tcross2 = FALSE
+  tcross.alt.crossprod = FALSE,
+  tcross.alt.star = FALSE
 )
 }
 \arguments{
@@ -34,9 +34,9 @@ generations as there are in the data.}
 
 \item{standardize.colnames}{logical. If TRUE, standardize the column names of the pedigree dataset}
 
-\item{alt.tcross1}{logical. If TRUE, use an alternative method for computing the transpose}
+\item{tcross.alt.crossprod}{logical. If TRUE, use alternative method of using Crossprod function for computing the transpose}
 
-\item{alt.tcross2}{logical. If TRUE, use an alternative method for computing the transpose}
+\item{tcross.alt.star}{logical. If TRUE, use alternative method of using %*% for computing the transpose}
 }
 \description{
 Take a pedigree and turn it into a mitochondrial relatedness matrix
diff --git a/tests/testthat/test-network.R b/tests/testthat/test-network.R
index d711b3c..2343ad2 100755
--- a/tests/testthat/test-network.R
+++ b/tests/testthat/test-network.R
@@ -54,7 +54,7 @@ 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", {
   data(hazard)
-  add <- ped2add(hazard, alt.tcross1 = TRUE)
+  add <- ped2add(hazard, tcross.alt.crossprod = TRUE)
   # Check dimension
   expect_equal(dim(add), c(nrow(hazard), nrow(hazard)))
   # Check several values
@@ -92,7 +92,7 @@ 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", {
   data(inbreeding)
-  add <- ped2add(inbreeding, alt.tcross2 = TRUE)
+  add <- ped2add(inbreeding, tcross.alt.star = TRUE)
   # Check dimension
   expect_equal(dim(add), c(nrow(inbreeding), nrow(inbreeding)))
   # Check several values

From 860ad16471503f31c6bcc25efe63d04ce8ecb21b Mon Sep 17 00:00:00 2001
From: Mason Garrison 
Date: Thu, 21 Mar 2024 13:31:28 -0400
Subject: [PATCH 20/24] fixed %*% in documentaiton

---
 .Rbuildignore                               |  1 +
 R/convertPedigree.R                         |  5 +--
 R/formula.R                                 | 14 ++++++-
 cran-comments.md                            |  1 -
 man/BGmisc-package.Rd                       |  2 +-
 man/ped2add.Rd                              |  2 +-
 man/ped2cn.Rd                               |  2 +-
 man/ped2com.Rd                              |  2 +-
 man/ped2mit.Rd                              |  2 +-
 tests/testthat/test-relatedness-functions.R | 45 ++++++++++++++++-----
 vignettes/network.Rmd                       |  2 +-
 vignettes/network.html                      |  7 +---
 vignettes/pedigree.Rmd                      |  1 -
 13 files changed, 56 insertions(+), 30 deletions(-)

diff --git a/.Rbuildignore b/.Rbuildignore
index 31a9a74..9c25700 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -3,6 +3,7 @@
 ^LICENSE\.md$
 ^R/\.Rhistory$
 ^R/paper$
+^checkParents\.X
 CITATION.cff$
 ^doc$
 ^data-raw$
diff --git a/R/convertPedigree.R b/R/convertPedigree.R
index ca74521..4123c4c 100644
--- a/R/convertPedigree.R
+++ b/R/convertPedigree.R
@@ -10,7 +10,7 @@
 #' @param flatten.diag logical. If TRUE, overwrite the diagonal of the final relatedness matrix with ones
 #' @param standardize.colnames logical. If TRUE, standardize the column names of the pedigree dataset
 #' @param tcross.alt.crossprod logical. If TRUE, use alternative method of using Crossprod function for computing the transpose
-#' @param tcross.alt.star logical. If TRUE, use alternative method of using %*% for computing the transpose
+#' @param tcross.alt.star logical. If TRUE, use alternative method of using \%\*\% for computing the transpose
 #' @param ... additional arguments to be passed to \code{\link{ped2com}}
 #' @details The algorithms and methodologies used in this function are further discussed and exemplified in the vignette titled "examplePedigreeFunctions".
 #' @export
@@ -243,9 +243,6 @@ ped2mit <- ped2mt <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALS
   )
 }
 
-
-
-
 #' Take a pedigree and turn it into a common nuclear environmental relatedness matrix
 #' @inheritParams ped2com
 #' @details The algorithms and methodologies used in this function are further discussed and exemplified in the vignette titled "examplePedigreeFunctions".
diff --git a/R/formula.R b/R/formula.R
index a7c2627..cae0f88 100644
--- a/R/formula.R
+++ b/R/formula.R
@@ -102,12 +102,24 @@ calculateH <- function(r1, r2, obsR1, obsR2) {
   if (any(r1 - r2 == 0)) {
     stop("Relatedness coefficients r1 and r2 must not be equal for any pair.")
   }
+  if (any(abs(obsR1) > 1) || any(abs(obsR2) > 1)) {
+    warning("The observed correlations should be between -1 and 1.")
+  }
+
+  if (any(obsR1 * obsR2 < 0)) {
+    warning("The correlations should not have opposite signs.")
+  }
+
+  if(any(obsR1 < 0 & obsR2 < 0)){
+    message("Your scale might be reverse coded because you have negative correlations. Please check your data. ")
+  }
+
 
   # Calculate heritability estimates (H^2) for all pairs
   heritability_estimates <- (obsR1 - obsR2) / (r1 - r2)
   # Check for unrealistic heritability estimates and warn the user
   if (any(heritability_estimates < 0)) {
-    warning("Some calculated heritability values are negative, which may indicate non-genetic influences or measurement errors.")
+    warning("Some calculated heritability values are negative, which may indicate assumption violations or questions about directionality.")
   }
 
   if (any(heritability_estimates > 1)) {
diff --git a/cran-comments.md b/cran-comments.md
index 961b675..0314d3b 100644
--- a/cran-comments.md
+++ b/cran-comments.md
@@ -3,7 +3,6 @@
 
 This update reflects a substantial improvement in the codebase as part of the peer review process for JOSS, including the addition of numerous function checks, increased code coverage to 85%, and the replacement of sapply usage. We also added a new function to simulate twins and the ability to trace paternal and maternal lines. We also added a Harry Potter pedigree.
 
-
 # Test Environments
 
 1. Local OS: Windows 11 x64 (build 22635), R version 4.3.2 (2023-10-31 ucrt)
diff --git a/man/BGmisc-package.Rd b/man/BGmisc-package.Rd
index 963688f..506ce2a 100644
--- a/man/BGmisc-package.Rd
+++ b/man/BGmisc-package.Rd
@@ -25,7 +25,7 @@ Authors:
   \item Michael D. Hunter (\href{https://orcid.org/0000-0002-3651-6709}{ORCID})
   \item Xuanyu Lyu (\href{https://orcid.org/0000-0002-2841-5529}{ORCID})
   \item Rachel N. Good (\href{https://orcid.org/0000-0000-0000-0000}{ORCID})
-  \item Jonathan D. Trattner (\href{https://orcid.org/0000-0002-1097-7603}{ORCID})
+  \item Jonathan D. Trattner \email{code@jdtrat.com} (\href{https://orcid.org/0000-0002-1097-7603}{ORCID}) (https://www.jdtrat.com/)
   \item S. Alexandra Burt (\href{https://orcid.org/0000-0001-5538-7431}{ORCID})
 }
 
diff --git a/man/ped2add.Rd b/man/ped2add.Rd
index dc84cd9..ad87012 100644
--- a/man/ped2add.Rd
+++ b/man/ped2add.Rd
@@ -35,7 +35,7 @@ generations as there are in the data.}
 
 \item{tcross.alt.crossprod}{logical. If TRUE, use alternative method of using Crossprod function for computing the transpose}
 
-\item{tcross.alt.star}{logical. If TRUE, use alternative method of using %*% for computing the transpose}
+\item{tcross.alt.star}{logical. If TRUE, use alternative method of using \%\*\% for computing the transpose}
 }
 \description{
 Take a pedigree and turn it into an additive genetics relatedness matrix
diff --git a/man/ped2cn.Rd b/man/ped2cn.Rd
index c4c1b5b..0d7e3eb 100644
--- a/man/ped2cn.Rd
+++ b/man/ped2cn.Rd
@@ -35,7 +35,7 @@ generations as there are in the data.}
 
 \item{tcross.alt.crossprod}{logical. If TRUE, use alternative method of using Crossprod function for computing the transpose}
 
-\item{tcross.alt.star}{logical. If TRUE, use alternative method of using %*% for computing the transpose}
+\item{tcross.alt.star}{logical. If TRUE, use alternative method of using \%\*\% for computing the transpose}
 }
 \description{
 Take a pedigree and turn it into a common nuclear environmental relatedness matrix
diff --git a/man/ped2com.Rd b/man/ped2com.Rd
index 0bb3269..67daf5f 100644
--- a/man/ped2com.Rd
+++ b/man/ped2com.Rd
@@ -39,7 +39,7 @@ generations as there are in the data.}
 
 \item{tcross.alt.crossprod}{logical. If TRUE, use alternative method of using Crossprod function for computing the transpose}
 
-\item{tcross.alt.star}{logical. If TRUE, use alternative method of using %*% for computing the transpose}
+\item{tcross.alt.star}{logical. If TRUE, use alternative method of using \%\*\% for computing the transpose}
 
 \item{...}{additional arguments to be passed to \code{\link{ped2com}}}
 }
diff --git a/man/ped2mit.Rd b/man/ped2mit.Rd
index ac0f677..530ca4e 100644
--- a/man/ped2mit.Rd
+++ b/man/ped2mit.Rd
@@ -36,7 +36,7 @@ generations as there are in the data.}
 
 \item{tcross.alt.crossprod}{logical. If TRUE, use alternative method of using Crossprod function for computing the transpose}
 
-\item{tcross.alt.star}{logical. If TRUE, use alternative method of using %*% for computing the transpose}
+\item{tcross.alt.star}{logical. If TRUE, use alternative method of using \%\*\% for computing the transpose}
 }
 \description{
 Take a pedigree and turn it into a mitochondrial relatedness matrix
diff --git a/tests/testthat/test-relatedness-functions.R b/tests/testthat/test-relatedness-functions.R
index c3eedc0..8159a9b 100644
--- a/tests/testthat/test-relatedness-functions.R
+++ b/tests/testthat/test-relatedness-functions.R
@@ -41,23 +41,46 @@ test_that("calculateH returns correct heritability estimates", {
   expect_equal(calculateH(0.5, 0.125, 0.5, 0.25), 2/3, tolerance = 1e-8)
 })
 
-# Test 2: Vectorized Input Test
+# Test 2: unusual warning
+test_that("provides warning for unusual H value", {
+  r1 <- 0.25
+  r2 <- 0.125
+  obsR1 <- 0.3
+  obsR2 <- 0.1
+  expected <-  1.6
+  expect_warning(expect_equal(calculateH(r1, r2, obsR1, obsR2), expected))
+})
+
+
+# Test 3: Vectorized Input Test
 test_that("calculateH handles vectorized inputs correctly", {
-  r1 <- c(0.5, 0.25)
+  r1 <- c(0.5, 0.5)
   r2 <- c(0.25, 0.125)
-  obsR1 <- c(0.4, 0.3)
-  obsR2 <- c(0.2, 0.1)
-  expected <- c(0.8, 1.6)
-  expect_equal(calculateH(r1, r2, obsR1, obsR2), expected)
+  obsR1 <- c(0.4, 0.5)
+  obsR2 <- c(0.2, 0.25)
+  expected <- c(0.8, 2/3)
+  expect_equal(calculateH(r1, r2, obsR1, obsR2), expected, tolerance = 1e-8)
 })
 
-# Test 3: Equal Relatedness Coefficients Test
+
+# Test 4: Equal Relatedness Coefficients Test
 test_that("calculateH stops for equal relatedness coefficients", {
-  expect_error(calculateH(0.5, 0.5, 0.4, 0.2), "Relatedness coefficients r1 and r2 must not be equal for any pair.")
+  expect_error(calculateH(0.5, 0.5, 0.4, 0.2),
+               "Relatedness coefficients r1 and r2 must not be equal for any pair.")
 })
 
-# Test 4: Negative and Positive Correlation Test
+# Test 5: Negative and Positive Correlation Test
 test_that("calculateH handles both negative and positive correlations", {
-  expect_equal(calculateH(0.5, 0.25, -0.4, -0.2), -0.8)
-  expect_equal(calculateH(0.5, 0.25, 0.2, -0.1), 1.2)
+  # Test for negative correlations with expected warnings about negative heritability values
+  expect_warning(
+    expect_equal(calculateH(0.5, 0.25, -0.4, -0.2), -0.8),
+    regexp = "Some calculated heritability values are negative"
+  )
+  # Test for a scenario leading to a positive heritability estimate
+
+  expect_warning(
+    expect_warning(
+      expect_equal(calculateH(0.5, 0.25, 0.2, -0.1), 1.2),
+                 regexp = "The correlations should not have opposite signs."),
+    regexp = "Some calculated heritability values are greater than 1")
 })
diff --git a/vignettes/network.Rmd b/vignettes/network.Rmd
index 3b5d0c0..375b727 100644
--- a/vignettes/network.Rmd
+++ b/vignettes/network.Rmd
@@ -181,6 +181,6 @@ However, this subset does not plot the relationship between spouses (such as the
 subset_rows <- c(1:5, 31:36)
 subset_potter <- potter[subset_rows, ]
 ```
-```{r, echo=FALSE, results='hide', out.width='50%', fig.cap="Potter Subset Pedigree"}
+```{r, echo=FALSE, results='hide', out.width='50%'}
 plotPedigree(subset_potter, code_male = 1, verbose = TRUE)
 ```
diff --git a/vignettes/network.html b/vignettes/network.html
index 5c7ed08..07fd015 100644
--- a/vignettes/network.html
+++ b/vignettes/network.html
@@ -529,12 +529,7 @@ 
Subsetting Pedigrees

 are not children to connect the two individuals together yet.

 
subset_rows <- c(1:5, 31:36)
 subset_potter <- potter[subset_rows, ]

-

-Potter Subset Pedigree
-

-Potter Subset Pedigree
-

-

+
diff --git a/vignettes/pedigree.Rmd b/vignettes/pedigree.Rmd index aa029e1..3548c17 100644 --- a/vignettes/pedigree.Rmd +++ b/vignettes/pedigree.Rmd @@ -49,7 +49,6 @@ The columns represents the individual's family ID, the individual's personal ID, ## Plotting Pedigree - Pedigrees are visual diagrams that represent family relationships across generations. They are commonly used in genetics to trace the inheritance of specific traits or conditions. This vignette will guide you through visualizing simulated pedigrees using the `plotPedigree` function. This function is a wrapper function for `Kinship2`'s base R plotting. ### Single Pedigree Visualization From f537cd72ed6ccd55eaa4a6313b8a4f6ae9a5a92f Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Fri, 22 Mar 2024 12:43:33 -0400 Subject: [PATCH 21/24] Update README.Rmd added corecov --- README.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.Rmd b/README.Rmd index 4bb16db..a39981a 100644 --- a/README.Rmd +++ b/README.Rmd @@ -21,10 +21,10 @@ options(citation.bibtex.max=0) [![R package version](https://www.r-pkg.org/badges/version/BGmisc)](https://cran.r-project.org/package=BGmisc) [![Package downloads](https://cranlogs.r-pkg.org/badges/grand-total/BGmisc)](https://cran.r-project.org/package=BGmisc)
[![status](https://joss.theoj.org/papers/ee3a025be4f61584f977a7657d936187/status.svg)](https://joss.theoj.org/papers/10.21105/joss.06203) - [![R-CMD-check](https://github.com/R-Computing-Lab/BGmisc/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/R-Computing-Lab/BGmisc/actions/workflows/R-CMD-check.yaml) [![Dev Main branch](https://github.com/R-Computing-Lab/BGmisc/actions/workflows/R-CMD-dev_maincheck.yaml/badge.svg)](https://github.com/R-Computing-Lab/BGmisc/actions/workflows/R-CMD-dev_maincheck.yaml) +[![codecov](https://codecov.io/gh/R-Computing-Lab/BGmisc/graph/badge.svg?token=2IARK2XSA6)](https://codecov.io/gh/R-Computing-Lab/BGmisc) ![License](https://img.shields.io/badge/License-GPL_v3-blue.svg) From 9398efabe0f32e9bb91eed6cb9993cfa7bfd289e Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Tue, 26 Mar 2024 10:16:05 -0400 Subject: [PATCH 22/24] Update NEWS.md --- .Rbuildignore | 1 + DESCRIPTION | 5 ++--- NEWS.md | 5 +++++ man/BGmisc-package.Rd | 6 +++++- 4 files changed, 13 insertions(+), 4 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 9c25700..73b20e6 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -4,6 +4,7 @@ ^R/\.Rhistory$ ^R/paper$ ^checkParents\.X +^test-clean\.X CITATION.cff$ ^doc$ ^data-raw$ diff --git a/DESCRIPTION b/DESCRIPTION index 546f199..fb92558 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: BGmisc Title: An R Package for Extended Behavior Genetics Analysis -Version: 1.2.0 +Version: 1.2.1 Authors@R: c( person("S. Mason", "Garrison", , email= "garrissm@wfu.edu", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-4804-6003")), @@ -8,8 +8,7 @@ Authors@R: c( comment = c(ORCID = "0000-0002-3651-6709")), person("Xuanyu", "Lyu", role = "aut", comment = c(ORCID = "0000-0002-2841-5529")), - person(c("Rachel", "N."), "Good", role = "ctb", - comment = c(ORCID = "0000-0000-0000-0000")), + person(c("Rachel", "N."), "Good", role = "ctb"), person(c("Jonathan", "D."), "Trattner", role = "aut", email = "code@jdtrat.com", comment = c(ORCID = "0000-0002-1097-7603", url = "https://www.jdtrat.com/")), diff --git a/NEWS.md b/NEWS.md index 87892be..20f848d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# BGmisc 1.2.1 + +* Added alternative transpose options for the matrix +* Added generalization of Falconer's formula + # BGmisc 1.2.0 * Added numerous code checks, increased code coverage to 85% diff --git a/man/BGmisc-package.Rd b/man/BGmisc-package.Rd index 506ce2a..55e1b84 100644 --- a/man/BGmisc-package.Rd +++ b/man/BGmisc-package.Rd @@ -24,10 +24,14 @@ Authors: \itemize{ \item Michael D. Hunter (\href{https://orcid.org/0000-0002-3651-6709}{ORCID}) \item Xuanyu Lyu (\href{https://orcid.org/0000-0002-2841-5529}{ORCID}) - \item Rachel N. Good (\href{https://orcid.org/0000-0000-0000-0000}{ORCID}) \item Jonathan D. Trattner \email{code@jdtrat.com} (\href{https://orcid.org/0000-0002-1097-7603}{ORCID}) (https://www.jdtrat.com/) \item S. Alexandra Burt (\href{https://orcid.org/0000-0001-5538-7431}{ORCID}) } +Other contributors: +\itemize{ + \item Rachel N. Good [contributor] +} + } \keyword{internal} From 9f24206b68bd507cd1d45ecb492c2b2710afaeb8 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Tue, 26 Mar 2024 10:30:33 -0400 Subject: [PATCH 23/24] Update test-relatedness-functions.R --- tests/testthat/test-relatedness-functions.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/testthat/test-relatedness-functions.R b/tests/testthat/test-relatedness-functions.R index 8159a9b..387c5bc 100644 --- a/tests/testthat/test-relatedness-functions.R +++ b/tests/testthat/test-relatedness-functions.R @@ -84,3 +84,9 @@ test_that("calculateH handles both negative and positive correlations", { regexp = "The correlations should not have opposite signs."), regexp = "Some calculated heritability values are greater than 1") }) + +# Test 6: illegal correlation values +test_that("calculateH stops for illegal coefficients", { + expect_warning(calculateH(0.5, 0.25, 1.4, 1.4), + "The observed correlations should be between -1 and 1") +}) From ea8c0777e571cc8a3f3a7c1e5abb694d85c4bf60 Mon Sep 17 00:00:00 2001 From: Mason Garrison Date: Tue, 26 Mar 2024 12:45:54 -0400 Subject: [PATCH 24/24] Update R-CMD-dev_maincheck.yaml update to v3 --- .github/workflows/R-CMD-dev_maincheck.yaml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/R-CMD-dev_maincheck.yaml b/.github/workflows/R-CMD-dev_maincheck.yaml index 1db28e4..fe93bc4 100644 --- a/.github/workflows/R-CMD-dev_maincheck.yaml +++ b/.github/workflows/R-CMD-dev_maincheck.yaml @@ -33,22 +33,22 @@ jobs: steps: - uses: actions/checkout@v3 - - uses: r-lib/actions/setup-pandoc@v2 + - uses: r-lib/actions/setup-pandoc@v3 - - uses: r-lib/actions/setup-r@v2 + - uses: r-lib/actions/setup-r@v3 with: r-version: ${{ matrix.config.r }} rtools-version: ${{ matrix.config.rtools }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v2 + - uses: r-lib/actions/setup-r-dependencies@v3 with: cache-version: 3 extra-packages: | any::rcmdcheck upgrade: 'TRUE' needs: check - - uses: r-lib/actions/check-r-package@v2 + - uses: r-lib/actions/check-r-package@v3 with: upload-snapshots: true