#' Add parents
#'
## Copyright(c) 2017-2020 R. Mark Sharp
## This file is part of nprcgenekeepr
#' Pedigree curation function
#' Given a pedigree, find any IDs listed in the "sire" or "dam" columns
#' that lack their own line entry and generate one.
#'
#' This must be run after to \code{addUIds} since the IDs made there are
#' used by \code{addParents}
#'
#' @return An updated pedigree with entries added as necessary.
#' Entries have the id and sex specified; all remaining columns are filled
#' with \code{NA}.
#'
#' @examples
#' \donttest{
#' pedTwo <- data.frame(id = c("d1", "s2", "d2", "o1", "o2", "o3", "o4"),
#' sire = c(NA, NA, NA, "s1", "s1", "s2", "s2"),
#' dam = c(NA, NA, NA, "d1", "d2", "d2", "d2"),
#' sex = c("F", "M", "F", "F", "F", "F", "M"),
#' stringsAsFactors = FALSE)
#' newPed <- addParents(pedTwo)
#' newPed
#' }
#'
#' @param ped datatable that is the `Pedigree`. It contains pedigree
#' information including the IDs listed in \code{candidates}.
#' @export
addParents <- function(ped) {
sires <- ped$sire
dams <- ped$dam
# Finding sires and dams not in the id column
a1 <- sires[!(sires %in% ped$id) & !is.na(sires)]
a1 <- a1[!duplicated(a1)]
a2 <- dams[!(dams %in% ped$id) & !is.na(dams)]
a2 <- a2[!duplicated(a2)]
a1 <- data.frame(id = a1, stringsAsFactors = FALSE)
a2 <- data.frame(id = a2, stringsAsFactors = FALSE)
# Add recordStatus to identify original records
# if (length(ped) > 4) {
# ped <- cbind(ped[ , c("id", "sire", "dam", "sex")],
# recordStatus = "original",
# ped[ , names(ped)[5:length(ped)], drop = FALSE],
# stringsAsFactors = FALSE)
# } else {
ped <- ped[ , !names(ped) %in% "recordStatus"]
ped <- cbind(ped, recordStatus = "original", stringsAsFactors = FALSE)
#}
# Adding line entries for these parents
if (nrow(a1) > 0) {
a1$sire <- NA
a1$dam <- NA
a1$sex <- "M"
a1$recordStatus <- "added"
ped <- rbindFill(ped, a1)
}
if (nrow(a2) > 0) {
a2$sire <- NA
a2$dam <- NA
a2$sex <- "F"
a2$recordStatus <- "added"
ped <- rbindFill(ped, a2)
}
return(ped)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.