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

1.3.1 BGA

Author: smasongarrison

.gitignore

@@ -1,6 +1,6 @@
 .Rproj.user
 .DS_Store
-R/plane.txt
+data-raw/ASOIAF.ged
 R/.Rhistory
 .Rhistory
 paper/paper.html
@@ -9,4 +9,5 @@ paper/paper.html
 vignettes/articles/paper.html
 BGmisc.code-workspace
 tests/testthat/Rplots.pdf
-
+*.ASOIAF.ged
+ASOIAF.ged

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: BGmisc
 Title: An R Package for Extended Behavior Genetics Analysis
-Version: 1.3.0.1
+Version: 1.3.1
 Authors@R: c(
     person("S. Mason", "Garrison", , email= "garrissm@wfu.edu", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-4804-6003")),
@@ -30,7 +30,8 @@ Imports:
     kinship2,
     Matrix,
     stats,
-    data.table
+    data.table,
+    stringr
 Suggests: 
     dplyr,
     EasyMx,

NAMESPACE

@@ -7,7 +7,6 @@ export(checkIDs)
 export(checkSex)
 export(comp2vech)
 export(createGenDataFrame)
-export(determineSex)
 export(dropLink)
 export(evenInsert)
 export(famSizeCal)
@@ -26,6 +25,7 @@ export(ped2maternal)
 export(ped2mit)
 export(ped2paternal)
 export(plotPedigree)
+export(readGedcom)
 export(recodeSex)
 export(related_coef)
 export(relatedness)

NEWS.md

@@ -1,14 +1,20 @@
+# BGmisc 1.3.1
+* Confirmed that all orcids are correct
+* Added gedcom importer
+
 # BGmisc 1.3.0.1
 * Created subfunctions to reduce function complexity
 
 # BGmisc 1.3.0
+* Harmonized function names
 * Fixed incorrectly spelled last name in potter pedigree
 * Added function to summarize variables by family, matrilinael, and patrilineal lines
 * Added within row duplicate ID checks
 * Added data validation vignettes
 * Harmonized function names and arguments
 
 # BGmisc 1.2.1
+
 * Added alternative transpose options for the matrix
 * Added generalization of Falconer's formula
 

R/checkSex.R

@@ -134,8 +134,7 @@ repairSex <- function(ped, verbose = FALSE, code_male = NULL) {
 
 #' Recodes Sex Variable in a Pedigree Dataframe
 #'
-#' This function serves as a wrapper around `checkSex` to specifically handle
-#' the repair of the sex coding in a pedigree dataframe.
+#' This function serves as is primarily used internally, by plotting functions etc.
 #' It sets the `repair` flag to TRUE automatically and forwards any additional parameters to `checkSex`.
 #'
 #' @inheritParams checkSex
@@ -148,6 +147,7 @@ repairSex <- function(ped, verbose = FALSE, code_male = NULL) {
 #' @return 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.
 #' @export
 #' @seealso \code{\link{plotPedigree}}
+#' @export
 recodeSex <- function(
     ped, verbose = FALSE, code_male = NULL, code_na = NULL, code_female = NULL,
     recode_male = "M", recode_female = "F", recode_na = NA_character_) {

R/cleanPedigree.R

@@ -13,15 +13,15 @@
 standardizeColnames <- function(df, verbose = FALSE) {
   # Internal mapping of standardized names to possible variants
   mapping <- list(
-    "fam" = "^(?:fam(?:ily)?(?:id)?)",
-    "ID" = "^(?:i(?:d$|ndiv(?:idual)?)|p(?:erson)?id)",
+    "fam" = "^(?:fam(?:ily)?[\\.\\-_]?(?:id)?)",
+    "ID" = "^(?:i(?:d$|ndiv(?:idual)?)|p(?:erson)?[\\.\\-_]?id)",
     "gen" = "^(?:gen(?:s|eration)?)",
-    "dadID" = "^(?:d(?:ad)?id|paid|fatherid|pid_fath[er]*)",
-    "patID" = "^(?:datid|patid|paternal(?:id)?)",
-    "momID" = "^(?:m(?:om|a|other)?id|pid_moth[er]*)",
-    "matID" = "^(?:matid|maternal(?:id)?)",
-    "spt" = "^(?:s(?:pt)?id|spouse(?:id)?|partner(?:id)?|husb(?:and)?id|wife(?:id)?)|pid_spouse1?)",
-    "twinID" = "^(?:twin(?:id)?)",
+    "dadID" = "^(?:d(?:ad)?id|paid|fatherid|pid[\\.\\-_]?fath[er]*)",
+    "patID" = "^(?:dat[\\.\\-_]?id|pat[\\.\\-_]?id|paternal[\\.\\-_]?(?:id)?)",
+    "momID" = "^(?:m(?:om|a|other)?[\\.\\-_]?id|pid[\\.\\-_]?moth[er]*)",
+    "matID" = "^(?:mat[\\.\\-_]?id|maternal[\\.\\-_]?(?:id)?)",
+    "spID" = "^(?:s(?:pt)?id|spouse[\\.\\-_]?(?:id)?|partner[\\.\\-_]?(?:id)?|husb(?:and)?[\\.\\-_]?id|wife[\\.\\-_]?(?:id)?|pid[\\.\\-_]?spouse1?)",
+    "twinID" = "^(?:twin[\\.\\-_]?(?:id)?)",
     "sex" = "^(?:sex|gender|female|m(?:a(?:le|n)|en)|wom[ae]n)"
   )
   if (verbose) {

R/helpPedigree.R

@@ -11,7 +11,7 @@
 #' @return A data frame representing the initial structure for the individuals in the specified generation
 #'         before any relationships (parental, spousal) are defined. The columns include family ID (`fam`),
 #'         individual ID (`id`), generation number (`gen`), father's ID (`pat`), mother's ID (`mat`),
-#'         spouse's ID (`spt`), and sex (`sex`), with NA values for paternal, maternal, and spouse IDs, and sex.
+#'         spouse's ID (`spID`), and sex (`sex`), with NA values for paternal, maternal, and spouse IDs, and sex.
 #' @examples
 #' sizeGens <- c(3, 5, 4) # Example sizes for 3 generations
 #' genIndex <- 2 # Creating data frame for the 2nd generation
@@ -26,7 +26,7 @@ createGenDataFrame <- function(sizeGens, genIndex, idGen) {
     gen = rep(genIndex, sizeGens[genIndex]),
     pat = rep(NA, sizeGens[genIndex]), # father id
     mat = rep(NA, sizeGens[genIndex]), # mother id
-    spt = rep(NA, sizeGens[genIndex]), # spouse id
+    spID = rep(NA, sizeGens[genIndex]), # spouse id
     sex = rep(NA, sizeGens[genIndex])
   )
   return(df_Ngen)
@@ -35,13 +35,12 @@ createGenDataFrame <- function(sizeGens, genIndex, idGen) {
 
 #' Determine Sex of Offspring
 #'
-#' This function assigns sexes to the offspring in a generation based on the specified sex ratio.
+#' This internal function assigns sexes to the offspring in a generation based on the specified sex ratio.
 #'
 #' @param idGen Vector of IDs for the generation.
 #' @param sexR Numeric value indicating the sex ratio (proportion of males).
 #' @return Vector of sexes ("M" for male, "F" for female) for the offspring.
 #' @importFrom stats runif
-#' @export
 determineSex <- function(idGen, sexR) {
   if (runif(1) > .5) {
     sexVec1 <- rep("M", floor(length(idGen) * sexR))
@@ -66,16 +65,16 @@ assignCoupleIds <- function(df_Ngen) {
   usedCoupleIds <- character() # Initialize an empty character vector to track used IDs
 
   for (j in seq_len(nrow(df_Ngen))) {
-    if (!is.na(df_Ngen$spt[j]) && is.na(df_Ngen$coupleId[j])) {
+    if (!is.na(df_Ngen$spID[j]) && is.na(df_Ngen$coupleId[j])) {
       # Construct a potential couple ID from sorted individual and spouse IDs
-      sortedIds <- sort(c(df_Ngen$id[j], df_Ngen$spt[j]))
+      sortedIds <- sort(c(df_Ngen$id[j], df_Ngen$spID[j]))
       potentialCoupleId <- paste(sortedIds[1], sortedIds[2], sep = "_")
 
       # Check if the potentialCoupleId has not already been used
       if (!potentialCoupleId %in% usedCoupleIds) {
         # Assign the new couple ID to both partners
         df_Ngen$coupleId[j] <- potentialCoupleId
-        spouseIndex <- which(df_Ngen$id == df_Ngen$spt[j])
+        spouseIndex <- which(df_Ngen$id == df_Ngen$spID[j])
         df_Ngen$coupleId[spouseIndex] <- potentialCoupleId
 
         # Add the new couple ID to the list of used IDs
@@ -137,7 +136,7 @@ adjustKidsPerCouple <- function(nMates, kpc, rd_kpc) {
 #' the assignment of roles and relationships within and between generations in a pedigree simulation.
 #'
 #' @param df_Ngen A data frame for the current generation being processed.
-#'        It must include columns for individual IDs (`id`), spouse IDs (`spt`), sex (`sex`),
+#'        It must include columns for individual IDs (`id`), spouse IDs (`spID`), sex (`sex`),
 #'        and any previously assigned roles (`ifparent`, `ifson`, `ifdau`).
 #' @param i Integer, the index of the current generation being processed.
 #' @param Ngen Integer, the total number of generations in the simulation.
@@ -163,7 +162,7 @@ markPotentialChildren <- function(df_Ngen, i, Ngen, sizeGens, CoupleF) {
   # single person should all be sons or daus
   # change the ifson and ifdau based on coupleGirl and coupleBoy
   for (j in 1:sizeGens[i]) {
-    if (is.na(df_Ngen$spt[j])) {
+    if (is.na(df_Ngen$spID[j])) {
       if (df_Ngen$sex[j] == "F") {
         df_Ngen$ifdau[j] <- TRUE
         # usedIds <- c(usedIds, df_Ngen$id[j])