styling, params

R/convertPedigree.R

@@ -138,7 +138,7 @@ ped2com <- function(ped, component,
     if (component == "mitochondrial") {
       r[r != 0] <- 1 # for mitochondrial component, set all nonzero values to 1
     }
-    if (flatten.diag) { #flattens diagonal if you don't want to deal with inbreeding
+    if (flatten.diag) { # flattens diagonal if you don't want to deal with inbreeding
       diag(r) <- 1
     }
     return(r)
@@ -151,13 +151,15 @@ ped2com <- function(ped, component,
 #' @export
 #'
 ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE) {
-  ped2com(ped = ped,
-          max.gen = max.gen,
-          sparse = sparse,
-          verbose = verbose,
-          gc = gc,
-          component = "additive",
-          flatten.diag = flatten.diag )
+  ped2com(
+    ped = ped,
+    max.gen = max.gen,
+    sparse = sparse,
+    verbose = verbose,
+    gc = gc,
+    component = "additive",
+    flatten.diag = flatten.diag
+  )
 }
 
 #' Take a pedigree and turn it into a mitochondrial relatedness matrix
@@ -166,13 +168,15 @@ ped2add <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA
 #' @export
 #'
 ped2mit <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE) {
-  ped2com(ped = ped,
-          max.gen = max.gen,
-          sparse = sparse,
-          verbose = verbose,
-          gc = gc,
-          component = "mitochondrial",
-          flatten.diag = flatten.diag )
+  ped2com(
+    ped = ped,
+    max.gen = max.gen,
+    sparse = sparse,
+    verbose = verbose,
+    gc = gc,
+    component = "mitochondrial",
+    flatten.diag = flatten.diag
+  )
 }
 
 #' Take a pedigree and turn it into a common nuclear environmental relatedness matrix
@@ -181,13 +185,15 @@ ped2mit <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FA
 #' @export
 #'
 ped2cn <- function(ped, max.gen = Inf, sparse = FALSE, verbose = FALSE, gc = FALSE, flatten.diag = FALSE) {
-  ped2com(ped = ped,
-          max.gen = max.gen,
-          sparse = sparse,
-          verbose = verbose,
-          gc = gc,
-          component = "common nuclear",
-          flatten.diag = flatten.diag )
+  ped2com(
+    ped = ped,
+    max.gen = max.gen,
+    sparse = sparse,
+    verbose = verbose,
+    gc = gc,
+    component = "common nuclear",
+    flatten.diag = flatten.diag
+  )
 }
 
 #' Take a pedigree and turn it into an extended environmental relatedness matrix

R/family.R

@@ -20,9 +20,9 @@
 #'
 #' @export
 #'
-ped2fam <- function(ped, personID='ID', momID='momID', dadID='dadID', famID='famID'){
-    # Turn pedigree into graph
-    pg <- ped2graph(ped=ped, personID=personID, momID=momID, dadID=dadID, famID=famID)
+ped2fam <- function(ped, personID = "ID", momID = "momID", dadID = "dadID", famID = "famID") {
+  # Turn pedigree into family
+  pg <- ped2graph(ped = ped, personID = personID, momID = momID, dadID = dadID, famID = famID)
 
   # Find weakly connected components of graph
   wcc <- igraph::components(pg)
@@ -41,10 +41,8 @@ ped2fam <- function(ped, personID='ID', momID='momID', dadID='dadID', famID='fam
 
 #' Turn a pedigree into a graph
 #' @param ped a pedigree dataset.  Needs ID, momID, and dadID columns
-#' @param personID character.  Name of the column in ped for the person ID variable
-#' @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
+#' @inheritParams ped2fam
+#' @param directed Logical scalar. Default is TRUE. Indicates whether or not to create a directed graph.
 #' @details
 #' The general idea of this function is to represent a pedigree as a graph using the igraph package.
 #'
@@ -55,23 +53,30 @@ ped2fam <- function(ped, personID='ID', momID='momID', dadID='dadID', famID='fam
 #'
 #' @export
 #'
-ped2graph <- function(ped, personID='ID', momID='momID', dadID='dadID', famID='famID'){
-    if(!inherits(ped, 'data.frame')) stop("ped should be a data.frame or inherit to a data.frame")
-    if(!all(c() %in% names(ped))) stop("'personID', 'momID', and 'dadID' were not all found in your pedigree.\nMake sure you have the variable names correct.")
+ped2graph <- function(ped,
+                      personID = "ID",
+                      momID = "momID",
+                      dadID = "dadID",
+                      famID = "famID",
+                      directed = TRUE) {
+  if (!inherits(ped, "data.frame")) stop("ped should be a data.frame or inherit to a data.frame")
+  if (!all(c() %in% names(ped))) stop("'personID', 'momID', and 'dadID' were not all found in your pedigree.\nMake sure you have the variable names correct.")
 
-    nodes <- unique(
-      stats::na.omit(c(ped[[personID]], ped[[momID]], ped[[dadID]]))
-    )
-    edges <- rbind(
-        as.matrix(ped[,c(personID, momID)]),
-        as.matrix(ped[,c(personID, dadID)]))
-    edges <- edges[stats::complete.cases(edges),]
+  nodes <- unique(
+    stats::na.omit(c(ped[[personID]], ped[[momID]], ped[[dadID]]))
+  )
+  edges <- rbind(
+    as.matrix(ped[, c(personID, momID)]),
+    as.matrix(ped[, c(personID, dadID)])
+  )
+  edges <- edges[stats::complete.cases(edges), ]
 
-    # Make graph
-    pg <- igraph::graph_from_data_frame(d=edges,
-                                        directed=TRUE, # directed = TRUE looks better
-                                        vertices=nodes)
+  # Make graph
+  pg <- igraph::graph_from_data_frame(
+    d = edges,
+    directed = directed, # directed = TRUE looks better
+    vertices = nodes
+  )
 
-    return(pg)
+  return(pg)
 }
-

R/helper.R

@@ -131,4 +131,4 @@ related_coef <- function(...) {
 relatedness <- function(...) {
   warning("The 'relatedness' function is deprecated. Please use 'inferRelatedness' instead.")
   inferRelatedness(...)
-}
+}

R/plotPedigree.R

@@ -26,47 +26,47 @@ plotPedigree <- function(ped,
 
   # Check if dataframe matches the criteria
   if (identical(sort(names(ped)), sort(simulated_vars))) {
-  p <- ped[, c("fam", "ID", "dadID", "momID","sex")]
-  colnames(p) <- c("ped", "id", "father", "mother", "sex")
-  # data conversation
-  p[is.na(p)] <- 0
-  p$affected <- 0
-  p$avail <- 0
-  if(!is.null(code_male)){
-    p$sex_recode <- "F"
-    p$sex_recode[p$sex==code_male] <- "M"
-  }else{
-    p$sex_recode <- p$sex
-  }
- # family id
-  if(length(unique(p$ped))==1){ # only one family
-    p$ped <- 1
-   }else{
-     # Assign a unique string pattern "fam #" for each unique family
-     unique_families <- unique(p$fam)
-     named_families <- 1:length(unique_families)
-     p$ped <- named_families[match(p$fam, unique_families)]
-  }
-  p2 <- kinship2::pedigree(
-    id = p$id,
-    dadid = p$father,
-    momid = p$mother,
-    sex = p$sex_recode,
-    famid = p$ped
-  )
-  p3 <- p2["1"]
-  print(p3)
-  return(kinship2::plot.pedigree(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
-  ))
+    p <- ped[, c("fam", "ID", "dadID", "momID", "sex")]
+    colnames(p) <- c("ped", "id", "father", "mother", "sex")
+    # data conversation
+    p[is.na(p)] <- 0
+    p$affected <- 0
+    p$avail <- 0
+    if (!is.null(code_male)) {
+      p$sex_recode <- "F"
+      p$sex_recode[p$sex == code_male] <- "M"
+    } else {
+      p$sex_recode <- p$sex
+    }
+    # family id
+    if (length(unique(p$ped)) == 1) { # only one family
+      p$ped <- 1
+    } else {
+      # Assign a unique string pattern "fam #" for each unique family
+      unique_families <- unique(p$fam)
+      named_families <- 1:length(unique_families)
+      p$ped <- named_families[match(p$fam, unique_families)]
+    }
+    p2 <- kinship2::pedigree(
+      id = p$id,
+      dadid = p$father,
+      momid = p$mother,
+      sex = p$sex_recode,
+      famid = p$ped
+    )
+    p3 <- p2["1"]
+    print(p3)
+    return(kinship2::plot.pedigree(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
+    ))
   } else {
     stop("The structure of the provided pedigree data does not match the expected structure.")
   }

R/simulatePedigree.R

@@ -26,11 +26,11 @@
 #' @export
 
 simulatePedigree <- function(kpc = 3,
-                   Ngen = 4,
-                   sexR = .5,
-                   marR = 2 / 3,
-                   balancedSex = TRUE,
-                   balancedmar = TRUE) {
+                             Ngen = 4,
+                             sexR = .5,
+                             marR = 2 / 3,
+                             balancedSex = TRUE,
+                             balancedmar = TRUE) {
   # SexRatio: ratio of male over female in the offspring setting; used in the between generation combinations
   SexRatio <- sexR / (1 - sexR)