R/add.pedigree.r

In synbreed: Framework for the Analysis of Genomic Prediction Data using R

add.pedigree <- function(ped, IDadd, add.ancestors=FALSE){
  if(!all.equal(class(ped), c("pedigree", "data.frame"))) stop(paste(substitute(ped), "has to be an object generated by create.pedigree()"))
  if(!all.equal(class(IDadd), c("pedigree", "data.frame"))) stop(paste(substitute(IDadd), "has to be an object generated by create.pedigree()"))

  # only unique IDs
  IDped <- unique(rbind(ped[ped$ID %in%IDadd$ID, c("ID", "Par1", "Par2")], IDadd[IDadd$ID %in% ped$ID, c("ID", "Par1", "Par2")]))
  if(length(unique(IDped[,"ID"]))!=nrow(IDped))  stop("IDs are not unique, removing duplicated individuals")
  if(!is.null(ped$sex)&is.null(IDadd$sex)){
    IDadd$sex <- NA
    warning("No information on sex in ", substitute(IDadd), ". Values will be set to NA")
  }
  if(is.null(ped$sex)&!is.null(IDadd$sex)){
    ped$sex <- NA
    warning("No information on sex in ", substitute(ped), ". Values will be set to NA")
  }
  ped <- rbind(ped, IDadd[IDadd$gener==0,])
  IDadd <- IDadd[!IDadd$ID %in% ped$ID,]
  gener <- sort(unique(IDadd$gener))
  for(i in gener){
    geners <- cbind(ped$gener[match(IDadd$Par1[IDadd$gener==i], ped$ID)],
                    ped$gener[match(IDadd$Par2[IDadd$gener==i], ped$ID)])
    geners <- apply(geners,1,max)+1
    ped <- rbind(ped, IDadd[IDadd$gener==i,])
    ped$gener[ped$ID %in% IDadd$ID[IDadd$gener==i]] <- geners
  }
  ped <- ped[order(ped$gener, ped$ID), ]
  return(ped)
}