Part II: Main analysis
Steps 1-5: Calculation of pairwise recombination rates
out <- foreach(chr = 1:nchr, .packages = "hsrecombi") %dopar% {
# 1: Physical map
map <- read.table(file.path(path.dat, paste0("map_chr", chr, ".map")), col.names = c("Chr", "Name",
"locus_Mb", "locus_bp"))
map$SNP <- 1:nrow(map)
locus_Mb <- map$locus_Mb
# 2: Genotype matrix
genomatrix <- data.table::fread(file.path(path.dat, paste0("hsphase_input_chr", chr, ".raw")))
X <- as.matrix(genomatrix[, -c(1:6)])
# 3: Assign daughters to sire IDs
daughterSire <- genomatrix$PAT
# 4: Estimate sire haplotypes and format data
hap <- makehappm(unique(daughterSire), daughterSire, X)
save("hap", file = file.path(path.res, paste0("hsphase_output_chr", chr, ".Rdata")))
# Check order and dimension
io <- sapply(1:nrow(map), function(z) {
grepl(x = colnames(X)[z], pattern = map$Name[z])
})
if (sum(io) != nrow(map))
stop("ERROR in dimension")
# 5: Estimate recombination rates
res <- hsrecombi(hap, X, map$SNP)
final <- editraw(res, map)
save(list = c("final", "locus_Mb"), file = file.path(path.res, paste0("Results_chr", chr, ".RData")))
ifelse(nrow(final) > 0, "OK", "no result")
}
print(which(unlist(out) == "OK"))
#> [1] 1 2In step 4, function makehap would be sufficient but makehappm allows comparison with a deterministic approach shown later. Note that sire haplotypes can also be obtained by some other (external) software. Then sire haplotypes and sire-to-daughter information need to be reshaped with makehaplist in step 4.
6: Check for candidates of misplacement
# 6a: Filter SNPs with unusually large recombination rate to neighbouring (30) SNPs
excl <- foreach(chr = 1:nchr, .packages = "hsrecombi") %dopar% {
load(file.path(path.res, paste0("Results_chr", chr, ".RData")))
checkCandidates(final)
}
# 6b: Heatmap plot of recombination rates for visual verification, e.g.:
chr <- 2
load(file.path(path.res, paste0("Results_chr", chr, ".RData")))
cand <- excl[[chr]][1]
win <- cand + (-100:100)
win <- win[(win >= 1) & (win <= max(final$SNP2))]
target <- final[(final$SNP1 %in% win) & (final$SNP2 %in% win), ]
ggplot(data = target, aes(SNP2, SNP1, fill = theta)) + geom_tile() + xlab("Locus 2") + ylab("Locus 1") +
coord_equal() + scale_y_continuous(trans = "reverse") + theme(panel.background = element_blank(),
panel.grid.major = element_line(colour = "grey", size = 0.1), panel.grid.minor = element_line(colour = "grey")) +
theme(text = element_text(size = 18)) + scale_fill_gradientn(colours = c("yellow", "red"), limits = c(0,
1 + 1e-10), na.value = "white")
Orange colour in the SNP neighbourhood implies an increased recombination rate. In case of a misplaced marker or a cluster of misplaced markers, the heatmap is characterised by an orange band.
7: Approximation of genetic positions
pos <- foreach(chr = 1:nchr, .packages = "hsrecombi") %dopar% {
load(file.path(path.res, paste0("Results_chr", chr, ".RData")))
out <- geneticPosition(final, exclude = excl[[chr]])
list(pos.cM = c(out, rep(NA, length(locus_Mb) - length(out))), pos.Mb = locus_Mb)
}Genetic position is reported as NA if the corresponding SNP has not been considered in the analysis (e.g., when no sire was heterozygous at the corresponding SNP).
8: Plot of physical versus genetic-map positions
data <- data.frame(Chr = rep(1:length(pos), times = unlist(list.select(pos, length(pos.Mb)))), Mbp = unlist(list.select(pos,
pos.Mb)), cM = unlist(list.select(pos, pos.cM)))
ggplot(data, aes(x = Mbp, y = cM)) + geom_point(na.rm = T) + facet_grid(Chr ~ .)
9: Plot of genetic mapping function
The genetic mapping function that fits best to the estimated data can be retrieved from a system of mapping functions (Rao et al. 1977, Human Hered); putatively misplaced markers need to be excluded. Given a parameter \(p\), recombination rate \(\theta \in (0,0.5)\) is mapped to Morgan units by \[ f(\theta; p) = \frac{1}{6}(p(2p - 1)(1 - 4p) log(1 - 2\theta) + 16p(p - 1)(2p - 1) \text{atan}(2\theta) + 2p(1 - p)(8p + 2)\text{atanh}(2\theta) + 6(1 - p)(1 - 2p)(1 - 4p)\theta) \]
for (chr in 1:nchr) {
load(file.path(path.res, paste0("Results_chr", chr, ".RData")))
final$theta[(final$SNP1 %in% excl[[chr]]) | (final$SNP2 %in% excl[[chr]])] <- NA
final$dist_M <- (pos[[chr]]$pos.cM[final$SNP2] - pos[[chr]]$pos.cM[final$SNP1])/100
out <- bestmapfun(theta = final$theta, dist_M = final$dist_M)
plot(final$dist_M, final$theta, xlab = "genetic distance (Morgan)", ylab = "recombination rate",
col = 8)
x <- seq(0, 0.5, 0.01)
y <- rao(out$mixing, x)
points(y, x, type = "l", lwd = 2)
legend("bottomright", legend = paste0("map function (p=", round(out$mixing, 3), ")"), lwd = 2, lty = 1,
bty = "n")
}
The mixing parameter \(p\) is estimated via quadratic optimisation in bestmapfun. A value of \(p=0\) would match to Morgan’s mapping function, \(p=0.25\) to Carter, \(p=0.5\) to Kosambi and \(p=1\) resembles Haldane’s mapping function.
The likelihood-based approach requires a sufficiently large sample size if SNP density is high. A verification of the bias of genetic-map positions can be found in the Supplemental Material of