Recursive Method to Generate Partial Kinship and
Inbreeding Coefficients Across Founders

• Founder Specific Kinship Matrix Function
  Lacy_1996 <- function(animal,sire,dam,founders,kinship =FALSE)
  {
    Founders <- length(founders) # Number of Founders #
    PartialInbreedingF <- vector("list", Founders+1) # Stores Partial Kinships #
    ## Loop Through Founders
    for(f in 1:Founders)
    {
      ## Step 1 - Set up founder square block
      PartialKinship <- matrix(data=NA,ncol=length(animal),nrow=length(animal),byrow=T)
      PartialKinship[1:(Founders),1:(Founders)] <- 0
      PartialKinship[f,f] <- 0.5
      ## loop through non-founders
      for(i in (Founders+1):ncol(PartialKinship))
      {
        if (sire[i] != 0 & dam[i] != 0) # Both parents known #
        {
          for(j in 1:(i-1))
          {
            PartialKinship[j,i] = 0.5*(PartialKinship[sire[i],j]+PartialKinship[dam[i],j])
            PartialKinship[i,j] = PartialKinship[j,i];
          }
          PartialKinship[i,i] = PartialKinship[i,f] + (0.5*PartialKinship[sire[i],dam[i]])
        }
        if(sire[i] == 0 & dam[i] != 0) # Only Dam is known #
        {
          for(j in 1:(i-1))
          {
            PartialKinship[j,i] = PartialKinship[i,j] = 0.5 * (PartialKinship[j,dam[i]])
          }
          PartialKinship[i,i] = PartialKinship[i,f]*2
        }
        if(sire[i] != 0 & dam[i] == 0) # Only Sire is known #
        {
          for(j in 1:(i-1))
          {
            PartialKinship[j,i] = PartialKinship[i,j] = 0.5 * (PartialKinship[j,sire[i]])
          }
          PartialKinship[i,i] = PartialKinship[i,f]*2
        }
      }
      PartialInbreedingF[[f]] <- PartialKinship
    }
    ## Now calculate partial inbreeding coefficient of an ##
    ## individual with respect to a given founder ##
    sizef = length(c((Founders+1):length(animal)))
    PartF <- cbind(c(animal[(Founders+1):length(animal)]),matrix(data=0,ncol=Founders,nrow=sizef))
    for(i in 1:sizef) # Loop across non-founder individuals #
    {
      for(f in 1:(Founders)) # Loop across founders #
      {
        if (sire[(Founders+i)] != 0 & dam[(Founders+i)] != 0)
        {
          # Partial Inbreeding Coefficient with respect to founder #
          # j of a descendant i (with parents m and p) is given by Fi(j) = f_mp. #
          PartF[i,c(f+1)] <- PartialInbreedingF[[f]][sire[Founders+i],dam[Founders+i]]
        }
      }
    }
    # if want partial kinships but partial F in list #
    PartialInbreedingF[[Founders+1]] <- PartF;
    # if don't want partial kinships just output partial F #
    if(kinship == TRUE){return(PartialInbreedingF)}
    if(kinship == FALSE){return(PartF)}
  }