BookEKM-package {BookEKM} | R Documentation |
Functions and data sets used in the book "Relationship Inference with Familias and R. Statistical Methods in Forensic Genetics" by T Egeland, D Kling and P Mostad
Package: | BookEKM |
Type: | Package |
Version: | 1.0 |
Date: | 2014-11-19 |
License: | Lazy |
Thore Egeland
#Example Ch 8. Obtaining data from a relative. Expected cost require(paramlink) require(DNAprofiles) require(Familias) data(NorwegianFrequencies) z <- singleton(1, sex=1) #Pedigree for H2 x <- nuclearPed(2, sex=1) x <- addOffspring(x,father=1, sex=1, noff=1) #Pedigree for H1 n <- 15 h1 <- h2 <- vector("list",n) for(i in 1:n){ L <- NorwegianFrequencies[[i]] mx <- marker(x, alleles=names(L), afreq=L) #For simplicity data for 3 and 4 are simulated gt1 <- markerSim(x, 1, available = c(3,4), partialmarker=mx, seed = 177, verbose = FALSE) num <- oneMarkerDistribution(gt1, 6, gt1$markerdata[[1]], verbose=FALSE) mz <- marker(z, alleles=names(L), afreq=L) den <- oneMarkerDistribution(z, 1, verbose=FALSE, partialmarker=mz) LR <- num/den #All calculations done. Rearranging below: ord <- order(LR) tab <- cbind(LR,num,den)[ord,] tab[,-1] <- apply(tab[,-1],2,cumsum) keep <- !duplicated(round(LR[ord],7), fromLast=TRUE) tab <- tab[keep,] d1 <- dim(tab)[1] tab[,2] <- tab[,2]-c(0,tab[-d1,2]) tab[,3] <- tab[,3]-c(0,tab[-d1,3]) colnames(tab) <- c("LR", "Pr.H1", "Pr.H2") h1[[i]] <- list(x=tab[,1], fx=tab[,2]) h2[[i]] <- list(x=tab[,1], fx=tab[,3]) } N <- 1e+06; c.D <- 0.1; odds <- 100; L.L <- 1/10000; L.H <- 10000 p1 <- 1-sim.q(L.H/odds, N=N, dists=h1) p2 <- 1-sim.q(L.L/odds, N=N, dists=h1) p3 <- sim.q(L.L/odds, N=N, dists=h2, dists.sample=h1) p4 <- sim.q(L.H/odds, N=N, dists=h2, dists.sample=h1) EC <- c.D + odds/(odds + 1) * (p1 + p2/L.L) + 1/(odds + 1) * (p3 + p4 * L.H) data.frame(p1,p2,p3,p4,EC)