| Title: | Pedigree Functions |
|---|---|
| Description: | Pedigree related functions. |
| Authors: | Albart Coster [aut, cre] |
| Maintainer: | Albart Coster <[email protected]> |
| License: | GPL (>= 2) |
| Version: | 1.4.2 |
| Built: | 2024-12-07 06:48:02 UTC |
| Source: | CRAN |
Package with functions to analyse and transform pedigree data. A
pedigree is a data.frame where the first column contains an
ID, and the second and third columns contain ID of first and second parent.
Albart Coster: <[email protected]>
trimPed
orderPed
countGen
makeA
makeAinv
calcInbreeding
add.Inds
Function add.Inds() adds missing individuals to a pedigree and returns the
complete pedigree as a data.frame with the same headers as the
original pedigree. Remeber to check for errors beforehand with
function errors.ped. Unknown parents should be coded as NA.
add.Inds(ped)add.Inds(ped)
ped |
|
data.frame of three columns with identical header as input.
Albart Coster, [email protected]
ID <- 3:5 DAM <- c(1,1,3) SIRE <- c(2,2,4) pedigree <- data.frame(ID,DAM,SIRE) pedigree <- add.Inds(pedigree)ID <- 3:5 DAM <- c(1,1,3) SIRE <- c(2,2,4) pedigree <- data.frame(ID,DAM,SIRE) pedigree <- add.Inds(pedigree)
Fit an animal model to data, use a given variance ratio
(). Calculate inverse of the
additive genetic relationship matrix using function makeInv()
of this package.
blup(formula, ped, alpha,trim = FALSE)blup(formula, ped, alpha,trim = FALSE)
formula |
formula of the model, do not include the random effect due to animal (generally ID). |
ped |
|
alpha |
Variance ratio ( |
trim |
If |
Vector of solutions to the model, including random animal effects.
SamplePedigree, gblup,
makeAinv,blup
example(gblup) sol <- blup(P~1,ped = ped,alpha = 1/h2 - 1)example(gblup) sol <- blup(P~1,ped = ped,alpha = 1/h2 - 1)
Function to calculate a relationship matrix from marker data. Option
to return the inverse of matrix. Inverse calculated using
Matrix package.
calcG(M, data = NULL,solve = FALSE)calcG(M, data = NULL,solve = FALSE)
M |
Matrix of marker genotypes, usually the count of one of the two SNP alleles at each markers (0, 1, or 2). |
data |
Optional logical vector which can tell of which individuals we have phenotypes. |
solve |
Logic, if TRUE then function returns the inverse of the relationship matrix. |
Matrix of class dgeMatrix.
SamplePedigree, gblup,
makeAinv,blup
example(gblup) G <- calcG(M) Ginv <- calcG(M,solve = TRUE)example(gblup) G <- calcG(M) Ginv <- calcG(M,solve = TRUE)
Calculates inbreeding coefficients of individuals in a pedigree.
calcInbreeding(ped)calcInbreeding(ped)
ped |
|
Logical.
id <- 1:6 dam <- c(0,0,1,1,4,4) sire <- c(0,0,2,2,3,5) ped <- data.frame(id,dam,sire) (F <- calcInbreeding(ped))id <- 1:6 dam <- c(0,0,1,1,4,4) sire <- c(0,0,2,2,3,5) ped <- data.frame(id,dam,sire) (F <- calcInbreeding(ped))
Counts generation number for individuals in a pedigreee.
countGen(ped)countGen(ped)
ped |
|
Numeric vector
id <- 1:5 dam <- c(0,0,1,1,4) sire <- c(0,0,2,2,3) ped <- data.frame(id,dam,sire) (gens <- countGen(ped))id <- 1:5 dam <- c(0,0,1,1,4) sire <- c(0,0,2,2,3) ped <- data.frame(id,dam,sire) (gens <- countGen(ped))
Function to count the number of offspring for each individual in a pedigree. With loops, offspring of later generations will be counted several times.
countOff(ped)countOff(ped)
ped |
|
Numeric vector with number of offspring for each individual in the pedigree.
Albart Coster
example(countGen) countOff(ped)example(countGen) countOff(ped)
Fit an animal model to data, use a given variance ratio
(). Calculate genetic
relationship matrix using the function calcG of this package.
gblup(formula, data, M, lambda)gblup(formula, data, M, lambda)
formula |
formula of the model, do not include the random effect due to animal (generally ID). |
data |
|
M |
Matrix of marker genotypes, usually the count of one of the two SNP alleles at each markers (0, 1, or 2). |
lambda |
Variance ratio ( |
Vector of solutions to the model, including random animal effects.
SamplePedigree, gblup,
makeAinv,blup
## Example Code from SampleHaplotypes hList <- HaploSim::SampleHaplotypes(nHaplotypes = 20,genDist = 1,nDec = 3,nLoc = 20) ## create objects h <- HaploSim::SampleHaplotype(H0 = hList[[1]],H1 = hList[[2]],genDist = 1,nDec = 3) ## code from the Example SamplePedigree ID <- 1:10 pID0 <- c(rep(0,5),1,1,3,3,5) pID1 <- c(rep(0,4),2,2,2,4,4,6) ped <- data.frame(ID,pID0,pID1) phList <- HaploSim::SamplePedigree(orig = hList,ped = ped) ## own code h2 <- 0.5 ped <- phList$ped hList <- phList$hList qtlList <- HaploSim::ListQTL(hList = hList,frqtl = 0.1,sigma2qtl = 1) qtl <- tapply(unlist(qtlList),list(rep(names(qtlList),times = unlist(lapply(qtlList,length))), unlist(lapply(qtlList,function(x)seq(1,length(x))))),mean,na.rm = TRUE) qtl <- reshape::melt(qtl) names(qtl) <- c("POS","TRAIT","a") HH <- HaploSim::getAll(hList,translatePos = FALSE) rownames(HH) <- sapply(hList,function(x)x@hID) QQ <- HH[,match(qtl$POS,colnames(HH))] g <- QQ ped$G <- with(ped,g[match(hID0,rownames(g))]+g[match(hID1,rownames(g))]) sigmae <- sqrt(var(ped$G)/h2 - var(ped$G)) ped$P <- ped$G + rnorm(nrow(ped),0,sigmae) M <- with(ped,HH[match(hID0,rownames(HH)),] + HH[match(hID1,rownames(HH)),]) rownames(M) <- ped$ID sol <- gblup(P~1,data = ped[,c('ID','P')],M = M,lambda = 1/h2 - 1)## Example Code from SampleHaplotypes hList <- HaploSim::SampleHaplotypes(nHaplotypes = 20,genDist = 1,nDec = 3,nLoc = 20) ## create objects h <- HaploSim::SampleHaplotype(H0 = hList[[1]],H1 = hList[[2]],genDist = 1,nDec = 3) ## code from the Example SamplePedigree ID <- 1:10 pID0 <- c(rep(0,5),1,1,3,3,5) pID1 <- c(rep(0,4),2,2,2,4,4,6) ped <- data.frame(ID,pID0,pID1) phList <- HaploSim::SamplePedigree(orig = hList,ped = ped) ## own code h2 <- 0.5 ped <- phList$ped hList <- phList$hList qtlList <- HaploSim::ListQTL(hList = hList,frqtl = 0.1,sigma2qtl = 1) qtl <- tapply(unlist(qtlList),list(rep(names(qtlList),times = unlist(lapply(qtlList,length))), unlist(lapply(qtlList,function(x)seq(1,length(x))))),mean,na.rm = TRUE) qtl <- reshape::melt(qtl) names(qtl) <- c("POS","TRAIT","a") HH <- HaploSim::getAll(hList,translatePos = FALSE) rownames(HH) <- sapply(hList,function(x)x@hID) QQ <- HH[,match(qtl$POS,colnames(HH))] g <- QQ ped$G <- with(ped,g[match(hID0,rownames(g))]+g[match(hID1,rownames(g))]) sigmae <- sqrt(var(ped$G)/h2 - var(ped$G)) ped$P <- ped$G + rnorm(nrow(ped),0,sigmae) M <- with(ped,HH[match(hID0,rownames(HH)),] + HH[match(hID1,rownames(HH)),]) rownames(M) <- ped$ID sol <- gblup(P~1,data = ped[,c('ID','P')],M = M,lambda = 1/h2 - 1)
Makes the A matrix for a part of a pedigree and stores it in a file called
A.txt.
makeA(ped,which)makeA(ped,which)
ped |
|
which |
Logical vector specifying between which indiduals additive genetic relationship is required. Goes back through the whole pedigree but only for subset of individuals. |
Logical.
id <- 1:6 dam <- c(0,0,1,1,4,4) sire <- c(0,0,2,2,3,5) ped <- data.frame(id,dam,sire) makeA(ped,which = c(rep(FALSE,4),rep(TRUE,2))) A <- read.table("A.txt") if(file.exists("A.txt")) file.remove("A.txt")id <- 1:6 dam <- c(0,0,1,1,4,4) sire <- c(0,0,2,2,3,5) ped <- data.frame(id,dam,sire) makeA(ped,which = c(rep(FALSE,4),rep(TRUE,2))) A <- read.table("A.txt") if(file.exists("A.txt")) file.remove("A.txt")
Makes inverted A matrix for a pedigree and stores it in a file called
Ainv.txt.
makeAinv(ped)makeAinv(ped)
ped |
|
Logical.
id <- 1:6 dam <- c(0,0,1,1,4,4) sire <- c(0,0,2,2,3,5) ped <- data.frame(id,dam,sire) makeAinv(ped) Ai <- read.table('Ainv.txt') nInd <- nrow(ped) Ainv <- matrix(0,nrow = nInd,ncol = nInd) Ainv[as.matrix(Ai[,1:2])] <- Ai[,3] dd <- diag(Ainv) Ainv <- Ainv + t(Ainv) diag(Ainv) <- dd if(file.exists("Ainv.txt")) file.remove("Ainv.txt")id <- 1:6 dam <- c(0,0,1,1,4,4) sire <- c(0,0,2,2,3,5) ped <- data.frame(id,dam,sire) makeAinv(ped) Ai <- read.table('Ainv.txt') nInd <- nrow(ped) Ainv <- matrix(0,nrow = nInd,ncol = nInd) Ainv[as.matrix(Ai[,1:2])] <- Ai[,3] dd <- diag(Ainv) Ainv <- Ainv + t(Ainv) diag(Ainv) <- dd if(file.exists("Ainv.txt")) file.remove("Ainv.txt")
Orders a pedigree so that offspring follow parents.
orderPed(ped)orderPed(ped)
ped |
|
numerical vector
id <- 1:6 dam <- c(0,0,1,1,4,4) sire <- c(0,0,2,2,3,5) pedigree <- data.frame(id,dam,sire) (ord <- orderPed(pedigree)) pedigree <- pedigree[6:1,] (ord <- orderPed(pedigree)) pedigree <- pedigree[order(ord),] pwrong <- pedigree pwrong[1,2] <- pwrong[6,1]id <- 1:6 dam <- c(0,0,1,1,4,4) sire <- c(0,0,2,2,3,5) pedigree <- data.frame(id,dam,sire) (ord <- orderPed(pedigree)) pedigree <- pedigree[6:1,] (ord <- orderPed(pedigree)) pedigree <- pedigree[order(ord),] pwrong <- pedigree pwrong[1,2] <- pwrong[6,1]
Trims a pedigree given a vector of data. Branches without data are trimmed off the pedigree.
trimPed(ped, data,ngenback = NULL)trimPed(ped, data,ngenback = NULL)
ped |
|
data |
TRUE-FALSE vector. Specifies if data for an individual is available. |
ngenback |
Number of generations back. Specifies the number of generations to keep before the individuals with data. |
Logical vector specifying if an individual should stay in the pedigree.
id <- 1:5 dam <- c(0,0,1,1,4) sire <- c(0,0,2,2,3) data <- c(FALSE,FALSE,TRUE,FALSE,FALSE) ped <- data.frame(id,dam,sire) yn <- trimPed(ped,data) ped <- ped[yn,]id <- 1:5 dam <- c(0,0,1,1,4) sire <- c(0,0,2,2,3) data <- c(FALSE,FALSE,TRUE,FALSE,FALSE) ped <- data.frame(id,dam,sire) yn <- trimPed(ped,data) ped <- ped[yn,]