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

implementing 1.3.1.1

Author: smasongarrison

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: BGmisc
 Title: An R Package for Extended Behavior Genetics Analysis
-Version: 1.3.2
+Version: 1.3.2.1
 Authors@R: c(
     person("S. Mason", "Garrison", , "garrissm@wfu.edu", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-4804-6003")),
@@ -45,4 +45,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US
 LazyData: true
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

NEWS.md

@@ -1,3 +1,6 @@
+# BGmisc 1.3.2.1
+* Added ability to pass additional arguments to the ped2FOO functions
+
 # BGmisc 1.3.2
 * Added some more tests of identifyModel.R
 * Modified tests to be MKL friendly

R/buildPedigree.R

@@ -9,6 +9,7 @@
 #' @param momID character.  Name of the column in ped for the mother ID variable
 #' @param dadID character.  Name of the column in ped for the father ID variable
 #' @param famID character.  Name of the column to be created in ped for the family ID variable
+#' @param ... additional arguments to be passed to \code{\link{ped2com}}
 #' @details
 #' The general idea of this function is to use person ID, mother ID, and father ID to
 #' create an extended family ID such that everyone with the same family ID is in the
@@ -25,14 +26,17 @@
 #'
 #' @export
 #'
-ped2fam <- function(ped, personID = "ID", momID = "momID", dadID = "dadID", famID = "famID") {
+ped2fam <- function(ped, personID = "ID",
+                    momID = "momID", dadID = "dadID", famID = "famID",
+                    ...) {
   # Call to wrapper function
   .ped2id(ped = ped, personID = personID, momID = momID, dadID = dadID, famID = famID, type = "parents")
 }
 
 .ped2id <- function(ped,
                     personID = "ID", momID = "momID", dadID = "dadID",
-                    famID = "famID", type) {
+                    famID = "famID", type,
+                    ...) {
   # Turn pedigree into family
   pg <- ped2graph(ped = ped, personID = personID, momID = momID, dadID = dadID, adjacent = type)
 
@@ -79,7 +83,8 @@ ped2graph <- function(ped,
                       momID = "momID",
                       dadID = "dadID",
                       directed = TRUE,
-                      adjacent = c("parents", "mothers", "fathers")) {
+                      adjacent = c("parents", "mothers", "fathers"),
+                      ...) {
   # Check ped/data.fram
   if (!inherits(ped, "data.frame")) stop("ped should be a data.frame or inherit to a data.frame")
   # Handle adjacent argument
@@ -171,7 +176,8 @@ ped2graph <- function(ped,
 #' for creating paternal line IDs
 #' @export
 #'
-ped2maternal <- function(ped, personID = "ID", momID = "momID", dadID = "dadID", matID = "matID") {
+ped2maternal <- function(ped, personID = "ID",
+                         momID = "momID", dadID = "dadID", matID = "matID", ...) {
   # Call to wrapper function
   .ped2id(ped = ped, personID = personID, momID = momID, dadID = dadID, famID = matID, type = "mothers")
 }
@@ -189,7 +195,9 @@ ped2maternal <- function(ped, personID = "ID", momID = "momID", dadID = "dadID",
 #' for creating maternal line IDs
 #' @export
 #'
-ped2paternal <- function(ped, personID = "ID", momID = "momID", dadID = "dadID", patID = "patID") {
+ped2paternal <- function(ped, personID = "ID",
+                         momID = "momID", dadID = "dadID",
+                         patID = "patID", ...) {
   # Call to wrapper function
   .ped2id(ped = ped, personID = personID, momID = momID, dadID = dadID, famID = patID, type = "fathers")
 }

R/checkIDs.R

@@ -76,26 +76,26 @@ checkIDs <- function(ped, verbose = FALSE, repair = FALSE) {
       ))
     }
     validation_results$within_row_duplicates <- TRUE
- if(validation_results$total_own_father > 0){
-     validation_results$is_own_father_ids <- unique(is_own_father)
+    if (validation_results$total_own_father > 0) {
+      validation_results$is_own_father_ids <- unique(is_own_father)
       if (verbose) {
         cat(paste0(
           validation_results$total_own_father,
           " individuals are their own fathers.\n"
         ))
       }
     }
-if(validation_results$total_own_mother > 0){
-     validation_results$is_own_mother_ids <- unique(is_own_mother)
+    if (validation_results$total_own_mother > 0) {
+      validation_results$is_own_mother_ids <- unique(is_own_mother)
       if (verbose) {
         cat(paste0(
           validation_results$total_own_mother,
           " individuals are their own mothers.\n"
         ))
       }
     }
-if(validation_results$total_duplicated_parents > 0){
-     validation_results$duplicated_parents_ids <- unique(duplicated_parents)
+    if (validation_results$total_duplicated_parents > 0) {
+      validation_results$duplicated_parents_ids <- unique(duplicated_parents)
       if (verbose) {
         cat(paste0(
           validation_results$total_duplicated_parents,

R/computeRelatedness.R

@@ -59,7 +59,7 @@ calculateRelatedness <- function(
     denom_emp <- denom_m * total_m * weight_m + total_a * weight_a
     if (denom_emp == 0) stop("Denominator in empirical adjustment is zero.")
 
-    coef <- (coef * total_a * weight_a + maternal * total_m * weight_m)/denom_emp
+    coef <- (coef * total_a * weight_a + maternal * total_m * weight_m) / denom_emp
   }
   return(coef)
 }

R/convertPedigree.R

@@ -204,8 +204,11 @@ ped2com <- function(ped, component,
 #' @inherit ped2com details
 #' @export
 #'
-ped2add <- function(ped, max.gen = 25, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE,
-                    tcross.alt.crossprod = FALSE, tcross.alt.star = FALSE) {
+ped2add <- function(ped, max.gen = 25, 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,
@@ -226,7 +229,13 @@ ped2add <- function(ped, max.gen = 25, sparse = FALSE, verbose = FALSE, gc = FAL
 #' @export
 #' @aliases ped2mt
 #'
-ped2mit <- ped2mt <- function(ped, max.gen = 25, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, tcross.alt.crossprod = FALSE, tcross.alt.star = FALSE) {
+ped2mit <- ped2mt <- function(ped, max.gen = 25,
+                              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,
@@ -246,7 +255,11 @@ ped2mit <- ped2mt <- function(ped, max.gen = 25, sparse = FALSE, verbose = FALSE
 #' @inherit ped2com details
 #' @export
 #'
-ped2cn <- function(ped, max.gen = 25, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE, standardize.colnames = TRUE, tcross.alt.crossprod = FALSE, tcross.alt.star = FALSE) {
+ped2cn <- function(ped, max.gen = 25, 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,
@@ -266,6 +279,7 @@ ped2cn <- function(ped, max.gen = 25, sparse = FALSE, verbose = FALSE, gc = FALS
 #' @inherit ped2com details
 #' @export
 #'
-ped2ce <- function(ped) {
+ped2ce <- function(ped,
+                   ...) {
   matrix(1, nrow = nrow(ped), ncol = nrow(ped), dimnames = list(ped$ID, ped$ID))
 }