diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index c1326560..4332ba0b 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -43,7 +43,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::rcmdcheck + extra-packages: github::LynxJinyangii/RcppTskit/RcppTskit@add-multiple-functions-on-pr-131, any::rcmdcheck needs: check - uses: r-lib/actions/check-r-package@v2 diff --git a/.github/workflows/document.yaml b/.github/workflows/document.yaml index 24934b79..486e5dcf 100644 --- a/.github/workflows/document.yaml +++ b/.github/workflows/document.yaml @@ -29,7 +29,7 @@ jobs: - name: Install dependencies uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::roxygen2 + extra-packages: github::LynxJinyangii/RcppTskit/RcppTskit@add-multiple-functions-on-pr-131, any::roxygen2 needs: roxygen2 - name: Document diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 0b260216..91667d7f 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -30,7 +30,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::pkgdown, local::. + extra-packages: github::LynxJinyangii/RcppTskit/RcppTskit@add-multiple-functions-on-pr-131, any::pkgdown, local::. needs: website - name: Build site diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index e38eef6a..65c868f9 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -36,7 +36,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::covr, any::xml2 + extra-packages: github::LynxJinyangii/RcppTskit/RcppTskit@add-multiple-functions-on-pr-131, any::covr, any::xml2 needs: coverage - name: Test coverage diff --git a/.gitignore b/.gitignore index 22624c10..09caeebd 100644 --- a/.gitignore +++ b/.gitignore @@ -10,6 +10,7 @@ .Rhistory .Rproj.user/ .Ruserdata +.Rproj.user.bak/ .httr-oauth /*.Rcheck/ /.*tar.gz @@ -30,3 +31,38 @@ src/Makevars src/Makevars.win vignettes/*.html vignettes/*.pdf +.idea/ +src/.idea/ +.Rlib/ +*tar.gz +__pycache__/ +testData/out_phase1_useMacsMut_FALSE/*.trees +testData/out_msprime_from_macs/*.trees +dev/testData/out_phase1_useMacsMut_FALSE/*.trees +dev/testData/out_msprime_from_macs/*.trees +dev/testData/AlphaSimR_extended_TS_*.trees +dev/testData/inbred_test.trees +dev/testData/forward_*.trees +dev/testData/msprime_bridge_*.trees +dev/testData/msprime_direct_*.trees +dev/testData/runMacTS_bridge_*.trees +dev/testData/runMacTS_direct_*.trees +dev/testData/runMacTS_founder_*.trees +dev/testData/runMacsTS_bridge_*.trees +dev/testData/runMacsTS_direct_*.trees +dev/testData/runMacsTS_founder_*.trees +dev/testData/standard_forward_recorder_*.trees +dev/testData/standard_*_forward_recorder_*.trees +dev/testData/standard_msprime_*_input_forward_recorder_*.trees +dev/testData/standard_msprime_vcf_addTsMut_forward_recorder_*.trees +!dev/testData/*.vcf +!dev/testData/AlphaSimR_extended_chr*.trees +!dev/testData/MaCSTS*.trees +!dev/testData/msprime_chr*.trees +dev/testData/*_pairs.json +dev/testData/hotspots*.txt +dev/testData/*_hotspots_for_window_counts.txt +dev/testData/out_phase1_useMacsMut_FALSE/*.debug.txt +dev/testData/out_phase1_useMacsMut_FALSE/*.demography.png +dev/*.html +dev/tmp_tree.* diff --git a/DESCRIPTION b/DESCRIPTION index 2af5936d..33a9175a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,8 +43,7 @@ Depends: R (>= 4.0.0) Imports: Rcpp (>= 0.12.7), Rdpack, methods, R6, RcppTskit (>= 0.3.0) RdMacros: Rdpack LinkingTo: Rcpp, RcppArmadillo (>= 0.7.500.0.0), BH, dqrng (>= 0.4.1), RcppTskit -RoxygenNote: 7.3.3 Suggests: knitr, rmarkdown, testthat VignetteBuilder: knitr NeedsCompilation: true -Config/roxygen2/version: 8.0.0 +Config/roxygen2/version: 8.1.0 diff --git a/NAMESPACE b/NAMESPACE index a5744d92..c4bf7bc4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(aa) export(addSegSite) export(asCategorical) export(asLogNormal) +export(asMapPop) export(asPoisson) export(attrition) export(bv) @@ -41,6 +42,7 @@ export(hybridCross) export(importGenMap) export(importHaplo) export(importInbredGeno) +export(importVCF) export(isFemale) export(isHybridPop) export(isMale) @@ -89,6 +91,7 @@ export(rtsk_table_collection_summary2) export(rtsk_treeseq_get_num_individuals2) export(runMacs) export(runMacs2) +export(runMacsTS) export(sampleHaplo) export(selIndex) export(selInt) @@ -104,6 +107,8 @@ export(setMarkerHaplo) export(setPheno) export(setPhenoGCA) export(setPhenoProgTest) +export(simAnc) +export(simMut) export(smithHazel) export(solveMKM) export(solveMVM) @@ -114,6 +119,9 @@ export(solveRRBLUP_EM) export(solveRRBLUP_EM2) export(solveRRBLUP_EM3) export(solveUVM) +export(tsForwardFinalizeFromSimParam) +export(tsForwardHasRecorder) +export(tsForwardWriteTreesFromSimParam) export(unnameMultiPop) export(usefulness) export(varA) @@ -146,31 +154,37 @@ import(Rcpp) import(RcppTskit) importFrom(R6,R6Class) importFrom(Rdpack,reprompt) -importFrom(methods,.hasSlot) -importFrom(methods,classLabel) -importFrom(methods,is) -importFrom(methods,new) -importFrom(methods,show) -importFrom(methods,slot) -importFrom(methods,validObject) -importFrom(stats,aggregate) -importFrom(stats,coef) -importFrom(stats,cov2cor) -importFrom(stats,dnorm) -importFrom(stats,lm) -importFrom(stats,model.matrix) -importFrom(stats,na.omit) -importFrom(stats,pnorm) -importFrom(stats,qgamma) -importFrom(stats,qnorm) -importFrom(stats,rbinom) -importFrom(stats,rnorm) -importFrom(stats,rpois) -importFrom(stats,runif) -importFrom(stats,setNames) -importFrom(stats,var) -importFrom(utils,combn) -importFrom(utils,packageDescription) -importFrom(utils,read.table) -importFrom(utils,write.table) +importFrom(methods, + .hasSlot, + classLabel, + is, + new, + show, + slot, + validObject +) +importFrom(stats, + aggregate, + coef, + cov2cor, + dnorm, + lm, + model.matrix, + na.omit, + pnorm, + qgamma, + qnorm, + rbinom, + rnorm, + rpois, + runif, + setNames, + var +) +importFrom(utils, + combn, + packageDescription, + read.table, + write.table +) useDynLib(AlphaSimR, .registration = TRUE) diff --git a/R/Class-Pop.R b/R/Class-Pop.R index ebf398c3..31f4165c 100644 --- a/R/Class-Pop.R +++ b/R/Class-Pop.R @@ -686,7 +686,7 @@ newPop = function(rawPop,ploidy=NULL,simParam=NULL,nThreads=NULL,...){ .newPop = function(rawPop, id=NULL, mother=NULL, father=NULL, iMother=NULL, iFather=NULL, isDH=NULL, femaleParentPop=NULL, maleParentPop=NULL, - hist=NULL, simParam=NULL, nThreads=NULL,...){ + hist=NULL, histGen=NULL, simParam=NULL, nThreads=NULL,...){ if(is.null(simParam)){ simParam = get("SP",envir=.GlobalEnv) } @@ -813,7 +813,7 @@ newPop = function(rawPop,ploidy=NULL,simParam=NULL,nThreads=NULL,...){ if(simParam$isTrackPed){ if(simParam$isTrackRec){ - simParam$addToRec(lastId,id,iMother,iFather,isDH,hist,output@ploidy) + simParam$addToRec(lastId,id,iMother,iFather,isDH,hist,histGen,output@ploidy) #Jinyang modified }else{ simParam$addToPed(lastId,id,iMother,iFather,isDH) } @@ -823,6 +823,14 @@ newPop = function(rawPop,ploidy=NULL,simParam=NULL,nThreads=NULL,...){ output = simParam$finalizePop(output, simParam=simParam, ...) + ts_forward_attrs <- c("tsForwardSource", "tsForwardPosMeta") + for (nm in ts_forward_attrs) { + val <- attr(rawPop, nm, exact = TRUE) + if (!is.null(val)) { + attr(output, nm) <- val + } + } + return(output) } @@ -1534,4 +1542,4 @@ unnameMultiPop = function(x, level = Inf) { } validObject(mp) return(mp) -} \ No newline at end of file +} diff --git a/R/Class-SimParam.R b/R/Class-SimParam.R index 26a661a9..6da91be8 100644 --- a/R/Class-SimParam.R +++ b/R/Class-SimParam.R @@ -111,6 +111,8 @@ SimParam = R6Class( private$.pedigree = matrix(NA_integer_,nrow=0,ncol=3) private$.isTrackRec = FALSE private$.recHist = list() + private$.isTrackRecGen = FALSE + private$.recHistGen = list() private$.varA = numeric() private$.varG = numeric() private$.varE = numeric() @@ -187,6 +189,51 @@ SimParam = R6Class( invisible(self) }, + #' @description Sets genetic-coordinate recombination tracking for the simulation. + #' By default this is turned off. When turned on, it will also turn on pedigree tracking. + #' + #' @param isTrackRecGen should genetic-coordinate recombination tracking be on. + #' @param force should the check for a running simulation be ignored. + setTrackRecGen = function(isTrackRecGen, force=FALSE){ + stopifnot(is.logical(isTrackRecGen)) + if(!force){ + private$.isRunning() + } + private$.isTrackRecGen = isTrackRecGen + if(isTrackRecGen){ + private$.isTrackPed = TRUE + private$.isTrackRec = TRUE + } + invisible(self) + }, + + #' @description Sets forward tree-sequence tracking on/off. + #' When enabled, this also enables genetic-coordinate recombination + #' tracking and can initialize the forward TS recorder immediately. + #' + #' @param isTrackTs should forward tree-sequence tracking be on. + #' @param founderPop founder/sample population used to seed TS node maps. + #' Required on enable if no recorder is already attached. + #' @param force should the check for a running simulation be ignored. + setTrackTs = function(isTrackTs, founderPop=NULL, force=FALSE){ + stopifnot(is.logical(isTrackTs), length(isTrackTs)==1L, !is.na(isTrackTs)) + if(isTRUE(isTrackTs)){ + self$setTrackRecGen(TRUE, force=TRUE) + hasRecorder = !is.null(.tsForwardGetRecorder(self)) + if(is.null(founderPop)){ + if(!hasRecorder){ + stop("setTrackTs(TRUE) requires founderPop when no recorder is attached", call. = FALSE) + } + } else { + tsForwardInitOnSimParam(self, founderPop=founderPop) + } + }else{ + .tsForwardSetRecorder(self, NULL) + } + invisible(self) + }, + + #' @description Resets the internal lastId, the pedigree #' and recombination tracking (if in use) to the #' supplied lastId. Be careful using this function because @@ -217,6 +264,9 @@ SimParam = R6Class( if(private$.isTrackRec){ private$.recHist = private$.recHist[0:lastId] } + if(private$.isTrackRecGen){ + private$.recHistGen = private$.recHistGen[0:lastId] + } invisible(self) }, @@ -2139,9 +2189,12 @@ SimParam = R6Class( #' @param father vector of father iids #' @param isDH indicator for DH lines #' @param hist new recombination history + #' @param histGen new recombination history (genetic coordinate) #' @param ploidy ploidy level addToRec = function(lastId,id,mother,father,isDH, - hist,ploidy){ + hist, + histGen=NULL, + ploidy){ nNewInd = lastId-private$.lastId stopifnot(nNewInd>0) if(length(isDH)==1) isDH = rep(isDH,nNewInd) @@ -2153,6 +2206,8 @@ SimParam = R6Class( length(isDH)==nNewInd) tmp = cbind(mother,father,isDH) rownames(tmp) = id + keepRecHistGen = isTRUE(getOption("AlphaSimR.tsForwardKeepRecHistGen", FALSE)) + storeRecHistGen = keepRecHistGen if(is.null(hist)){ newRecHist = vector("list",nNewInd) tmpLastHaplo = private$.lastHaplo @@ -2172,12 +2227,35 @@ SimParam = R6Class( names(newRecHist) = id private$.recHist = c(private$.recHist, newRecHist) private$.lastHaplo = tmpLastHaplo + + if(private$.isTrackRecGen){ + if(storeRecHistGen){ + private$.recHistGen = c(private$.recHistGen, newRecHist) + }else{ + emptyRecHistGen = vector("list", nNewInd) + names(emptyRecHistGen) = id + private$.recHistGen = c(private$.recHistGen, emptyRecHistGen) + } + } }else{ # Add hist to recombination history private$.hasHap = c(private$.hasHap, rep(FALSE, nNewInd)) private$.isFounder = c(private$.isFounder, rep(FALSE, nNewInd)) names(hist) = id private$.recHist = c(private$.recHist, hist) + if(private$.isTrackRecGen){ + if(storeRecHistGen){ + if(is.null(histGen)){ + histGen = vector("list", nNewInd) + } + names(histGen) = id + private$.recHistGen = c(private$.recHistGen, histGen) + }else{ + emptyRecHistGen = vector("list", nNewInd) + names(emptyRecHistGen) = id + private$.recHistGen = c(private$.recHistGen, emptyRecHistGen) + } + } } private$.pedigree = rbind(private$.pedigree, tmp) private$.lastId = lastId @@ -2292,6 +2370,8 @@ SimParam = R6Class( .pedigree="matrix", .isTrackRec="logical", .recHist="list", + .isTrackRecGen = "logical", + .recHistGen = "list", .varA="numeric", .varG="numeric", .varE="numeric", @@ -2735,6 +2815,25 @@ SimParam = R6Class( } }, + #' @field isTrackRecGen is genetic-coordinate recombination being tracked. + isTrackRecGen = function(value){ + if(missing(value)){ + private$.isTrackRecGen + }else{ + stop("`$isTrackRecGen` is read only",call.=FALSE) + } + }, + + #' @field recHistGen list of historic genetic-coordinate recombination events. + recHistGen = function(value){ + if(missing(value)){ + private$.recHistGen + }else{ + stop("`$recHistGen` is read only",call.=FALSE) + } + }, + + #' @field haplotypes list of computed IBD haplotypes haplotypes=function(value){ if(missing(value)){ diff --git a/R/RcppExports.R b/R/RcppExports.R index ed16b7c5..3fd6371f 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -292,8 +292,8 @@ createIbdMat <- function(ibd, chr, nLoci, ploidy, nThreads) { .Call(`_AlphaSimR_createIbdMat`, ibd, chr, nLoci, ploidy, nThreads) } -cross <- function(motherGeno, mother, fatherGeno, father, femaleMap, maleMap, trackRec, motherPloidy, fatherPloidy, v, p, motherCentromere, fatherCentromere, quadProb, nThreads) { - .Call(`_AlphaSimR_cross`, motherGeno, mother, fatherGeno, father, femaleMap, maleMap, trackRec, motherPloidy, fatherPloidy, v, p, motherCentromere, fatherCentromere, quadProb, nThreads) +cross <- function(motherGeno, mother, fatherGeno, father, femaleMap, maleMap, trackRec, motherPloidy, fatherPloidy, v, p, motherCentromere, fatherCentromere, quadProb, nThreads, trackRecGen, returnRecHistGen, recordTsDirect, returnTsSegGen, directAppendFnSEXP) { + .Call(`_AlphaSimR_cross`, motherGeno, mother, fatherGeno, father, femaleMap, maleMap, trackRec, motherPloidy, fatherPloidy, v, p, motherCentromere, fatherCentromere, quadProb, nThreads, trackRecGen, returnRecHistGen, recordTsDirect, returnTsSegGen, directAppendFnSEXP) } createDH2 <- function(geno, nDH, genMap, v, p, trackRec, nThreads) { @@ -399,6 +399,10 @@ MaCS <- function(args, maxSites, inbred, ploidy, nThreads, seed) { .Call(`_AlphaSimR_MaCS`, args, maxSites, inbred, ploidy, nThreads, seed) } +MaCSTS <- function(args, nChr, inbred, ploidy, nThreads, seed, usePhysicalPositions = FALSE, useMacsMut = FALSE, Nref = NA_real_, expandInbredSamples = TRUE) { + .Call(`_AlphaSimR_MaCSTS`, args, nChr, inbred, ploidy, nThreads, seed, usePhysicalPositions, useMacsMut, Nref, expandInbredSamples) +} + #' @title Summarise `tskit` table collection #' @param tc an external pointer to a \code{tsk_table_collection_t} object. #' @return A list. @@ -426,3 +430,31 @@ rtsk_treeseq_get_num_individuals2 <- function(ts) { .Call(`_AlphaSimR_rtsk_treeseq_get_num_individuals2`, ts) } +tsMutateTableCollection <- function(tc, theta, seed) { + invisible(.Call(`_AlphaSimR_tsMutateTableCollection`, tc, theta, seed)) +} + +tsFinalizeInbredTableCollection <- function(tc, ploidy) { + invisible(.Call(`_AlphaSimR_tsFinalizeInbredTableCollection`, tc, ploidy)) +} + +vcfFounderTableCollection <- function(haplo, pos, seqLen, ploidy, addTsMut) { + .Call(`_AlphaSimR_vcfFounderTableCollection`, haplo, pos, seqLen, ploidy, addTsMut) +} + +tsForwardNodeTableAddRows <- function(tc, flags, time, population, individual) { + .Call(`_AlphaSimR_tsForwardNodeTableAddRows`, tc, flags, time, population, individual) +} + +tsForwardNodeTableAddRowsWithMetadata <- function(tc, flags, time, population, individual, nodeKey) { + .Call(`_AlphaSimR_tsForwardNodeTableAddRowsWithMetadata`, tc, flags, time, population, individual, nodeKey) +} + +tsForwardEdgeTableAddRows <- function(tc, left, right, parent, child) { + invisible(.Call(`_AlphaSimR_tsForwardEdgeTableAddRows`, tc, left, right, parent, child)) +} + +tsForwardSetSampleFlags <- function(tc, samples, clearExisting = TRUE) { + invisible(.Call(`_AlphaSimR_tsForwardSetSampleFlags`, tc, samples, clearExisting)) +} + diff --git a/R/alphaSimR2Ts.R b/R/alphaSimR2Ts.R new file mode 100644 index 00000000..95b1db3f --- /dev/null +++ b/R/alphaSimR2Ts.R @@ -0,0 +1,271 @@ +.bridgeMetadataString <- function(key) { + key <- as.character(key) + key <- gsub("\\\\", "\\\\\\\\", key) + key <- gsub("\"", "\\\\\"", key) + paste0("{\"alphaSimR\":{\"id\":\"", key, "\"}}") +} + +.bridgeIndividualMetadataRaw <- function(file_id) { + charToRaw(paste0("{\"file_id\":", as.integer(file_id), "}")) +} + +recHistMatToSegDf <- function(histMat, nLoci) { + + origin <- as.integer(histMat[, 1]) + starts <- as.integer(histMat[, 2]) + + ends <- c(starts[-1] - 1L, nLoci) + + data.frame( + origin = origin, + locusStart = starts, + locusEnd = ends, + stringsAsFactors = FALSE + ) +} + + +recHistToSegDfWithParents <- function(SP, offspringPop, nLociByChr) { + childIds <- offspringPop@id + ped <- SP$pedigree[childIds, , drop = FALSE] + + out <- list() + k <- 1 + + for (childId in childIds) { + x <- SP$recHist[[childId]] + + motherId <- ped[childId, "mother"] + fatherId <- ped[childId, "father"] + + for (cc in seq_along(x)) { + nLoci <- nLociByChr[[cc]] + + haps <- as.vector(x[[cc]]) + nHap <- length(haps) + + for (h in seq_len(nHap)) { + seg <- recHistMatToSegDf(haps[[h]], nLoci = nLoci) + + parentId <- if (h <= nHap/2) motherId else fatherId + + seg$childId <- childId + seg$chr <- cc + seg$hap <- h + seg$parentId <- parentId + + seg$parentHap <- seg$origin + seg$parentGlobalHapId <- (parentId - 1) * nHap + seg$parentHap + + out[[k]] <- seg[, c("childId", "hap", "chr", + "locusStart","locusEnd", + "parentId","parentHap","parentGlobalHapId")] + k <- k + 1 + } + } + } + + do.call(rbind, out) +} + +bridgeCollectSegFromSimOutput <- function(SP, simOutput, pos_list) { + out <- list() + nLociByChr <- lapply(pos_list, length) + + if (length(simOutput) >= 2L) { + for (k in seq.int(2L, length(simOutput))) { + segDf <- recHistToSegDfWithParents(SP, simOutput[[k]], nLociByChr) + out[[length(out) + 1L]] <- segDf + } + } + + invisible(out) +} + +bridgeAllSegToEdgeDf <- function(chr_info, seg_list, pos_list) { + allSeg <- do.call(rbind, seg_list) + + out <- allSeg + out$left <- NA + out$right <- NA + + for (cc in sort(unique(out$chr))) { + posBp <- pos_list[[cc]] + + tsPath <- chr_info[[cc]]$ts_path + tc <- RcppTskit::tc_load(tsPath) + seqLen <- tc$sequence_length() + + idx <- which(out$chr == cc) + for (i in idx) { + s <- out$locusStart[i] + e <- out$locusEnd[i] + out$left[i] <- if (s == 1) 0 else posBp[s] + out$right[i] <- if (e < length(posBp)) posBp[e + 1] else seqLen + } + } + + out +} + +bridgeComputeIndTime <- function(pedigree) { + n <- nrow(pedigree) + indTime <- rep(NA, n) + + for (i in 1:n) { + m <- pedigree[i, "mother"] + f <- pedigree[i, "father"] + + if (m == 0 && f == 0) { + indTime[i] <- 0 + } else { + indTime[i] <- min(indTime[m], indTime[f]) - 1 + } + } + + indTime +} + + +bridgeWriteTrees <- function(chr_info, edgeDf, SP, out_dir = NULL, + out_basename = "AlphaSimR_extended", + ploidy = NULL) { + + indTime <- bridgeComputeIndTime(SP$pedigree) + + if (is.null(ploidy)) { + ploidy <- suppressWarnings(max(edgeDf$hap, edgeDf$parentHap, na.rm = TRUE)) + } + ploidy <- as.integer(ploidy) + if (length(ploidy) != 1L || is.na(ploidy) || ploidy < 1L) { + stop("ploidy must be supplied or inferable from edgeDf", call. = FALSE) + } + + outPaths <- character(length(chr_info)) + + for (cc in seq_along(chr_info)) { + + nodeIdMap <- new.env(parent = emptyenv()) + indIdMap <- new.env(parent = emptyenv()) + + ts <- RcppTskit::ts_load(chr_info[[cc]]$ts_path) + tc <- ts$dump_tables() + + df <- edgeDf[edgeDf$chr == cc, , drop = FALSE] + if (nrow(df) == 0) { + next + } + + # get indIDs for sampled nodes + sampNodeId <- ts$samples() + sampIndRow <- integer(length(sampNodeId)) + for (i in seq_along(sampNodeId)) { + sampIndRow[i] <- tc$node_table_get_row(sampNodeId[i])$individual + } + if (any(sampIndRow < 0)) { + bad <- which(sampIndRow < 0)[1] + stop( + "Sample node", sampNodeId[bad], "has individual = -1. ", + "Cannot reuse founders' individuals. ", + ) + } + + if (length(sampNodeId) %% ploidy != 0L) { + stop("Sample node count is not divisible by ploidy on chr ", cc, call. = FALSE) + } + nFounder <- length(sampNodeId) / ploidy + idx <- 1 + for (ind in 1:nFounder) { + indRow <- sampIndRow[idx] + assign(as.character(ind), indRow, envir = indIdMap) + + for (h in 1:ploidy) { + nodeId <- as.integer(unlist(sampNodeId[[idx]]))[1] + key <- paste(ind, h, sep = "_") + assign(key, nodeId, envir = nodeIdMap) + # list(alphaSimR = list(id = key))) + idx <- idx + 1 + } + } + + # add indIDs for offSpring nodes + nextInd <- as.integer(tc$num_individuals()) + addNewIndividual <- function(alphaId) { + key <- as.character(alphaId) + indRow <- get0(key, envir = indIdMap, inherits = FALSE) + if (!is.null(indRow)) return(indRow) + + m <- SP$pedigree[alphaId, "mother"] + f <- SP$pedigree[alphaId, "father"] + + mRow <- addNewIndividual(m) + fRow <- addNewIndividual(f) + + newId <- nextInd + tc$individual_table_add_row( + #parents = list(as.integer(mRow), as.integer(fRow)), + parents = c(as.integer(mRow), as.integer(fRow)), + metadata = .bridgeIndividualMetadataRaw(newId)) + + assign(key, as.integer(newId), envir = indIdMap) + + nextInd <<- nextInd + 1L + newId + } + + childIdsNeeded <- sort(as.integer(unique(df$childId))) + for (childId in childIdsNeeded) { + addNewIndividual(childId) + } + + # append child nodes + childKeys <- unique(paste(df$childId, df$hap, sep = "_")) + for (key in childKeys) { + if (is.null(get0(key, envir = nodeIdMap, inherits = FALSE))) { + childId <- as.integer(sub("_.*$", "", key)) + indRow <- get(as.character(childId), envir = indIdMap, inherits = FALSE) + + tc$node_table_add_row( + flags = 0L, + time = indTime[[childId]], + population = -1L, + individual = indRow, + metadata = .bridgeMetadataString(key) + ) + assign(key, as.integer(tc$num_nodes() - 1), envir = nodeIdMap) + } + } + + # append edges + for (i in 1:nrow(df)) { + parentKey <- paste(df$parentId[i], df$parentHap[i], sep = "_") + childKey <- paste(df$childId[i], df$hap[i], sep = "_") + + parentNode <- get0(parentKey, envir = nodeIdMap, inherits = FALSE) + if (is.null(parentNode)) { + stop("Missing parent node for key=", parentKey, + " on chr=", cc, ". Check founder mapping.") + } + childNode <- get(childKey, envir = nodeIdMap, inherits = FALSE) + + tc$edge_table_add_row( + left = df$left[i], + right = df$right[i], + parent = parentNode, + child = childNode + ) + } + + tc$sort() + newTs <- tc$tree_sequence() + + outDirCc <- if (is.null(out_dir)) dirname(chr_info[[cc]]$ts_path) else out_dir + outPath <- file.path(outDirCc, paste0(out_basename, "_chr", cc - 1, ".trees")) + + newTs$dump(outPath) + outPaths[[cc]] <- outPath + cat("Wrote:", outPath, "\n") + } + + invisible(outPaths[nzchar(outPaths)]) +} diff --git a/R/alphaSimR2TsGen.R b/R/alphaSimR2TsGen.R new file mode 100644 index 00000000..576cffff --- /dev/null +++ b/R/alphaSimR2TsGen.R @@ -0,0 +1,140 @@ +morgan2bpRate <- function(m, x0, breaks, rates, side=c("left","right")) { + # turn breaks into Morgan + segLen <- diff(breaks) + mStart <- c(0, cumsum(rates * segLen)) + # position of the 1st SNP in Morgan + i0 <- findInterval(x0, breaks, rightmost.closed = TRUE) + i0 <- pmin(pmax(i0, 1), length(rates)) + mX0 <- mStart[i0] + rates[i0] * (x0 - breaks[i0]) + # recombination breakpoints in Morgan count from the 1st SNP + M <- m + mX0 + i <- findInterval(M, mStart, rightmost.closed = TRUE) + i <- pmin(pmax(i, 1), length(rates)) + # record zero-recombination-rate regions + mEnd <- mStart[-1] + plateau <- (rates[i] == 0) | (mEnd[i] == mStart[i]) + out <- numeric(length(M)) + + # non-zero-recombination-rate regions + ii <- which(!plateau) + if (length(ii) > 0) { + out[ii] <- breaks[i[ii]] + (M[ii] - mStart[i[ii]]) / rates[i[ii]] + } + + # zero-recombination-rate regions + jj <- which(plateau) + if (length(jj) > 0) { + out[jj] <- if (side == "left") breaks[i[jj]] else breaks[i[jj] + 1L] + } + + out + +} + +recHistGenMatToSegDf <- function(histMat, x0, breaks, rates, seqLen) { + + origin <- as.integer(histMat[, 1]) + mStart <- as.numeric(histMat[, 2]) + mNext <- c(mStart[-1], NA_real_) + + left <- morgan2bpRate(mStart, x0, breaks, rates, side="left") + + right <- numeric(length(mStart)) + if (length(mStart) > 1) { + right[1:(length(mStart)-1)] <- morgan2bpRate(mNext[1:(length(mStart)-1)], + x0, breaks, rates, side="right") + } + right[length(mStart)] <- seqLen + left[1] <- 0 + + keep <- right > left + + data.frame( + origin = origin[keep], + left = left[keep], + right = right[keep], + stringsAsFactors = FALSE + ) +} + +recHistGenToSegDfWithParents <- function(SP, offspringPop, chr_info, pos_list) { + childIds <- offspringPop@id + ped <- SP$pedigree[childIds, , drop = FALSE] + + out <- list() + k <- 1 + + for (childId in childIds) { + x <- SP$recHistGen[[childId]] + if (is.null(x) || length(x) == 0L) { + next + } + + motherId <- ped[childId, "mother"] + fatherId <- ped[childId, "father"] + + for (cc in seq_along(x)) { + tc <- RcppTskit::tc_load(chr_info[[cc]]$ts_path) + seqLen <- as.numeric(tc$sequence_length()) + breaks <- chr_info[[cc]]$breaks + rates <- chr_info[[cc]]$rates + + x0 <- pos_list[[cc]][1] + + haps <- as.vector(x[[cc]]) + nHap <- length(haps) + + for (h in seq_len(nHap)) { + seg <- recHistGenMatToSegDf(haps[[h]], x0, breaks, rates, seqLen) + + parentId <- if (h <= nHap/2) motherId else fatherId + + seg$childId <- childId + seg$chr <- cc + seg$hap <- h + seg$parentId <- parentId + + seg$parentHap <- seg$origin + seg$parentGlobalHapId <- (parentId - 1) * nHap + seg$parentHap + + out[[k]] <- seg[, c("childId", "hap", "chr", + "left","right", + "parentId","parentHap","parentGlobalHapId")] + k <- k + 1 + } + } + } + + if (length(out) == 0L) { + return(data.frame( + childId = integer(), + hap = integer(), + chr = integer(), + left = numeric(), + right = numeric(), + parentId = integer(), + parentHap = integer(), + parentGlobalHapId = integer(), + stringsAsFactors = FALSE + )) + } + do.call(rbind, out) +} + +bridgeCollectSegGenFromSimOutput <- function(SP, simOutput, chr_info, pos_list) { + out <- list() + + if (length(simOutput) >= 2L) { + for (k in seq.int(2L, length(simOutput))) { + segDf <- recHistGenToSegDfWithParents( + SP = SP, + offspringPop = simOutput[[k]], + chr_info = chr_info, + pos_list = pos_list + ) + out[[length(out) + 1L]] <- segDf + } + } + + invisible(out) +} diff --git a/R/crossing.R b/R/crossing.R index 32495504..f54c6abc 100644 --- a/R/crossing.R +++ b/R/crossing.R @@ -82,6 +82,14 @@ makeCross = function(pop, crossPlan, nProgeny=1, rep(crossPlan[,2], times=nProgeny)) } + tsForward = .setupTsForwardCross( + simParam = simParam, + crossPlan = crossPlan, + motherIid = pop@iid, + fatherIid = pop@iid, + femaleMap = simParam$femaleMap, + maleMap = simParam$maleMap + ) tmp = cross(pop@geno, crossPlan[,1], pop@geno, @@ -96,7 +104,12 @@ makeCross = function(pop, crossPlan, nProgeny=1, simParam$femaleCentromere, simParam$maleCentromere, simParam$quadProb, - nThreads) + nThreads, + simParam$isTrackRecGen, + tsForward$keepRecHistGen, + tsForward$useTsDirect, + tsForward$returnTsSegGen, + tsForward$directAppendFn) dim(tmp$geno) = NULL # Account for matrix bug in RcppArmadillo @@ -112,17 +125,31 @@ makeCross = function(pop, crossPlan, nProgeny=1, }else{ hist = NULL } - - return(.newPop(rawPop=rPop, - mother=pop@id[crossPlan[,1]], - father=pop@id[crossPlan[,2]], - iMother=pop@iid[crossPlan[,1]], - iFather=pop@iid[crossPlan[,2]], - femaleParentPop=pop, - maleParentPop=pop, - hist=hist, - simParam=simParam, - nThreads=nThreads)) + recGen = .extractTsCrossRecGen(tmp, simParam, tsForward$keepRecHistGen) + histGen = recGen$histGen + tsSegGenRaw = recGen$tsSegGenRaw + outPop = .newPop(rawPop=rPop, + mother=pop@id[crossPlan[,1]], + father=pop@id[crossPlan[,2]], + iMother=pop@iid[crossPlan[,1]], + iFather=pop@iid[crossPlan[,2]], + femaleParentPop=pop, + maleParentPop=pop, + hist=hist, + histGen=histGen, + simParam=simParam, + nThreads=nThreads) + outPop = .finalizeTsForwardCross( + outPop = outPop, + tsSegGenRaw = tsSegGenRaw, + recorderAppended = isTRUE(tsForward$useTsDirect), + childIidPred = tsForward$childIidPred, + femalePop = pop, + malePop = pop, + femaleMap = simParam$femaleMap, + maleMap = simParam$maleMap + ) + return(outPop) } #' @title Make random crosses @@ -421,6 +448,14 @@ makeCross2 = function(females, males, crossPlan, nProgeny=1, simParam=NULL, rep(crossPlan[,2], times=nProgeny)) } + tsForward = .setupTsForwardCross( + simParam = simParam, + crossPlan = crossPlan, + motherIid = females@iid, + fatherIid = males@iid, + femaleMap = simParam$femaleMap, + maleMap = simParam$maleMap + ) tmp=cross(females@geno, crossPlan[,1], males@geno, @@ -435,7 +470,12 @@ makeCross2 = function(females, males, crossPlan, nProgeny=1, simParam=NULL, simParam$femaleCentromere, simParam$maleCentromere, simParam$quadProb, - nThreads) + nThreads, + simParam$isTrackRecGen, + tsForward$keepRecHistGen, + tsForward$useTsDirect, + tsForward$returnTsSegGen, + tsForward$directAppendFn) dim(tmp$geno) = NULL # Account for matrix bug in RcppArmadillo @@ -451,17 +491,31 @@ makeCross2 = function(females, males, crossPlan, nProgeny=1, simParam=NULL, }else{ hist = NULL } - - return(.newPop(rawPop=rPop, - mother=females@id[crossPlan[,1]], - father=males@id[crossPlan[,2]], - iMother=females@iid[crossPlan[,1]], - iFather=males@iid[crossPlan[,2]], - femaleParentPop=females, - maleParentPop=males, - hist=hist, - simParam=simParam, - nThreads=nThreads)) + recGen = .extractTsCrossRecGen(tmp, simParam, tsForward$keepRecHistGen) + histGen = recGen$histGen + tsSegGenRaw = recGen$tsSegGenRaw + outPop = .newPop(rawPop=rPop, + mother=females@id[crossPlan[,1]], + father=males@id[crossPlan[,2]], + iMother=females@iid[crossPlan[,1]], + iFather=males@iid[crossPlan[,2]], + femaleParentPop=females, + maleParentPop=males, + hist=hist, + histGen=histGen, + simParam=simParam, + nThreads=nThreads) + outPop = .finalizeTsForwardCross( + outPop = outPop, + tsSegGenRaw = tsSegGenRaw, + recorderAppended = isTRUE(tsForward$useTsDirect), + childIidPred = tsForward$childIidPred, + femalePop = females, + malePop = males, + femaleMap = simParam$femaleMap, + maleMap = simParam$maleMap + ) + return(outPop) } #' @title Make random crosses @@ -662,6 +716,14 @@ self = function(pop, nProgeny=1, parents=NULL, keepParents=TRUE, crossPlan = cbind(crossPlan,crossPlan) + tsForward = .setupTsForwardCross( + simParam = simParam, + crossPlan = crossPlan, + motherIid = pop@iid, + fatherIid = pop@iid, + femaleMap = simParam$femaleMap, + maleMap = simParam$maleMap + ) tmp = cross(pop@geno, crossPlan[,1], pop@geno, @@ -676,8 +738,13 @@ self = function(pop, nProgeny=1, parents=NULL, keepParents=TRUE, simParam$femaleCentromere, simParam$maleCentromere, simParam$quadProb, - nThreads) - + nThreads, + simParam$isTrackRecGen, + tsForward$keepRecHistGen, + tsForward$useTsDirect, + tsForward$returnTsSegGen, + tsForward$directAppendFn) + dim(tmp$geno) = NULL # Account for matrix bug in RcppArmadillo rPop = new("RawPop", @@ -692,30 +759,36 @@ self = function(pop, nProgeny=1, parents=NULL, keepParents=TRUE, }else{ hist = NULL } - - if(keepParents){ - return(.newPop(rawPop=rPop, - mother=pop@mother[crossPlan[,1]], - father=pop@father[crossPlan[,1]], - iMother=pop@iid[crossPlan[,1]], - iFather=pop@iid[crossPlan[,1]], - femaleParentPop=pop, - maleParentPop=pop, - hist=hist, - simParam=simParam, - nThreads=nThreads)) - }else{ - return(.newPop(rawPop=rPop, - mother=pop@id[crossPlan[,1]], - father=pop@id[crossPlan[,1]], - iMother=pop@iid[crossPlan[,1]], - iFather=pop@iid[crossPlan[,1]], + recGen = .extractTsCrossRecGen(tmp, simParam, tsForward$keepRecHistGen) + histGen = recGen$histGen + tsSegGenRaw = recGen$tsSegGenRaw + parentIdx = crossPlan[,1] + motherVals = if(keepParents) pop@mother[parentIdx] else pop@id[parentIdx] + fatherVals = if(keepParents) pop@father[parentIdx] else pop@id[parentIdx] + iParentVals = pop@iid[parentIdx] + + outPop = .newPop(rawPop=rPop, + mother=motherVals, + father=fatherVals, + iMother=iParentVals, + iFather=iParentVals, femaleParentPop=pop, maleParentPop=pop, hist=hist, + histGen=histGen, simParam=simParam, - nThreads=nThreads)) - } + nThreads=nThreads) + outPop = .finalizeTsForwardCross( + outPop = outPop, + tsSegGenRaw = tsSegGenRaw, + recorderAppended = isTRUE(tsForward$useTsDirect), + childIidPred = tsForward$childIidPred, + femalePop = pop, + malePop = pop, + femaleMap = simParam$femaleMap, + maleMap = simParam$maleMap + ) + return(outPop) } #' @title Generates DH lines diff --git a/R/founderPop.R b/R/founderPop.R index 8055e391..40b36e7f 100644 --- a/R/founderPop.R +++ b/R/founderPop.R @@ -253,12 +253,7 @@ runMacs = function(nInd,nChr=1, segSites=NULL, inbred=FALSE, species="GENERIC", stop("MaCS did not return enough segSites, use segSites=NULL to return all sites generated by MaCS") } - genMap = vector("list",nChr) - for(i in seq_len(nChr)){ - genMap[[i]] = genLen[i]*c(macsOut$genMap[[i]]-macsOut$genMap[[i]][1]) - names(genMap[[i]]) = paste(i,1:length(genMap[[i]]),sep="_") - } - names(genMap) = as.character(1:nChr) + genMap = .runMacsGenMapFromMacs(macsOut$genMap, genLen, manualCommand) output = new("MapPop", nInd=nInd, @@ -272,6 +267,47 @@ runMacs = function(nInd,nChr=1, segSites=NULL, inbred=FALSE, species="GENERIC", return(output) } +.runMacsGenMapFromMacs <- function(macsGenMap, genLen, manualCommand = NULL) { + nChr <- length(macsGenMap) + if (length(genLen) == 1L) { + genLen <- rep(genLen, nChr) + } + if (length(genLen) != nChr) { + stop("genLen must have length 1 or nChr", call. = FALSE) + } + + hotspotPath <- if (is.null(manualCommand)) { + NULL + } else { + .runMacsTS_hotspot_path(manualCommand) + } + recMap <- if (is.null(hotspotPath)) { + NULL + } else { + .runMacsTS_map_from_hotspots( + path = hotspotPath, + nChr = nChr, + seqLen = 1, + genLen = genLen, + usePhysicalPositions = FALSE + ) + } + + genMap <- vector("list", nChr) + for (i in seq_len(nChr)) { + pos <- as.numeric(macsGenMap[[i]]) + if (is.null(recMap)) { + genMap[[i]] <- genLen[[i]] * c(pos - pos[[1L]]) + } else { + genMap[[i]] <- rateMap2cumMorgan(pos, recMap$breaks[[i]], recMap$rates[[i]]) + genMap[[i]] <- genMap[[i]] - genMap[[i]][[1L]] + } + names(genMap[[i]]) <- paste(i, seq_along(genMap[[i]]), sep = "_") + } + names(genMap) <- as.character(seq_len(nChr)) + genMap +} + #' @title Alternative wrapper for MaCS #' #' @description diff --git a/R/importData.R b/R/importData.R index 8393bbed..fbf52b35 100644 --- a/R/importData.R +++ b/R/importData.R @@ -294,3 +294,654 @@ importHaplo = function(haplo, genMap, ploidy=2L, ped=NULL){ return(founderPop) } +#' @title Import VCF haplotypes +#' +#' @description +#' Streams a VCF file and imports phased genotype calls as founder +#' haplotypes. Sites are filtered to biallelic segregating sites, missing +#' genotype calls are filtered or rejected, and optional reservoir sampling is +#' applied independently within each chromosome. +#' +#' @param vcfFile path to a VCF file. Plain text and gzip-compressed files are +#' supported. +#' @param breaks recombination map breakpoints. Supply either a numeric vector +#' used for every chromosome, or a list of numeric vectors with one entry per +#' chromosome. Named lists are matched to VCF chromosome names. +#' @param rates recombination rates for the intervals defined by \code{breaks}. +#' Supply either a numeric vector used for every chromosome, or a list of +#' numeric vectors with one entry per chromosome. Each rates vector must have +#' length \code{length(breaks) - 1}. +#' @param segSites optional number of segregating sites to keep per chromosome. +#' If \code{NULL}, all qualifying sites are retained. A scalar value is used for +#' every chromosome. A vector or list can be supplied per chromosome; named +#' values are matched to VCF chromosome names. +#' @param siteSamplingSeed integer seed used for reservoir sampling. +#' @param ploidy optional ploidy level. If \code{NULL}, ploidy is inferred from +#' the VCF genotype calls and checked for consistency. +#' @param ped an optional pedigree for the supplied genotypes. See details. +#' @param missing how to handle missing genotype calls. Use \code{"filter"} to +#' drop sites with missing calls or \code{"error"} to stop. +#' @param requirePhased if \code{TRUE}, genotype calls with \code{/} separators +#' are rejected. +#' @param useVCFIds if \code{TRUE} and \code{ped} is \code{NULL}, VCF sample IDs +#' are used to return a \code{\link{NamedMapPop-class}}. +#' @param tsRecord if \code{TRUE}, initialize in-memory founder tree-sequence +#' tables from the imported VCF haplotypes and attach metadata for +#' \code{SimParam$setTrackTs(TRUE, founderPop=...)}. +#' @param tsRecorde deprecated alias for \code{tsRecord}. +#' @param addTsMut if \code{TRUE} and \code{tsRecord=TRUE}, add retained VCF +#' sites and allele-1 calls as synthetic tskit site/mutation rows. If +#' \code{FALSE}, initialize only founder individuals and sample nodes, leaving +#' the TS site and mutation tables empty. +#' @param seqLen optional chromosome sequence lengths for \code{tsRecord=TRUE}. +#' Supply either a scalar, vector, or list. Named values are matched to VCF +#' chromosome names. If \code{NULL}, the maximum breakpoint for each chromosome +#' is used. +#' @param returnMeta if \code{TRUE}, return a list containing the population, +#' retained physical positions, sample IDs, and scan statistics. +#' +#' @details +#' The optional pedigree follows the same format as \code{\link{importHaplo}}. +#' If the object is a data.frame or matrix, the first three columns must include +#' id, mother, and father. If the object is a vector, it is assumed to only +#' include the id. In this case, the mother and father will be set to \code{"0"} +#' for all individuals. +#' +#' A site is retained only when it has a single ALT allele, every non-missing +#' genotype allele is coded as 0 or 1, and both alleles are observed in the +#' founder haplotypes. +#' +#' When \code{tsRecord=TRUE} and \code{addTsMut=TRUE}, duplicate retained +#' physical positions within a chromosome are not allowed because tskit requires +#' strictly increasing site positions. +#' +#' @return a \code{\link{MapPop-class}} or \code{\link{NamedMapPop-class}}. If +#' \code{returnMeta = TRUE}, a list with elements \code{pop}, \code{keptPos}, +#' \code{sampleIds}, \code{stats}, and, when \code{tsRecord=TRUE}, +#' \code{tsTables}. +#' +#' @examples +#' \dontrun{ +#' founderPop = importVCF("founders.vcf.gz", +#' breaks=list(c(0, 1e8)), +#' rates=list(c(1e-8)), +#' segSites=1000) +#' +#' # Initialize founder tree-sequence tables for forward recording. +#' founderPopTs = importVCF("founders.vcf.gz", +#' breaks=list(c(0, 1e8)), +#' rates=list(c(1e-8)), +#' segSites=1000, +#' tsRecord=TRUE, +#' addTsMut=FALSE) +#' SP = SimParam$new(founderPopTs) +#' SP$setTrackTs(TRUE, founderPop=founderPopTs) +#' } +#' +#' @export +importVCF = function(vcfFile, breaks, rates, segSites=NULL, + siteSamplingSeed=42L, ploidy=NULL, ped=NULL, + missing=c("filter", "error"), requirePhased=TRUE, + useVCFIds=TRUE, tsRecord=FALSE, tsRecorde=NULL, + addTsMut=TRUE, seqLen=NULL, + returnMeta=FALSE){ + missing = match.arg(missing) + requirePhased = isTRUE(requirePhased) + useVCFIds = isTRUE(useVCFIds) + if(!is.null(tsRecorde)){ + tsRecord = tsRecorde + } + tsRecord = isTRUE(tsRecord) + addTsMut = isTRUE(addTsMut) + returnMeta = isTRUE(returnMeta) + if(!is.null(ploidy)){ + ploidy = as.integer(ploidy) + if(length(ploidy)!=1L || is.na(ploidy) || ploidy<1L){ + stop("`ploidy` must be NULL or a single positive integer.", + call.=FALSE) + } + } + + vcfData = .sampleVcfVariants(vcfFile=vcfFile, + segSites=segSites, + seed=siteSamplingSeed, + ploidy=ploidy, + requirePhased=requirePhased, + missing=missing) + + mapData = .vcfBuildMapData(chrData=vcfData$chrData, + breaks=breaks, + rates=rates, + seqLen=seqLen) + genMap = mapData$genMap + haplotypes = lapply(vcfData$chrData, `[[`, "H") + + founderPop = newMapPop(genMap=genMap, + haplotypes=haplotypes, + ploidy=vcfData$ploidy, + inbred=FALSE) + + founderPop = .vcfAddPed(founderPop=founderPop, + ped=ped, + sampleIds=vcfData$sampleIds, + useVCFIds=useVCFIds) + + tsTables = NULL + if(tsRecord){ + tsTables = .vcfBuildFounderTables(chrData=vcfData$chrData, + seqLenList=mapData$seqLenList, + ploidy=vcfData$ploidy, + addTsMut=addTsMut) + attr(founderPop, "tsForwardSource") = lapply(tsTables, function(x){ + list(tc_xptr=x) + }) + attr(founderPop, "tsForwardPosMeta") = list( + posList=lapply(vcfData$chrData, `[[`, "P"), + seqLenList=mapData$seqLenList, + breaksList=mapData$breaksList, + ratesList=mapData$ratesList + ) + } + + if(returnMeta){ + out = list(pop=founderPop, + keptPos=lapply(vcfData$chrData, `[[`, "P"), + sampleIds=vcfData$sampleIds, + stats=vcfData$stats) + if(tsRecord){ + out$tsTables = tsTables + } + return(out) + } + return(founderPop) +} + +#' @keywords internal +#' @noRd +.sampleVcfVariants = function(vcfFile, segSites, seed, ploidy, + requirePhased, missing){ + if(!file.exists(vcfFile)){ + stop("VCF file does not exist: ", vcfFile, call.=FALSE) + } + + oldSeedExists = exists(".Random.seed", envir=.GlobalEnv, inherits=FALSE) + if(oldSeedExists){ + oldSeed = get(".Random.seed", envir=.GlobalEnv, inherits=FALSE) + } + on.exit({ + if(oldSeedExists){ + assign(".Random.seed", oldSeed, envir=.GlobalEnv) + }else if(exists(".Random.seed", envir=.GlobalEnv, inherits=FALSE)){ + rm(".Random.seed", envir=.GlobalEnv) + } + }, add=TRUE) + set.seed(as.integer(seed)) + + con = .vcfOpen(vcfFile) + on.exit(close(con), add=TRUE) + + sampleIds = NULL + chrData = list() + chrOrder = character() + currentPloidy = ploidy + stats = list(records=0L, + qualifying=0L, + skippedNonBiallelic=0L, + skippedMissing=0L, + skippedInvalidAllele=0L, + skippedNonSegregating=0L) + + repeat{ + lines = readLines(con, n=10000L, warn=FALSE) + if(length(lines)==0L){ + break + } + for(line in lines){ + if(startsWith(line, "##")){ + next + } + if(startsWith(line, "#CHROM")){ + header = strsplit(line, "\t", fixed=TRUE)[[1]] + if(length(header)<10L){ + stop("VCF header must contain sample genotype columns.", + call.=FALSE) + } + sampleIds = header[-seq_len(9L)] + if(any(sampleIds=="") || any(duplicated(sampleIds))){ + stop("VCF sample IDs must be non-empty and unique.", + call.=FALSE) + } + next + } + if(is.null(sampleIds)){ + stop("VCF header line beginning with #CHROM was not found.", + call.=FALSE) + } + if(startsWith(line, "#")){ + next + } + + fields = strsplit(line, "\t", fixed=TRUE)[[1]] + if(length(fields)<(9L+length(sampleIds))){ + stop("Malformed VCF record with too few columns.", call.=FALSE) + } + stats$records = stats$records + 1L + + chr = as.character(fields[[1L]]) + pos = as.numeric(fields[[2L]]) + id = fields[[3L]] + alt = fields[[5L]] + + if(is.na(pos) || alt=="." || grepl(",", alt, fixed=TRUE)){ + stats$skippedNonBiallelic = stats$skippedNonBiallelic + 1L + next + } + + gt = .vcfParseGt(sampleFields=fields[-seq_len(9L)], + formatField=fields[[9L]], + sampleIds=sampleIds, + ploidy=currentPloidy, + requirePhased=requirePhased, + missing=missing, + chr=chr, + pos=pos) + + if(gt$status=="missing"){ + stats$skippedMissing = stats$skippedMissing + 1L + next + } + if(gt$status=="invalidAllele"){ + stats$skippedInvalidAllele = stats$skippedInvalidAllele + 1L + next + } + if(is.null(currentPloidy)){ + currentPloidy = gt$ploidy + } + if(length(unique(gt$haplo))<2L){ + stats$skippedNonSegregating = stats$skippedNonSegregating + 1L + next + } + + if(!chr%in%chrOrder){ + chrOrder = c(chrOrder, chr) + target = .vcfSegSitesForChr(segSites=segSites, + chr=chr, + chrIndex=length(chrOrder)) + chrData[[chr]] = .vcfNewReservoir(nHaplo=length(gt$haplo), + target=target) + } + + markerName = if(id=="." || id==""){ + paste(chr, format(pos, scientific=FALSE, trim=TRUE), sep="_") + }else{ + id + } + chrData[[chr]] = .vcfReservoirAdd(res=chrData[[chr]], + haplo=gt$haplo, + pos=pos, + markerName=markerName) + stats$qualifying = stats$qualifying + 1L + } + } + + if(is.null(sampleIds)){ + stop("VCF header line beginning with #CHROM was not found.", + call.=FALSE) + } + if(length(chrData)==0L){ + stop("No qualifying biallelic segregating sites were found.", + call.=FALSE) + } + chrData = chrData[chrOrder] + chrData = lapply(names(chrData), function(chr){ + .vcfFinalizeReservoir(res=chrData[[chr]], chr=chr) + }) + names(chrData) = chrOrder + + stats$kept = sum(vapply(chrData, function(x) ncol(x$H), integer(1))) + stats$keptByChr = vapply(chrData, function(x) ncol(x$H), integer(1)) + + return(list(chrData=chrData, + sampleIds=sampleIds, + ploidy=currentPloidy, + stats=stats)) +} + +#' @keywords internal +#' @noRd +.vcfOpen = function(vcfFile){ + if(grepl("\\.gz$", vcfFile, ignore.case=TRUE)){ + con = gzfile(vcfFile, open="rt") + }else{ + con = file(vcfFile, open="rt") + } + return(con) +} + +#' @keywords internal +#' @noRd +.vcfParseGt = function(sampleFields, formatField, sampleIds, ploidy, + requirePhased, missing, chr, pos){ + formatFields = strsplit(formatField, ":", fixed=TRUE)[[1]] + gtIndex = match("GT", formatFields) + if(is.na(gtIndex)){ + stop("VCF FORMAT field does not contain GT.", call.=FALSE) + } + + gt = vapply(sampleFields, function(x){ + value = strsplit(x, ":", fixed=TRUE)[[1]] + if(length(value)seqLen)){ + stop("Cannot initialize TS tables from VCF: retained positions on ", + "chromosome ", names(chrData)[[i]], " exceed `seqLen`.", + call.=FALSE) + } + haplo = matrix(as.integer(chrData[[i]]$H), + nrow=nrow(chrData[[i]]$H)) + out[[i]] = vcfFounderTableCollection(haplo=haplo, + pos=pos, + seqLen=seqLen, + ploidy=as.integer(ploidy), + addTsMut=addTsMut) + } + return(out) +} + +#' @keywords internal +#' @noRd +.vcfAddPed = function(founderPop, ped, sampleIds, useVCFIds){ + if(is.null(ped)){ + if(!useVCFIds){ + return(founderPop) + } + id = as.character(sampleIds) + mother = father = rep("0", length(id)) + }else if(is.atomic(ped) && is.vector(ped)){ + id = as.character(ped) + mother = father = rep("0", length(id)) + }else{ + id = as.character(ped[,1]) + mother = as.character(ped[,2]) + father = as.character(ped[,3]) + } + stopifnot(length(id)==founderPop@nInd, + !any(duplicated(id))) + founderPop = new("NamedMapPop", + id=id, + mother=mother, + father=father, + founderPop) + return(founderPop) +} diff --git a/R/makeFoundersFromTs.R b/R/makeFoundersFromTs.R new file mode 100644 index 00000000..1f314c3b --- /dev/null +++ b/R/makeFoundersFromTs.R @@ -0,0 +1,663 @@ +#' Sample Biallelic Variants from a Tree Sequence +#' +#' @param ts A `RcppTskit::TreeSequence` object. +#' @param segSites Integer number of biallelic variants to sample. +#' @param seed Integer random seed for reservoir sampling. +#' +#' @return A list with `H` (haplotypes matrix; rows are samples) and +#' `P` (numeric vector of site positions). +#' @keywords internal +#' @noRd +sample_segregating_variants <- function(ts, segSites, seed) { + + # Sample segregating variants from the tree sequence. + # + # Parameters + # ========== + # ts: tskit.TreeSequence + # The tree sequence to sample from. + # segSites: int + # The number of segregating sites to sample. + # seed: int + # The random seed to use for sampling. + # + # Returns + # ======= + # list of int + # The positions of the sampled segregating sites. + # Set the random seed for reproducibility. + set.seed(seed) + num_samples <- as.integer(ts$num_samples()) + + # 2. Pre-allocate H matrix and P vector based on required sample size (segSites) + # We only need space for 'segSites' number of variants + H <- matrix(NA_integer_, nrow = num_samples, ncol = segSites) + P <- numeric(segSites) + + it <- ts$variants() + + # k tracks how many biallelic variants we have encountered so far + k <- 0 + # current_size tracks how many variants are currently in our reservoir + current_size <- 0 + # 3. Iterate through variants + repeat { + v <- it$next_variant() + if (is.null(v)) break + + g <- v$genotypes + + # Filter for biallelic sites + if (length(unique(g)) == 2) { + k <- k + 1 + + if (current_size < segSites) { + # Case A: Reservoir is not full yet + current_size <- current_size + 1 + H[, current_size] <- g + P[current_size] <- v$position + } else { + # Case B: Reservoir is full, use Prob. entry: j/k + # sample.int(k, 1) returns a value from 1 to k + j <- sample.int(k, 1) + + if (j <= segSites) { + # Replace the existing variant at index j + H[, j] <- g + P[j] <- v$position + } + } + } + } + + # 4. Final check: if we found fewer biallelic sites than segSites, trim the output + if (k < segSites) { + if (k > 0) { + H <- H[, 1:k, drop = FALSE] + P <- P[1:k] + } else { + H <- matrix(nrow = num_samples, ncol = 0) + P <- numeric(0) + } + } + + return(list(H = H, P = P)) +} + + +#' Extract All Biallelic Variants from a Tree Sequence +#' +#' @param ts A `RcppTskit::TreeSequence` object. +#' @param debug Logical; if `TRUE`, print diagnostics while scanning variants. +#' +#' @return A list with `H` (haplotypes matrix; rows are samples) and +#' `P` (numeric vector of site positions). +#' @keywords internal +#' @noRd +segregating_variants <- function(ts, debug = FALSE) { + # 1. Get dimensions for pre-allocation + max_sites <- as.integer(ts$num_sites()) + num_samples <- as.integer(ts$num_samples()) + if (debug) { + message("Expected max sites: ", max_sites) + message("Expected num samples (from ts): ", num_samples) + } + + # 2. Pre-allocate H matrix (Rows: samples, Cols: sites) + # Using integer matrix to save memory (similar to np.int8) + H_full <- matrix(NA_integer_, nrow = num_samples, ncol = max_sites) + # Pre-allocate P vector for positions + P_full <- numeric(max_sites) + + it <- ts$variants() + count <- 0 + + # 3. Iterate through variants + repeat { + v <- it$next_variant() + if (is.null(v)) break + + g <- v$genotypes + if (debug && count == 0L) { + message("Actual length of genotype vector (g): ", length(g)) + message("Matrix H_full has ", nrow(H_full), " rows") + if (length(g) != nrow(H_full)) { + stop("DIMENSION MISMATCH: The genotype vector length does not match matrix rows!") + } + } + + # Filter for biallelic sites (exactly 2 unique alleles) + if (length(unique(g)) == 2) { + count <- count + 1 + if (debug && count > max_sites) { + stop("INDEX OVERFLOW: count (", count, ") exceeded max_sites (", max_sites, ")") + } + # Fill the matrix column directly + H_full[, count] <- g + P_full[count] <- v$position + } + } + + # 4. Trim the results to the actual number of kept variants + if (count > 0) { + H <- H_full[, 1:count, drop = FALSE] + P <- P_full[1:count] + } else { + H <- matrix(nrow = num_samples, ncol = 0) + P <- numeric(0) + } + if (debug) { + message("Success! Final count of biallelic variants: ", count) + } + + return(list(H = H, P = P)) +} + +#' Convert Physical Positions to Cumulative Morgan Positions +#' +#' @param x Numeric vector of physical positions. +#' @param breaks Numeric vector of recombination map breakpoints. +#' @param rates Numeric vector of per-bp recombination rates for each interval. +#' +#' @return Numeric vector of cumulative Morgan positions. +#' @keywords internal +#' @noRd +rateMap2cumMorgan <- function(x, breaks, rates) { + stopifnot(length(breaks) == length(rates) + 1) + + o <- order(breaks) + breaks <- breaks[o] + + # M_i = m(breaks[i]) + seg_len <- diff(breaks) + M_start <- c(0, cumsum(rates * seg_len)) # length = length(breaks) + + i <- findInterval(x, breaks, rightmost.closed = FALSE) + i <- pmin(pmax(i, 1), length(rates)) + + m <- M_start[i] + rates[i] * (x - breaks[i]) + return(m) +} + + +#' Load Tree Sequence from Supported Sources +#' +#' @param ts_path Character path to a `.trees` file. +#' @param ts Optional `TreeSequence` object or external pointer. +#' @param ts_xptr Optional external pointer to `tsk_treeseq_t`. +#' @param tc_xptr Optional external pointer to `tsk_table_collection_t`. +#' @param table_xptr Alias for `tc_xptr`. +#' +#' @return A `RcppTskit::TreeSequence` object. +#' @keywords internal +#' @noRd +asMapPop_load_ts <- function(ts_path = NULL, ts = NULL, ts_xptr = NULL, + tc_xptr = NULL, table_xptr = NULL) { + if (!is.null(ts)) { + if (inherits(ts, "externalptr")) { + try_ts <- try(RcppTskit::TreeSequence$new(xptr = ts), silent = TRUE) + if (!inherits(try_ts, "try-error")) { + return(try_ts) + } + tc <- RcppTskit::TableCollection$new(xptr = ts) + return(tc$tree_sequence()) + } + return(ts) + } + if (!is.null(ts_xptr)) { + return(RcppTskit::TreeSequence$new(xptr = ts_xptr)) + } + tc_ptr <- if (!is.null(tc_xptr)) tc_xptr else table_xptr + if (!is.null(tc_ptr)) { + tc <- RcppTskit::TableCollection$new(xptr = tc_ptr) + return(tc$tree_sequence()) + } + if (!is.null(ts_path)) { + return(RcppTskit::ts_load(ts_path)) + } + stop("No tree-sequence source provided. Provide one of ts_path, ts, ts_xptr, tc_xptr, or table_xptr.") +} + +#' Convert One Chromosome Tree Sequence to Map/Haplotypes +#' +#' @param ts_path Character path to `.trees` file (optional). +#' @param breaks Numeric vector of recombination map breakpoints. +#' @param rates Numeric vector of per-bp recombination rates. +#' @param segSites Optional integer number of biallelic variants to keep. +#' @param site_sampling_seed Integer seed for site sampling. +#' @param ts Optional in-memory tree sequence object. +#' @param ts_xptr Optional tree-sequence external pointer. +#' @param tc_xptr Optional table-collection external pointer. +#' @param table_xptr Alias for `tc_xptr`. +#' +#' @return A list with `genMap`, `haplotypes`, and `keptPosBp`. +#' @keywords internal +#' @noRd +ts2chrData <- function(ts_path = NULL, breaks, rates, segSites, site_sampling_seed, + ts = NULL, ts_xptr = NULL, tc_xptr = NULL, table_xptr = NULL) { + ts <- asMapPop_load_ts( + ts_path = ts_path, + ts = ts, + ts_xptr = ts_xptr, + tc_xptr = tc_xptr, + table_xptr = table_xptr + ) + seqLen <- as.numeric(ts$sequence_length()) + num_pos <- ts$num_sites() + + if (!is.null(segSites)) { + + if (num_pos < segSites) { + stop("Insufficient sites (only ", num_pos, " sites in the tree sequence).") + } + message(segSites, " variants sampled ", "(Random seed: ", site_sampling_seed, ")") + out <- sample_segregating_variants(ts, segSites, site_sampling_seed) + + if (length(out[[2]]) < segSites) { + stop("Insufficient sites (only ", length(out[[2]]), " sites after filtering non-biallelic sites).") + } + } + else { + out <- segregating_variants(ts) + } + + H <- out[[1]] + pos <- out[[2]] + + ord <- order(pos) + pos <- pos[ord] + H <- H[, ord, drop = FALSE] + mpos <- rateMap2cumMorgan(pos, breaks, rates) + + # relative position, so the 1st element is 0 + mpos <- mpos - min(mpos) + + list( + genMap = list(mpos), + haplotypes = list(H), + keptPosBp = pos, + seqLen = seqLen + ) +} + +#' Expand Recombination Component to Per-Chromosome List +#' +#' @param x Scalar/list recombination component (`breaks` or `rates`). +#' @param nChr Integer number of chromosomes. +#' @param name Character label for error messages. +#' +#' @return A list of length `nChr`. +#' @keywords internal +#' @noRd +.asMapPop_expand_rec_component <- function(x, nChr, name) { + if (is.null(x)) { + stop("Missing `", name, "` for asMapPop input.") + } + values <- if (is.list(x)) x else list(x) + if (length(values) == 1L) { + return(rep(values, nChr)) + } + if (length(values) != nChr) { + stop("`", name, "` must have length 1 or nChr.") + } + values +} + +#' Extract First Non-NULL Alias from a Named List +#' +#' @param x Named list. +#' @param keys Character vector of alias keys to try in order. +#' +#' @return First non-`NULL` component found, or `NULL`. +#' @keywords internal +#' @noRd +.asMapPop_extract_component <- function(x, keys) { + for (k in keys) { + if (!is.null(x[[k]])) { + return(x[[k]]) + } + } + NULL +} + +#' Safely Get Exact Named Component +#' +#' @param x Named list. +#' @param key Character scalar key. +#' +#' @return Value for `key` or `NULL` if absent. +#' @keywords internal +#' @noRd +.asMapPop_get <- function(x, key) { + if (!is.list(x) || is.null(names(x))) { + return(NULL) + } + if (!(key %in% names(x))) { + return(NULL) + } + x[[key]] +} + +#' Expand segSites to Per-Chromosome Specification +#' +#' @param segSites Optional scalar/vector/list of site counts. +#' @param nChr Integer number of chromosomes. +#' @param defaults Optional fallback segSites specification. +#' +#' @return List of length `nChr` with integer values or `NULL`. +#' @keywords internal +#' @noRd +.asMapPop_expand_seg_sites <- function(segSites, nChr, defaults = NULL) { + if (is.null(segSites)) { + values <- defaults + } else { + values <- segSites + } + if (is.null(values)) { + return(rep(list(NULL), nChr)) + } + if (!is.list(values)) { + values <- as.list(as.integer(values)) + } + if (length(values) == 1L) { + values <- rep(values, nChr) + } else if (length(values) != nChr) { + stop("`segSites` must have length 1 or nChr.") + } + lapply(values, function(x) { + if (is.null(x) || length(x) == 0) { + return(NULL) + } + x <- as.integer(x[1]) + if (is.na(x) || x <= 0L) { + return(NULL) + } + x + }) +} + +#' Check Whether an Entry Looks Like Chromosome TS Specification +#' +#' @param x List candidate chromosome specification. +#' +#' @return Logical scalar. +#' @keywords internal +#' @noRd +.asMapPop_is_chr_info <- function(x) { + is.list(x) && ( + !is.null(x$ts_path) || + !is.null(x$ts) || + !is.null(x$ts_xptr) || + !is.null(x$tc_xptr) || + !is.null(x$table_xptr) + ) +} + +#' Normalize asMapPop Inputs to Per-Chromosome Specs +#' +#' @param chr_info Either explicit per-chromosome list or bundle style input +#' containing `tables`/`ts` and map metadata. +#' @param segSites Optional override for per-chromosome site counts. +#' +#' @return A normalized list of per-chromosome specs. +#' @keywords internal +#' @noRd +.asMapPop_prepare_specs <- function(chr_info, segSites = NULL) { + if (!is.list(chr_info)) { + stop("`chr_info` must be a list.") + } + + root_info <- chr_info + if (!is.null(chr_info$chr_info)) { + chr_info <- chr_info$chr_info + } + + is_explicit_chr_info <- length(chr_info) > 0 && + all(vapply(chr_info, .asMapPop_is_chr_info, logical(1))) + + if (is_explicit_chr_info) { + nChr <- length(chr_info) + default_seg <- lapply(chr_info, function(x) x$segSites) + seg_by_chr <- .asMapPop_expand_seg_sites(segSites, nChr, defaults = default_seg) + root_breaks <- .asMapPop_extract_component(root_info, c("breaks", "rec_breaks", "recBreaks")) + root_rates <- .asMapPop_extract_component(root_info, c("rates", "rec_rates", "recRates")) + if (!is.null(root_breaks)) { + root_breaks <- .asMapPop_expand_rec_component(root_breaks, nChr, "breaks") + } + if (!is.null(root_rates)) { + root_rates <- .asMapPop_expand_rec_component(root_rates, nChr, "rates") + } + out <- vector("list", nChr) + for (i in seq_len(nChr)) { + info <- chr_info[[i]] + if (is.null(info$breaks) && !is.null(root_breaks)) { + info$breaks <- root_breaks[[i]] + } + if (is.null(info$rates) && !is.null(root_rates)) { + info$rates <- root_rates[[i]] + } + if (is.null(info$breaks) || is.null(info$rates)) { + stop("Each chromosome entry must include `breaks` and `rates`.") + } + info$segSites <- seg_by_chr[[i]] + out[[i]] <- info + } + return(out) + } + + tables <- .asMapPop_extract_component(chr_info, c("tables", "table_collections")) + ts_list <- .asMapPop_extract_component(chr_info, c("ts", "tree_sequences")) + if (is.null(tables) && is.null(ts_list)) { + stop("Unsupported `chr_info` format. Provide a list of chromosome specs or a bundle with `tables`/`ts`.") + } + if (!is.null(tables) && !is.list(tables)) { + stop("`tables` must be a list.") + } + if (!is.null(ts_list) && !is.list(ts_list)) { + stop("`ts` must be a list.") + } + + if (!is.null(tables)) { + nChr <- length(tables) + } else { + nChr <- length(ts_list) + } + if (!is.null(tables) && !is.null(ts_list) && length(ts_list) != nChr) { + stop("`tables` and `ts` must have the same length when both are supplied.") + } + + breaks <- .asMapPop_expand_rec_component( + .asMapPop_extract_component(chr_info, c("breaks", "rec_breaks", "recBreaks")), + nChr, "breaks" + ) + rates <- .asMapPop_expand_rec_component( + .asMapPop_extract_component(chr_info, c("rates", "rec_rates", "recRates")), + nChr, "rates" + ) + default_seg <- .asMapPop_extract_component(chr_info, c("segSites", "seg_sites")) + seg_by_chr <- .asMapPop_expand_seg_sites(segSites, nChr, defaults = default_seg) + + out <- vector("list", nChr) + for (i in seq_len(nChr)) { + out[[i]] <- list( + ts = if (!is.null(ts_list)) ts_list[[i]] else NULL, + tc_xptr = if (!is.null(tables)) tables[[i]] else NULL, + breaks = breaks[[i]], + rates = rates[[i]], + segSites = seg_by_chr[[i]] + ) + } + out +} + +#' Resolve and Validate Thread Count for asMapPop +#' +#' @param nThreads Optional requested thread count. +#' +#' @return Integer thread count >= 1. +#' @keywords internal +#' @noRd +.asMapPop_get_num_threads <- function(nThreads) { + if (is.null(nThreads)) { + if (exists("getNumThreads", mode = "function")) { + nThreads <- getNumThreads() + } else { + nThreads <- 1L + } + } + nThreads <- as.integer(nThreads) + if (length(nThreads) != 1L || is.na(nThreads) || nThreads < 1L) { + stop("`nThreads` must be a single positive integer.") + } + nThreads +} + +#' Apply Chromosome Worker with Optional Parallelism +#' +#' @param chr_specs Normalized per-chromosome specs. +#' @param worker Function applied to each chromosome spec. +#' @param nThreads Integer requested threads. +#' +#' @return List of worker outputs. +#' @keywords internal +#' @noRd +.asMapPop_apply <- function(chr_specs, worker, nThreads) { + if (length(chr_specs) <= 1L || nThreads <= 1L) { + return(lapply(chr_specs, worker)) + } + has_non_file_source <- any(vapply(chr_specs, function(x) { + is.null(x$ts_path) + }, logical(1))) + if (has_non_file_source) { + warning( + "asMapPop: parallel conversion currently uses file-backed TS only. ", + "Falling back to serial for in-memory TS/tables.", + call. = FALSE + ) + return(lapply(chr_specs, worker)) + } + if (.Platform$OS.type == "unix") { + return(parallel::mclapply(chr_specs, worker, mc.cores = nThreads)) + } + warning( + "asMapPop: parallel conversion is only enabled on unix via mclapply. ", + "Falling back to serial on this platform.", + call. = FALSE + ) + lapply(chr_specs, worker) +} + +.asMapPop_ts_source_from_spec <- function(info) { + out <- list( + ts_path = .asMapPop_get(info, "ts_path"), + ts = .asMapPop_get(info, "ts"), + ts_xptr = .asMapPop_get(info, "ts_xptr"), + tc_xptr = .asMapPop_get(info, "tc_xptr"), + table_xptr = .asMapPop_get(info, "table_xptr") + ) + has_source <- vapply(out, function(x) !is.null(x), logical(1)) + out[has_source] +} + +#' Build a MapPop from Tree Sequence Data +#' +#' @description +#' Converts one or more tree sequences to an AlphaSimR +#' \code{\link{MapPop-class}} by extracting biallelic segregating variants and +#' mapping tree-sequence coordinates through a recombination map. The resulting +#' population keeps the metadata needed for forward tree-sequence recording. +#' +#' @param chr_info Input tree-sequence data. Supports either: +#' 1) explicit per-chromosome list entries with \code{ts_path}, +#' \code{ts}, or \code{tc_xptr} plus \code{breaks} and \code{rates}; or +#' 2) bundle style list containing \code{tables} or \code{ts} plus map +#' metadata. +#' @param ploidy Integer ploidy used to construct the resulting +#' \code{\link{MapPop-class}}. +#' @param inbred Logical; whether resulting individuals are inbred. +#' @param segSites Optional site-count override (scalar or per chromosome). +#' @param site_sampling_seed Integer seed used when downsampling segregating sites. +#' @param nThreads Optional chromosome-level worker count. +#' @param returnMeta Logical; if \code{TRUE}, return list with \code{pop}, +#' \code{keptPosBp}, and \code{chrData}; otherwise return +#' \code{\link{MapPop-class}} only. +#' +#' @details +#' Each chromosome must provide tree-sequence input and a recombination map. +#' The map is supplied as \code{breaks} and \code{rates}, where +#' \code{breaks} are tree-sequence coordinate breakpoints and \code{rates} are +#' recombination rates for the corresponding intervals. The physical or +#' tree-sequence coordinates of retained variants are stored on the returned +#' population as \code{tsForwardPosMeta}. +#' +#' If \code{segSites} is supplied, biallelic segregating variants are sampled +#' with reservoir sampling using \code{site_sampling_seed}. Non-biallelic and +#' non-segregating variants are ignored. +#' +#' @return A \code{\link{MapPop-class}} object, or metadata list if +#' \code{returnMeta = TRUE}. +#' +#' @examples +#' \dontrun{ +#' chr_info = list(list( +#' ts_path="dev/testData/msprime_chr0.trees", +#' breaks=c(0, 1), +#' rates=c(1) +#' )) +#' founderPop = asMapPop(chr_info=chr_info, ploidy=2L) +#' } +#' +#' @export +asMapPop <- function(chr_info, ploidy = 2L, inbred = FALSE, segSites = NULL, + site_sampling_seed = 42L, nThreads = NULL, + returnMeta = FALSE) { + ploidy <- as.integer(ploidy) + nThreads <- .asMapPop_get_num_threads(nThreads) + chr_specs <- .asMapPop_prepare_specs(chr_info, segSites = segSites) + + worker <- function(info) { + ts2chrData( + ts_path = .asMapPop_get(info, "ts_path"), + ts = .asMapPop_get(info, "ts"), + ts_xptr = .asMapPop_get(info, "ts_xptr"), + tc_xptr = .asMapPop_get(info, "tc_xptr"), + table_xptr = .asMapPop_get(info, "table_xptr"), + breaks = .asMapPop_get(info, "breaks"), + rates = .asMapPop_get(info, "rates"), + segSites = .asMapPop_get(info, "segSites"), + site_sampling_seed = site_sampling_seed + ) + } + + chr_data <- .asMapPop_apply(chr_specs, worker, nThreads = nThreads) + + # save pos in bp for tskit tables + chrKeptPosBp <- lapply(chr_data, `[[`, "keptPosBp") + chrSeqLenBp <- lapply(chr_data, `[[`, "seqLen") + chrKeptPosBpList <<- chrKeptPosBp + chrSeqLenBpList <<- chrSeqLenBp + # generic aliases: positions are in tree-sequence coordinate space + # (bp when physical positions are used, otherwise normalized coordinates) + chrKeptPosTsList <<- chrKeptPosBp + chrSeqLenTsList <<- chrSeqLenBp + + genMap <- do.call(c, lapply(chr_data, `[[`, "genMap")) + haplotypes <- do.call(c, lapply(chr_data, `[[`, "haplotypes")) + + pop <- newMapPop(genMap = genMap, haplotypes = haplotypes, inbred = inbred, ploidy = ploidy) + attr(pop, "tsForwardSource") <- lapply(chr_specs, .asMapPop_ts_source_from_spec) + attr(pop, "tsForwardPosMeta") <- list( + posList = chrKeptPosBp, + seqLenList = chrSeqLenBp, + breaksList = lapply(chr_specs, function(x) as.numeric(.asMapPop_get(x, "breaks"))), + ratesList = lapply(chr_specs, function(x) as.numeric(.asMapPop_get(x, "rates"))) + ) + if (isTRUE(returnMeta)) { + return(list( + pop = pop, + keptPosBp = chrKeptPosBp, + chrData = chr_data + )) + } + pop +} diff --git a/R/runMacsTs.R b/R/runMacsTs.R new file mode 100644 index 00000000..a3cb45a2 --- /dev/null +++ b/R/runMacsTs.R @@ -0,0 +1,699 @@ +#' Parse Scaled Mutation Rate (`dTheta`) from a MaCS Argument String +#' +#' @param args Character scalar MaCS command string with sample size and +#' sequence length as the first two tokens. +#' +#' @return Numeric scalar `dTheta` used by MaCS-style mutation placement. +#' @keywords internal +#' @noRd +.simAnc_parse_dTheta <- function(args) { + tokens <- strsplit(as.character(args), "[,[:space:]]+", perl = TRUE)[[1L]] + tokens <- tokens[nzchar(tokens)] + if (length(tokens) < 2L) { + stop("args must contain at least sample size and sequence length") + } + seqLen <- suppressWarnings(as.numeric(tokens[2L])) + if (!is.finite(seqLen) || seqLen <= 0) { + stop("Failed to parse sequence length from args") + } + idx <- match("-t", tokens) + if (is.na(idx) || idx >= length(tokens)) { + return(0) + } + thetaScaled <- suppressWarnings(as.numeric(tokens[idx + 1L])) + if (!is.finite(thetaScaled) || thetaScaled < 0) { + stop("Failed to parse -t value from args") + } + seqLen * thetaScaled +} + +#' Simulate MaCS Ancestry as Tree-Sequence Tables +#' +#' @description +#' Runs the MaCS ancestry simulation path and returns one tskit table collection +#' per chromosome, without adding post-ancestry mutations. This is the staged +#' ancestry step used by \code{\link{runMacsTS}}. +#' +#' @param args Character MaCS command prefix with trailing \code{-s}. +#' @param nChr Integer number of chromosomes. +#' @param inbred Logical. +#' @param ploidy Integer ploidy. +#' @param nThreads Integer thread count. +#' @param seed Integer vector of chromosome seeds. +#' @param usePhysicalPositions Logical; use bp positions in TS if \code{TRUE}. +#' @param Nref Optional numeric reference \code{Ne} for time scaling. +#' +#' @details +#' This function is useful when ancestry simulation and mutation placement need +#' to be controlled separately. For the standard founder-population workflow, +#' use \code{\link{runMacsTS}}. +#' +#' @return List with ancestry table collections and metadata. +#' +#' @examples +#' \dontrun{ +#' cmd = runMacs2(nInd=10, nChr=1, segSites=NULL, returnCommand=TRUE) +#' anc = simAnc(args=paste0(20, " ", cmd, " -s "), +#' nChr=1, inbred=FALSE, ploidy=2L, +#' nThreads=1L, seed=123L) +#' } +#' +#' @export +simAnc <- function(args, nChr, inbred, ploidy, nThreads, seed, + usePhysicalPositions = FALSE, Nref = NA_real_) { + nChr <- as.integer(nChr) + if (length(nChr) != 1L || is.na(nChr) || nChr <= 0L) { + stop("nChr must be a positive integer scalar") + } + anc <- MaCSTS( + args = args, + nChr = nChr, + inbred = inbred, + ploidy = ploidy, + nThreads = nThreads, + seed = seed, + usePhysicalPositions = usePhysicalPositions, + useMacsMut = FALSE, + Nref = Nref, + expandInbredSamples = FALSE + ) + anc$dTheta <- .simAnc_parse_dTheta(args) + anc$seed <- as.integer(seed) + anc$ploidy <- as.integer(ploidy) + anc$inbred <- isTRUE(inbred) + anc$stage <- "simAnc" + anc +} + +#' Add Mutations to Ancestry Tree-Sequence Tables +#' +#' @description +#' Adds MaCS-style mutations to table collections returned by +#' \code{\link{simAnc}}. This is the staged mutation step used by +#' \code{\link{runMacsTS}} when \code{mutationMode = "postTs"}. +#' +#' @param x List returned by \code{\link{simAnc}}, or a list of +#' table-collection pointers. +#' @param dTheta Optional scalar/vector mutation-rate parameter in MaCS units. +#' @param seed Optional scalar/vector integer seeds for mutation sampling. +#' +#' @details +#' If \code{dTheta} is omitted and \code{x} is the full list returned by +#' \code{\link{simAnc}}, the mutation-rate metadata stored by \code{simAnc()} is +#' used. If \code{seed} is omitted, mutation seeds are derived from the ancestry +#' seeds when available. +#' +#' @return List with mutated table collections and metadata. +#' +#' @examples +#' \dontrun{ +#' cmd = runMacs2(nInd=10, nChr=1, segSites=NULL, returnCommand=TRUE) +#' anc = simAnc(args=paste0(20, " ", cmd, " -s "), +#' nChr=1, inbred=FALSE, ploidy=2L, +#' nThreads=1L, seed=123L) +#' mut = simMut(anc, seed=456L) +#' } +#' +#' @export +simMut <- function(x, dTheta = NULL, seed = NULL) { + tables <- if (is.list(x) && !is.null(x$tables)) x$tables else x + if (!is.list(tables) || length(tables) == 0L) { + stop("simMut requires a non-empty list of table collections") + } + nChr <- length(tables) + + if (is.null(dTheta)) { + if (is.list(x) && !is.null(x$dTheta)) { + dTheta <- x$dTheta + } else { + stop("dTheta is required when x has no dTheta metadata") + } + } + if (length(dTheta) == 1L) { + dTheta <- rep(as.numeric(dTheta), nChr) + } + if (length(dTheta) != nChr) { + stop("dTheta length must be 1 or number of chromosomes") + } + + if (is.null(seed)) { + if (is.list(x) && !is.null(x$seed)) { + seed <- as.integer(x$seed) + 104729L + } else { + seed <- sample.int(1e8, nChr) + } + } + if (length(seed) == 1L) { + seed <- rep(as.integer(seed), nChr) + } + if (length(seed) != nChr) { + stop("seed length must be 1 or number of chromosomes") + } + + for (chr in seq_len(nChr)) { + tsMutateTableCollection(tables[[chr]], as.numeric(dTheta[[chr]]), as.numeric(seed[[chr]])) + } + + out <- if (is.list(x) && !is.null(x$tables)) x else list() + out$tables <- tables + out$dTheta <- as.numeric(dTheta) + out$mutationSeed <- as.integer(seed) + out$mutationMode <- "postTs" + out$stage <- "simMut" + out +} + +#' Finalize Inbred TS by Duplicating Sample Leaves per Individual +#' +#' @param x List returned by `simAnc`/`simMut`, or a list of table pointers. +#' @param inbred Logical. +#' @param ploidy Integer ploidy. +#' +#' @return List with finalized table collections and metadata. +#' @keywords internal +#' @noRd +finalizeInbredTs <- function(x, inbred = FALSE, ploidy = 2L) { + tables <- if (is.list(x) && !is.null(x$tables)) x$tables else x + if (!is.list(tables) || length(tables) == 0L) { + stop("finalizeInbredTs requires a non-empty list of table collections") + } + ploidy <- as.integer(ploidy) + if (ploidy <= 0L) { + stop("ploidy must be a positive integer") + } + + if (isTRUE(inbred) && ploidy > 1L) { + for (chr in seq_along(tables)) { + tsFinalizeInbredTableCollection(tables[[chr]], ploidy) + } + } + + out <- if (is.list(x) && !is.null(x$tables)) x else list() + out$tables <- tables + out$inbred <- isTRUE(inbred) + out$ploidy <- ploidy + out$stage <- "finalizeInbredTs" + out +} + +#' Build runMacs-style MaCS Command for TS Workflow +#' +#' @param nInd Integer number of individuals. +#' @param inbred Logical. +#' @param species Character species preset name. +#' @param split Optional split time in generations. +#' @param ploidy Integer ploidy. +#' @param manualCommand Optional user-provided MaCS command tail. +#' @param manualGenLen Optional user-provided chromosome genetic length(s) in Morgan. +#' @param nChr Integer number of chromosomes. +#' +#' @return List with `command`, `genLen`, and `seqLen`. +#' @keywords internal +#' @noRd +.runMacsTS_build_command <- function(nInd, inbred, species, split, ploidy, + manualCommand, manualGenLen, nChr) { + popSize <- ifelse(inbred, nInd, ploidy * nInd) + if (!is.null(manualCommand)) { + if (is.null(manualGenLen)) { + stop("You must define manualGenLen when using manualCommand") + } + command <- paste0(popSize, " ", manualCommand, " -s ") + genLen <- manualGenLen + } else { + species <- toupper(species) + if (species == "GENERIC") { + genLen <- 1.0 + Ne <- 100 + speciesParams <- "1E8 -t 1E-5 -r 4E-6" + speciesHist <- "-eN 0.25 5.0 -eN 2.50 15.0 -eN 25.00 60.0 -eN 250.00 120.0 -eN 2500.00 1000.0" + } else if (species == "CATTLE") { + cattleChrSum <- 2.8e9 + cattleChrBp <- cattleChrSum / 30 + recRate <- 9.26e-9 + genLen <- recRate * cattleChrBp + mutRate <- 9.4e-9 + Ne <- 90 + histNe <- c(120, 250, 350, 1000, 1500, 2000, 2500, 3500, 7000, 10000, 17000, 62000) + histGen <- c(3, 6, 12, 18, 24, 154, 454, 654, 1754, 2354, 3354, 33154) + speciesParams <- paste(c(round(cattleChrBp), "-t", mutRate * 4 * Ne, "-r", recRate * 4 * Ne), + collapse = " ") + histNe <- histNe / Ne + histGen <- histGen / (4 * Ne) + speciesHist <- NULL + for (i in seq_len(length(histNe))) { + speciesHist <- paste(speciesHist, "-eN", histGen[i], histNe[i]) + } + } else if (species == "WHEAT") { + genLen <- 1.43 + Ne <- 50 + speciesParams <- "8E8 -t 4E-7 -r 3.6E-7" + speciesHist <- "-eN 0.03 1 -eN 0.05 2 -eN 0.10 4 -eN 0.15 6 -eN 0.20 8 -eN 0.25 10 -eN 0.30 12 -eN 0.35 14 -eN 0.40 16 -eN 0.45 18 -eN 0.50 20 -eN 1.00 40 -eN 2.00 60 -eN 3.00 80 -eN 4.00 100 -eN 5.00 120 -eN 10.00 140 -eN 20.00 160 -eN 30.00 180 -eN 40.00 200 -eN 50.00 240 -eN 100.00 320 -eN 200.00 400 -eN 300.00 480 -eN 400.00 560 -eN 500.00 640" + } else if (species == "MAIZE") { + genLen <- 2.0 + Ne <- 100 + speciesParams <- "2E8 -t 5E-6 -r 4E-6" + speciesHist <- "-eN 0.03 1 -eN 0.05 2 -eN 0.10 4 -eN 0.15 6 -eN 0.20 8 -eN 0.25 10 -eN 0.30 12 -eN 0.35 14 -eN 0.40 16 -eN 0.45 18 -eN 0.50 20 -eN 2.00 40 -eN 3.00 60 -eN 4.00 80 -eN 5.00 100" + } else { + stop("No rules for species ", species) + } + if (is.null(split)) { + splitI <- "" + splitJ <- "" + } else { + stopifnot(popSize %% 2 == 0) + splitI <- paste(" -I 2", popSize %/% 2, popSize %/% 2) + splitJ <- paste(" -ej", split / (4 * Ne) + 0.000001, "2 1") + } + command <- paste0(popSize, " ", speciesParams, splitI, " ", speciesHist, splitJ, " -s ") + } + if (!is.null(manualGenLen)) { + genLen <- manualGenLen + } + if (length(genLen) == 1L) { + genLen <- rep(genLen, nChr) + } + if (length(genLen) != nChr) { + stop("genLen must have length 1 or nChr") + } + tokens <- strsplit(command, "[,[:space:]]+", perl = TRUE)[[1L]] + tokens <- tokens[nzchar(tokens)] + if (length(tokens) < 2L) { + stop("Failed to parse sequence length from command") + } + seqLen <- suppressWarnings(as.numeric(tokens[2L])) + if (!is.finite(seqLen) || seqLen <= 0) { + stop("Invalid sequence length parsed from command") + } + list(command = command, genLen = as.numeric(genLen), seqLen = seqLen) +} + +.runMacsTS_hotspot_path <- function(args) { + tokens <- strsplit(as.character(args), "[,[:space:]]+", perl = TRUE)[[1L]] + tokens <- tokens[nzchar(tokens)] + idx <- match("-R", tokens) + if (is.na(idx) || idx >= length(tokens)) { + return(NULL) + } + tokens[[idx + 1L]] +} + +.runMacsTS_read_hotspot_map <- function(path) { + if (!is.character(path) || length(path) != 1L || is.na(path) || !nzchar(path)) { + stop("Invalid MaCS -R hotspot file path", call. = FALSE) + } + if (!file.exists(path)) { + stop("MaCS -R hotspot file does not exist: ", path, call. = FALSE) + } + hot <- utils::read.table(path, header = FALSE, col.names = c("start", "end", "ratio")) + if (ncol(hot) != 3L || nrow(hot) == 0L) { + stop("MaCS -R hotspot file must contain rows of: start end ratio", call. = FALSE) + } + hot$start <- as.numeric(hot$start) + hot$end <- as.numeric(hot$end) + hot$ratio <- as.numeric(hot$ratio) + bad <- !is.finite(hot$start) | !is.finite(hot$end) | !is.finite(hot$ratio) | + hot$start < 0 | hot$end > 1 | hot$start >= hot$end | hot$ratio < 0 + if (any(bad)) { + stop("Invalid MaCS -R hotspot row. Expected 0 <= start < end <= 1 and ratio >= 0.", call. = FALSE) + } + hot <- hot[order(hot$start, hot$end), , drop = FALSE] + if (nrow(hot) > 1L && any(hot$start[-1L] < hot$end[-nrow(hot)])) { + stop("Overlapping MaCS -R hotspot intervals are not supported", call. = FALSE) + } + hot +} + +.runMacsTS_map_from_hotspots <- function(path, nChr, seqLen, genLen, usePhysicalPositions) { + hot <- .runMacsTS_read_hotspot_map(path) + coordLen <- if (isTRUE(usePhysicalPositions)) as.numeric(seqLen) else 1 + starts <- coordLen * hot$start + ends <- coordLen * hot$end + recBreaks <- sort(unique(c(0, coordLen, starts, ends))) + ratio <- rep(1, length(recBreaks) - 1L) + for (i in seq_len(nrow(hot))) { + idx <- recBreaks[-length(recBreaks)] >= starts[[i]] & recBreaks[-1L] <= ends[[i]] + ratio[idx] <- hot$ratio[[i]] + } + recRates <- lapply(as.numeric(genLen), function(g) { + (g / coordLen) * ratio + }) + list( + breaks = rep(list(recBreaks), as.integer(nChr)), + rates = recRates + ) +} + +.runMacsTS_resolve_rec_map <- function(args, nChr, seqLen, genLen, usePhysicalPositions) { + hotspotPath <- .runMacsTS_hotspot_path(args) + if (!is.null(hotspotPath)) { + return(.runMacsTS_map_from_hotspots( + path = hotspotPath, + nChr = nChr, + seqLen = seqLen, + genLen = genLen, + usePhysicalPositions = usePhysicalPositions + )) + } + + recBreaks <- if (usePhysicalPositions) { + rep(list(c(0, seqLen)), nChr) + } else { + rep(list(c(0, 1)), nChr) + } + recRates <- if (usePhysicalPositions) { + lapply(genLen, function(g) c(g / seqLen)) + } else { + lapply(genLen, function(g) c(g)) + } + list(breaks = recBreaks, rates = recRates) +} + +#' Create Founder Haplotypes and Tree Sequences using MaCS +#' +#' @description +#' Tree-sequence analogue of \code{\link{runMacs}}. This function simulates +#' MaCS ancestry, optionally adds mutations, converts the resulting tree +#' sequence data to a \code{\link{MapPop-class}}, and can return the founder +#' table collections for forward tree-sequence recording. +#' +#' @param nInd Integer number of individuals to simulate. +#' @param nChr Integer number of chromosomes. +#' @param segSites Optional site-count cap per chromosome (scalar or vector). +#' @param inbred Logical. +#' @param species Species preset used by \code{\link{runMacs}}. +#' @param split Optional population split time in generations. +#' @param ploidy Integer ploidy. +#' @param manualCommand Optional MaCS command tail (advanced users). +#' @param manualGenLen Optional genetic length(s) in Morgan. +#' @param nThreads Optional thread count. +#' @param mutationMode One of \code{"postTs"}, \code{"macs"}, or +#' \code{"none"}. +#' @param usePhysicalPositions Logical; TS coordinates in bp if \code{TRUE}. +#' @param Nref Optional reference \code{Ne} for time scaling. +#' @param seed Optional integer vector (length 1 or \code{nChr}) for ancestry. +#' @param mutSeed Optional integer vector (length 1 or \code{nChr}) for +#' post-TS mutation. +#' @param mutSeedOffset Integer offset used when deriving post-TS mutation seeds. +#' @param siteSamplingSeed Integer seed for \code{\link{asMapPop}} site +#' sampling. +#' @param expandInbredTs Logical; whether to expand inbred TS sample leaves before conversion. +#' @param returnTs Logical; return TS tables and metadata alongside +#' \code{\link{MapPop-class}}. +#' +#' @details +#' \code{mutationMode = "postTs"} first creates ancestry tables and then calls +#' \code{\link{simMut}} to place mutations. \code{mutationMode = "macs"} keeps +#' the mutation placement from the native MaCS path. \code{mutationMode = "none"} +#' returns ancestry-only tables and requires \code{returnTs = TRUE}. +#' +#' When \code{returnTs = TRUE}, the returned population keeps +#' \code{tsForwardSource} and \code{tsForwardPosMeta} attributes that can be used +#' by \code{SimParam$setTrackTs(TRUE, founderPop=...)}. +#' +#' @return \code{\link{MapPop-class}} by default; otherwise a list with +#' \code{pop}, \code{tables}, and metadata. +#' +#' @examples +#' \dontrun{ +#' founderPop = runMacsTS(nInd=10, nChr=1, segSites=100) +#' +#' out = runMacsTS(nInd=10, nChr=1, segSites=100, returnTs=TRUE) +#' SP = SimParam$new(out$pop) +#' SP$setTrackTs(TRUE, founderPop=out$pop) +#' paths = tsForwardFinalizeFromSimParam(SP, out_dir=tempdir()) +#' } +#' +#' @export +runMacsTS <- function(nInd, nChr = 1, segSites = NULL, inbred = FALSE, + species = "GENERIC", split = NULL, ploidy = 2L, + manualCommand = NULL, manualGenLen = NULL, nThreads = NULL, + mutationMode = c("postTs", "macs", "none"), + usePhysicalPositions = FALSE, Nref = NA_real_, + seed = NULL, mutSeed = NULL, mutSeedOffset = 104729L, + siteSamplingSeed = 42L, expandInbredTs = FALSE, + returnTs = FALSE) { + mutationMode <- match.arg(mutationMode) + nInd <- as.integer(nInd) + nChr <- as.integer(nChr) + ploidy <- as.integer(ploidy) + if (is.null(nThreads)) { + nThreads <- getNumThreads() + } + nThreads <- as.integer(nThreads) + if (nChr < nThreads) { + nThreads <- nChr + } + if (nInd <= 0L || nChr <= 0L || ploidy <= 0L) { + stop("nInd, nChr, and ploidy must be positive integers") + } + if (!is.null(segSites)) { + segSites <- as.integer(segSites) + if (length(segSites) == 1L) { + segSites <- rep(segSites, nChr) + } + if (length(segSites) != nChr) { + stop("segSites must have length 1 or nChr") + } + } + + setup <- .runMacsTS_build_command( + nInd = nInd, + inbred = inbred, + species = species, + split = split, + ploidy = ploidy, + manualCommand = manualCommand, + manualGenLen = manualGenLen, + nChr = nChr + ) + args <- setup$command + genLen <- setup$genLen + seqLen <- setup$seqLen + + if (is.null(seed)) { + seed <- sample.int(n = 1e8, size = nChr) + } + seed <- as.integer(seed) + if (length(seed) == 1L) { + seed <- rep(seed, nChr) + } + if (length(seed) != nChr) { + stop("seed must have length 1 or nChr") + } + + runOut <- NULL + if (mutationMode == "macs") { + runOut <- MaCSTS( + args = args, + nChr = nChr, + inbred = inbred, + ploidy = ploidy, + nThreads = nThreads, + seed = seed, + usePhysicalPositions = usePhysicalPositions, + useMacsMut = TRUE, + Nref = Nref, + expandInbredSamples = FALSE + ) + } else { + runOut <- simAnc( + args = args, + nChr = nChr, + inbred = inbred, + ploidy = ploidy, + nThreads = nThreads, + seed = seed, + usePhysicalPositions = usePhysicalPositions, + Nref = Nref + ) + if (mutationMode == "postTs") { + if (is.null(mutSeed)) { + mutSeed <- as.integer(seed + as.integer(mutSeedOffset)) + } + mutSeed <- as.integer(mutSeed) + if (length(mutSeed) == 1L) { + mutSeed <- rep(mutSeed, nChr) + } + if (length(mutSeed) != nChr) { + stop("mutSeed must have length 1 or nChr") + } + timeScale <- if (!is.null(runOut$timeScale)) as.numeric(runOut$timeScale) else 1 + dThetaPost <- as.numeric(runOut$dTheta) / timeScale + runOut <- simMut(runOut, dTheta = dThetaPost, seed = mutSeed) + } + } + + if (isTRUE(expandInbredTs) && isTRUE(inbred) && ploidy > 1L) { + runOut <- finalizeInbredTs(runOut, inbred = inbred, ploidy = ploidy) + } + + if (mutationMode == "none") { + if (!isTRUE(returnTs)) { + stop("mutationMode='none' produces ancestry-only TS with zero sites; set returnTs=TRUE or use mutationMode='postTs'/'macs'.") + } + return(list( + pop = NULL, + tables = runOut$tables, + args = args, + seed = seed, + mutationMode = mutationMode, + mutSeed = NA_integer_, + usePhysicalPositions = usePhysicalPositions, + timeScale = if (!is.null(runOut$timeScale)) runOut$timeScale else 1, + Nref = if (!is.null(runOut$Nref)) runOut$Nref else NA_real_ + )) + } + + siteCounts <- vapply(runOut$tables, function(tc_xptr) { + as.integer(rtsk_table_collection_summary2(tc_xptr)$num_sites) + }, integer(1)) + if (any(siteCounts <= 0L)) { + badChr <- which(siteCounts <= 0L) + stop("No segregating sites on chromosome(s): ", + paste(badChr, collapse = ", "), + ". Increase mutation rate or inspect TS via returnTs=TRUE.") + } + + recMap <- .runMacsTS_resolve_rec_map( + args = args, + nChr = nChr, + seqLen = seqLen, + genLen = genLen, + usePhysicalPositions = usePhysicalPositions + ) + + popOut <- asMapPop( + chr_info = list( + tables = runOut$tables, + breaks = recMap$breaks, + rates = recMap$rates + ), + ploidy = ploidy, + inbred = inbred, + segSites = segSites, + site_sampling_seed = as.integer(siteSamplingSeed), + nThreads = nThreads, + returnMeta = FALSE + ) + + if (!isTRUE(returnTs)) { + return(popOut) + } + list( + pop = popOut, + tables = runOut$tables, + args = args, + seed = seed, + mutationMode = mutationMode, + mutSeed = if (!is.null(runOut$mutationSeed)) runOut$mutationSeed else NA_integer_, + usePhysicalPositions = usePhysicalPositions, + timeScale = if (!is.null(runOut$timeScale)) runOut$timeScale else 1, + Nref = if (!is.null(runOut$Nref)) runOut$Nref else NA_real_ + ) +} + +#' Build file-backed bridge chromosome info from a runMacsTS result +#' +#' `runMacsTS(..., returnTs = TRUE)` keeps founder tables in memory, while the +#' old bridge validation path expects `chr_info[[cc]]$ts_path`. This helper +#' writes those tables to `.trees` files and reuses the map metadata stored by +#' `asMapPop()`. +#' +#' @param x List returned by `runMacsTS(..., returnTs = TRUE)`. +#' @param out_dir Directory where founder `.trees` files should be written. +#' @param out_basename Prefix for written founder tree files. +#' @param segSites Optional scalar or per-chromosome site counts for returned +#' `chr_info`. Defaults to `x$pop@nLoci`. +#' +#' @return List of chromosome info entries with `ts_path`, `breaks`, `rates`, +#' and `segSites`. +#' @keywords internal +#' @noRd +runMacsTSBridgeChrInfo <- function(x, out_dir, out_basename = "runMacsTS_founder", + segSites = NULL) { + if (!is.list(x) || is.null(x$pop) || is.null(x$tables)) { + stop("x must be the list returned by runMacsTS(..., returnTs = TRUE)", call. = FALSE) + } + pop <- x$pop + tables <- x$tables + if (!is(pop, "MapPop") && !is(pop, "Pop")) { + stop("x$pop must be a Pop or MapPop object", call. = FALSE) + } + if (!is.list(tables) || length(tables) == 0L) { + stop("x$tables must be a non-empty list of table collection pointers", call. = FALSE) + } + nChr <- length(tables) + if (pop@nChr != nChr) { + stop("length(x$tables) must match x$pop@nChr", call. = FALSE) + } + if (!is.character(out_dir) || length(out_dir) != 1L || is.na(out_dir) || !nzchar(out_dir)) { + stop("out_dir must be a non-empty character scalar", call. = FALSE) + } + if (!is.character(out_basename) || length(out_basename) != 1L || + is.na(out_basename) || !nzchar(out_basename)) { + stop("out_basename must be a non-empty character scalar", call. = FALSE) + } + dir.create(out_dir, recursive = TRUE, showWarnings = FALSE) + if (!dir.exists(out_dir)) { + stop("Failed to create out_dir: ", out_dir, call. = FALSE) + } + + posMeta <- attr(pop, "tsForwardPosMeta", exact = TRUE) + if (is.null(posMeta) || is.null(posMeta$posList) || length(posMeta$posList) != nChr || + is.null(posMeta$breaksList) || length(posMeta$breaksList) != nChr || + is.null(posMeta$ratesList) || length(posMeta$ratesList) != nChr) { + stop("x$pop is missing TS position metadata from asMapPop()", call. = FALSE) + } + if (length(pop@genMap) != nChr) { + stop("x$pop@genMap length must match x$pop@nChr", call. = FALSE) + } + + if (is.null(segSites)) { + segSites <- as.integer(pop@nLoci) + } else { + segSites <- as.integer(segSites) + } + if (length(segSites) == 1L) { + segSites <- rep(segSites, nChr) + } + if (length(segSites) != nChr || any(is.na(segSites)) || any(segSites < 0L)) { + stop("segSites must have length 1 or number of chromosomes", call. = FALSE) + } + + lapply(seq_len(nChr), function(cc) { + tc <- RcppTskit::TableCollection$new(xptr = tables[[cc]]) + seqLen <- as.numeric(tc$sequence_length()) + if (!is.finite(seqLen) || seqLen <= 0) { + stop("Invalid sequence length for chromosome ", cc, call. = FALSE) + } + + tsPath <- file.path(out_dir, paste0(out_basename, "_chr", cc - 1L, ".trees")) + tc$tree_sequence()$dump(tsPath) + + list( + ts_path = tsPath, + breaks = as.numeric(posMeta$breaksList[[cc]]), + rates = as.numeric(posMeta$ratesList[[cc]]), + segSites = segSites[[cc]] + ) + }) +} + +# Backward-compatible development aliases for the earlier runMacTS spelling. +runMacTS <- function(...) { + runMacsTS(...) +} + +runMacTSBridgeChrInfo <- function(x, out_dir, out_basename = "runMacTS_founder", + segSites = NULL) { + runMacsTSBridgeChrInfo(x=x, + out_dir=out_dir, + out_basename=out_basename, + segSites=segSites) +} + +.runMacTS_build_command <- .runMacsTS_build_command +.runMacTS_hotspot_path <- .runMacsTS_hotspot_path +.runMacTS_read_hotspot_map <- .runMacsTS_read_hotspot_map +.runMacTS_map_from_hotspots <- .runMacsTS_map_from_hotspots +.runMacTS_resolve_rec_map <- .runMacsTS_resolve_rec_map diff --git a/R/tsForwardRecorder.R b/R/tsForwardRecorder.R new file mode 100644 index 00000000..6113f597 --- /dev/null +++ b/R/tsForwardRecorder.R @@ -0,0 +1,1505 @@ +.tsForwardNodeKey <- function(iid, hap) { + paste0(as.integer(iid), "_", as.integer(hap)) +} + +.tsForwardAttachMetadata <- function() { + isTRUE(getOption("AlphaSimR.tsForwardAttachMetadata", TRUE)) +} + +.tsForwardIndividualMetadataRaw <- function(file_id) { + charToRaw(paste0("{\"file_id\":", as.integer(file_id), "}")) +} + +.tsForwardUpdateIndTimeCache <- function(indTime, pedigree) { + n <- nrow(pedigree) + if (is.null(indTime)) { + indTime <- numeric(0) + } + oldN <- length(indTime) + if (oldN >= n) { + return(indTime) + } + indTime <- c(indTime, rep(NA_real_, n - oldN)) + for (i in seq.int(oldN + 1L, n)) { + m <- pedigree[i, "mother"] + f <- pedigree[i, "father"] + if (m == 0L && f == 0L) { + indTime[i] <- 0 + } else { + indTime[i] <- min(indTime[m], indTime[f]) - 1 + } + } + indTime +} + +.tsForwardEnsureIndividual <- function(chrState, iid, pedigree) { + key <- as.character(as.integer(iid)) + if (exists(key, envir = chrState$indMap, inherits = FALSE)) { + return(get(key, envir = chrState$indMap, inherits = FALSE)) + } + + m <- pedigree[iid, "mother"] + f <- pedigree[iid, "father"] + nextInd <- as.integer(chrState$tc$num_individuals()) + md <- if (.tsForwardAttachMetadata()) .tsForwardIndividualMetadataRaw(nextInd) else NULL + if (m > 0L) { + mRow <- .tsForwardEnsureIndividual(chrState, m, pedigree) + fRow <- .tsForwardEnsureIndividual(chrState, f, pedigree) + indRow <- chrState$tc$individual_table_add_row( + parents = c(as.integer(mRow), as.integer(fRow)), + metadata = md + ) + } else { + indRow <- chrState$tc$individual_table_add_row( + parents = NULL, + metadata = md + ) + } + + assign(key, as.integer(indRow), envir = chrState$indMap) + as.integer(indRow) +} + +.tsForwardMorgToTsPosVec <- function(m, gm, pos, seqLen, side = c("left", "right")) { + side <- match.arg(side) + out <- rep(NA_real_, length(m)) + ok <- is.finite(m) + if (!any(ok)) { + return(out) + } + if (length(gm) < 2L) { + v <- min(max(pos[1], 0), seqLen) + out[ok] <- v + return(out) + } + + out[ok & m <= 0] <- 0 + out[ok & m >= gm[length(gm)]] <- seqLen + + mid <- ok & m > 0 & m < gm[length(gm)] + if (any(mid)) { + mm <- m[mid] + i <- findInterval(mm, gm, rightmost.closed = TRUE) + i <- pmin.int(pmax.int(i, 1L), length(gm) - 1L) + gmL <- gm[i] + gmR <- gm[i + 1L] + posL <- pos[i] + posR <- pos[i + 1L] + val <- posL + (mm - gmL) * (posR - posL) / (gmR - gmL) + bad <- gmR <= gmL + if (any(bad)) { + val[bad] <- if (side == "left") posL[bad] else posR[bad] + } + out[mid] <- pmin(seqLen, pmax(0, val)) + } + out +} + +.tsForwardMorgToTsPosRateMapVec <- function(m, x0, breaks, rates, seqLen, maxM, + side = c("left", "right")) { + side <- match.arg(side) + out <- rep(NA_real_, length(m)) + ok <- is.finite(m) + if (!any(ok)) { + return(out) + } + + breaks <- as.numeric(breaks) + rates <- as.numeric(rates) + if (length(breaks) != length(rates) + 1L || + length(rates) < 1L || + any(!is.finite(breaks)) || + any(!is.finite(rates)) || + any(rates < 0) || + any(diff(breaks) < 0)) { + stop("Invalid TS forward rate-map metadata", call. = FALSE) + } + + if (!is.finite(maxM) || maxM <= 0) { + out[ok] <- if (side == "left") 0 else seqLen + return(out) + } + + out[ok & m <= 0] <- 0 + out[ok & m >= maxM] <- seqLen + + mid <- ok & m > 0 & m < maxM + if (any(mid)) { + segLen <- diff(breaks) + mStart <- c(0, cumsum(rates * segLen)) + mEnd <- mStart[-1L] + + i0 <- findInterval(x0, breaks, rightmost.closed = TRUE) + i0 <- pmin.int(pmax.int(i0, 1L), length(rates)) + mX0 <- mStart[i0] + rates[i0] * (x0 - breaks[i0]) + + M <- m[mid] + mX0 + i <- findInterval(M, mStart, rightmost.closed = TRUE) + i <- pmin.int(pmax.int(i, 1L), length(rates)) + + plateau <- (rates[i] == 0) | (mEnd[i] == mStart[i]) + val <- numeric(length(M)) + nonPlateau <- !plateau + if (any(nonPlateau)) { + val[nonPlateau] <- breaks[i[nonPlateau]] + + (M[nonPlateau] - mStart[i[nonPlateau]]) / rates[i[nonPlateau]] + } + if (any(plateau)) { + val[plateau] <- if (side == "left") breaks[i[plateau]] else breaks[i[plateau] + 1L] + } + out[mid] <- pmin(seqLen, pmax(0, val)) + } + out +} + +.tsForwardHasRateMapMeta <- function(posMeta, cc) { + !is.null(posMeta$breaksList) && + !is.null(posMeta$ratesList) && + length(posMeta$breaksList) >= cc && + length(posMeta$ratesList) >= cc && + !is.null(posMeta$breaksList[[cc]]) && + !is.null(posMeta$ratesList[[cc]]) +} + +.tsForwardSegGenToTsIntervals <- function(chr, parentSide, leftGen, rightGen, + femaleMap, maleMap, posMeta) { + nSeg <- length(chr) + left <- as.numeric(leftGen) + right <- as.numeric(rightGen) + if (nSeg == 0L || is.null(posMeta) || is.null(posMeta$posList)) { + return(list(left = left, right = right)) + } + + outLeft <- numeric(nSeg) + outRight <- numeric(nSeg) + chrVals <- sort.int(unique(as.integer(chr)), method = "quick") + for (cc in chrVals) { + idxChr <- which(chr == cc) + pos <- posMeta$posList[[cc]] + seqLen <- as.numeric(posMeta$seqLenList[[cc]]) + useRateMap <- .tsForwardHasRateMapMeta(posMeta, cc) + x0 <- if (useRateMap) as.numeric(pos[[1L]]) else NA_real_ + breaks <- if (useRateMap) posMeta$breaksList[[cc]] else NULL + rates <- if (useRateMap) posMeta$ratesList[[cc]] else NULL + + idxM <- idxChr[parentSide[idxChr] == 1L] + if (length(idxM) > 0L) { + gm <- femaleMap[[cc]] + if (useRateMap) { + outLeft[idxM] <- .tsForwardMorgToTsPosRateMapVec( + left[idxM], x0, breaks, rates, seqLen, max(gm), side = "left" + ) + outRight[idxM] <- .tsForwardMorgToTsPosRateMapVec( + right[idxM], x0, breaks, rates, seqLen, max(gm), side = "right" + ) + } else { + outLeft[idxM] <- .tsForwardMorgToTsPosVec(left[idxM], gm, pos, seqLen, side = "left") + outRight[idxM] <- .tsForwardMorgToTsPosVec(right[idxM], gm, pos, seqLen, side = "right") + } + } + + idxF <- idxChr[parentSide[idxChr] == 2L] + if (length(idxF) > 0L) { + gm <- maleMap[[cc]] + if (useRateMap) { + outLeft[idxF] <- .tsForwardMorgToTsPosRateMapVec( + left[idxF], x0, breaks, rates, seqLen, max(gm), side = "left" + ) + outRight[idxF] <- .tsForwardMorgToTsPosRateMapVec( + right[idxF], x0, breaks, rates, seqLen, max(gm), side = "right" + ) + } else { + outLeft[idxF] <- .tsForwardMorgToTsPosVec(left[idxF], gm, pos, seqLen, side = "left") + outRight[idxF] <- .tsForwardMorgToTsPosVec(right[idxF], gm, pos, seqLen, side = "right") + } + } + } + + list(left = outLeft, right = outRight) +} + +.tsForwardResolvePosMeta <- function() { + if (exists("chrKeptPosTsList", inherits = TRUE)) { + posList <- get("chrKeptPosTsList", inherits = TRUE) + } else if (exists("chrKeptPosBpList", inherits = TRUE)) { + posList <- get("chrKeptPosBpList", inherits = TRUE) + } else { + return(list(posList = NULL, seqLenList = NULL)) + } + if (exists("chrSeqLenTsList", inherits = TRUE)) { + seqLenList <- get("chrSeqLenTsList", inherits = TRUE) + } else if (exists("chrSeqLenBpList", inherits = TRUE)) { + seqLenList <- get("chrSeqLenBpList", inherits = TRUE) + } else { + seqLenList <- lapply(posList, function(x) max(x, na.rm = TRUE)) + } + list(posList = posList, seqLenList = seqLenList) +} + +.tsForwardParseNodeKeys <- function(keys) { + list( + iids = as.integer(sub("_.*$", "", keys)), + haps = as.integer(sub("^.*_", "", keys)) + ) +} + +.tsForwardAddMissingChildNodes <- function(chrState, missingKeys, nodeTimes) { + if (length(missingKeys) == 0L) { + return(invisible(NULL)) + } + if (length(nodeTimes) != length(missingKeys)) { + stop("Internal error: nodeTimes length does not match missingKeys length", call. = FALSE) + } + + keyInfo <- .tsForwardParseNodeKeys(missingKeys) + indRows <- vapply(keyInfo$iids, function(iid) { + as.integer(get(as.character(iid), envir = chrState$indMap, inherits = FALSE)) + }, integer(1)) + + if (!.tsForwardAttachMetadata()) { + nodeIds <- tsForwardNodeTableAddRows( + chrState$tc, + flags = rep.int(0L, length(missingKeys)), + time = as.numeric(nodeTimes), + population = rep.int(-1L, length(missingKeys)), + individual = as.integer(indRows) + ) + } else { + nodeIds <- tsForwardNodeTableAddRowsWithMetadata( + chrState$tc, + flags = rep.int(0L, length(missingKeys)), + time = as.numeric(nodeTimes), + population = rep.int(-1L, length(missingKeys)), + individual = as.integer(indRows), + nodeKey = as.character(missingKeys) + ) + } + + for (j in seq_along(missingKeys)) { + assign(missingKeys[[j]], as.integer(nodeIds[j]), envir = chrState$nodeMap) + } + invisible(NULL) +} + +.tsForwardAppendEdgesByKeys <- function(chrState, left, right, parentKeys, childKeys, cc) { + n <- length(left) + if (length(right) != n || length(parentKeys) != n || length(childKeys) != n) { + stop("Internal error: edge vector lengths do not match", call. = FALSE) + } + + keep <- rep.int(FALSE, n) + leftVec <- numeric(n) + rightVec <- numeric(n) + parentVec <- integer(n) + childVec <- integer(n) + for (i in seq_len(n)) { + leftI <- max(0, as.numeric(left[[i]])) + rightI <- min(chrState$seqLen, as.numeric(right[[i]])) + if (!is.finite(leftI) || !is.finite(rightI) || rightI <= leftI) { + next + } + + pKey <- parentKeys[[i]] + cKey <- childKeys[[i]] + if (!exists(pKey, envir = chrState$nodeMap, inherits = FALSE)) { + stop("Missing parent node for key ", pKey, " on chr ", cc, call. = FALSE) + } + if (!exists(cKey, envir = chrState$nodeMap, inherits = FALSE)) { + stop("Missing child node for key ", cKey, " on chr ", cc, call. = FALSE) + } + + keep[[i]] <- TRUE + leftVec[[i]] <- leftI + rightVec[[i]] <- rightI + parentVec[[i]] <- as.integer(get(pKey, envir = chrState$nodeMap, inherits = FALSE)) + childVec[[i]] <- as.integer(get(cKey, envir = chrState$nodeMap, inherits = FALSE)) + } + + if (any(keep)) { + idx <- which(keep) + tsForwardEdgeTableAddRows( + chrState$tc, + left = leftVec[idx], + right = rightVec[idx], + parent = parentVec[idx], + child = childVec[idx] + ) + } + invisible(NULL) +} + +.tsForwardEnsureChildrenIndividuals <- function(chrState, + children, + simParam, + cc, + childIid = NULL, + childMotherIid = NULL, + childFatherIid = NULL) { + useDirectParents <- !is.null(childMotherIid) && !is.null(childFatherIid) + + for (iid in children) { + key <- as.character(as.integer(iid)) + if (exists(key, envir = chrState$indMap, inherits = FALSE)) { + next + } + + if (useDirectParents) { + ii <- match(iid, childIid) + if (is.na(ii)) { + stop("Internal error: child iid not found in childIid map", call. = FALSE) + } + mIid <- childMotherIid[[ii]] + fIid <- childFatherIid[[ii]] + mKey <- as.character(as.integer(mIid)) + fKey <- as.character(as.integer(fIid)) + + if (!exists(mKey, envir = chrState$indMap, inherits = FALSE)) { + if (mIid <= nrow(simParam$pedigree)) { + .tsForwardEnsureIndividual(chrState, mIid, simParam$pedigree) + } else { + stop("Missing mother individual row for iid ", mIid, " on chr ", cc, call. = FALSE) + } + } + if (!exists(fKey, envir = chrState$indMap, inherits = FALSE)) { + if (fIid <= nrow(simParam$pedigree)) { + .tsForwardEnsureIndividual(chrState, fIid, simParam$pedigree) + } else { + stop("Missing father individual row for iid ", fIid, " on chr ", cc, call. = FALSE) + } + } + + mRow <- as.integer(get(mKey, envir = chrState$indMap, inherits = FALSE)) + fRow <- as.integer(get(fKey, envir = chrState$indMap, inherits = FALSE)) + nextInd <- as.integer(chrState$tc$num_individuals()) + md <- if (.tsForwardAttachMetadata()) .tsForwardIndividualMetadataRaw(nextInd) else NULL + indRow <- chrState$tc$individual_table_add_row( + parents = c(mRow, fRow), + metadata = md + ) + assign(key, as.integer(indRow), envir = chrState$indMap) + } else { + .tsForwardEnsureIndividual(chrState, iid, simParam$pedigree) + } + } + + invisible(NULL) +} + +.tsSegGenToTsPos <- function(tsSegGen, femaleMap, maleMap) { + if (is.null(tsSegGen)) { + return(NULL) + } + if (is.null(dim(tsSegGen)) || nrow(tsSegGen) == 0L) { + return(data.frame( + childLocal = integer(), + chr = integer(), + hap = integer(), + parentSide = integer(), + parentIndex = integer(), + parentHap = integer(), + leftGen = numeric(), + rightGen = numeric(), + left = numeric(), + right = numeric(), + stringsAsFactors = FALSE + )) + } + + df <- as.data.frame(tsSegGen, stringsAsFactors = FALSE) + names(df) <- c("childLocal", "chr", "hap", "parentSide", + "parentIndex", "parentHap", "leftGen", "rightGen") + intCols <- c("childLocal", "chr", "hap", "parentSide", "parentIndex", "parentHap") + for (cc in intCols) { + df[[cc]] <- as.integer(df[[cc]]) + } + + posMeta <- .tsForwardResolvePosMeta() + intervals <- .tsForwardSegGenToTsIntervals( + chr = df$chr, + parentSide = df$parentSide, + leftGen = df$leftGen, + rightGen = df$rightGen, + femaleMap = femaleMap, + maleMap = maleMap, + posMeta = posMeta + ) + df$left <- intervals$left + df$right <- intervals$right + + df[df$right > df$left, , drop = FALSE] +} + +.attachTsSegGenIds <- function(tsSegGen, childPop, femalePop, malePop) { + if (is.null(tsSegGen)) { + return(NULL) + } + if (nrow(tsSegGen) == 0L) { + tsSegGen$childIid <- integer() + tsSegGen$parentIid <- integer() + tsSegGen$childId <- character() + tsSegGen$parentId <- character() + return(tsSegGen) + } + + nChild <- nInd(childPop) + if (any(tsSegGen$childLocal < 1L | tsSegGen$childLocal > nChild)) { + stop("Internal error: tsSegGen childLocal out of bounds", call. = FALSE) + } + + motherRows <- which(tsSegGen$parentSide == 1L) + fatherRows <- which(tsSegGen$parentSide == 2L) + if (length(motherRows) > 0L) { + if (any(tsSegGen$parentIndex[motherRows] < 1L | + tsSegGen$parentIndex[motherRows] > nInd(femalePop))) { + stop("Internal error: tsSegGen mother parentIndex out of bounds", call. = FALSE) + } + } + if (length(fatherRows) > 0L) { + if (any(tsSegGen$parentIndex[fatherRows] < 1L | + tsSegGen$parentIndex[fatherRows] > nInd(malePop))) { + stop("Internal error: tsSegGen father parentIndex out of bounds", call. = FALSE) + } + } + + tsSegGen$childIid <- childPop@iid[tsSegGen$childLocal] + tsSegGen$childId <- childPop@id[tsSegGen$childLocal] + + tsSegGen$parentIid <- integer(nrow(tsSegGen)) + tsSegGen$parentId <- character(nrow(tsSegGen)) + if (length(motherRows) > 0L) { + tsSegGen$parentIid[motherRows] <- femalePop@iid[tsSegGen$parentIndex[motherRows]] + tsSegGen$parentId[motherRows] <- femalePop@id[tsSegGen$parentIndex[motherRows]] + } + if (length(fatherRows) > 0L) { + tsSegGen$parentIid[fatherRows] <- malePop@iid[tsSegGen$parentIndex[fatherRows]] + tsSegGen$parentId[fatherRows] <- malePop@id[tsSegGen$parentIndex[fatherRows]] + } + tsSegGen +} + +.appendTsForwardRawIfActive <- function(simParam, + tsSegGenRaw, + childIid, + motherIid, + fatherIid, + childMotherIid = NULL, + childFatherIid = NULL, + femaleMap, + maleMap) { + if (!simParam$isTrackRecGen) { + return(FALSE) + } + rec <- .tsForwardGetRecorder(simParam) + if (is.null(rec)) { + return(FALSE) + } + rec <- tsForwardAppendSegGenRaw( + recorder = rec, + tsSegGen = tsSegGenRaw, + childIid = childIid, + motherIid = motherIid, + fatherIid = fatherIid, + childMotherIid = childMotherIid, + childFatherIid = childFatherIid, + femaleMap = femaleMap, + maleMap = maleMap, + simParam = simParam + ) + .tsForwardSetRecorder(simParam, rec) + TRUE +} + +.useTsForwardDirectCross <- function(simParam) { + if (!simParam$isTrackRecGen) { + return(FALSE) + } + !is.null(.tsForwardGetRecorder(simParam)) +} + +.keepTsForwardSeg <- function() { + isTRUE(getOption("AlphaSimR.tsForwardKeepSeg", FALSE)) +} + +.needRecHistGenFromCross <- function(simParam) { + if (!isTRUE(simParam$isTrackRecGen)) { + return(FALSE) + } + isTRUE(getOption("AlphaSimR.tsForwardKeepRecHistGen", FALSE)) +} + +.setupTsForwardCross <- function(simParam, crossPlan, motherIid, fatherIid, femaleMap, maleMap) { + keepRecHistGen <- .needRecHistGenFromCross(simParam) + useTsDirect <- .useTsForwardDirectCross(simParam) + returnTsSegGen <- .keepTsForwardSeg() + + childIidPred <- NULL + directAppendFn <- NULL + if (useTsDirect) { + childIidPred <- simParam$lastId + seq_len(nrow(crossPlan)) + childMotherIidPred <- motherIid[crossPlan[, 1]] + childFatherIidPred <- fatherIid[crossPlan[, 2]] + directAppendFn <- function(segChunk) { + .appendTsForwardRawIfActive( + simParam = simParam, + tsSegGenRaw = segChunk, + childIid = childIidPred, + motherIid = motherIid, + fatherIid = fatherIid, + childMotherIid = childMotherIidPred, + childFatherIid = childFatherIidPred, + femaleMap = femaleMap, + maleMap = maleMap + ) + } + } + + list( + keepRecHistGen = keepRecHistGen, + useTsDirect = useTsDirect, + returnTsSegGen = returnTsSegGen, + childIidPred = childIidPred, + directAppendFn = directAppendFn + ) +} + +.extractTsCrossRecGen <- function(tmp, simParam, keepRecHistGen) { + if (simParam$isTrackRecGen) { + return(list( + histGen = if (keepRecHistGen) tmp$recHistGen else NULL, + tsSegGenRaw = tmp$tsSegGen + )) + } + list(histGen = NULL, tsSegGenRaw = NULL) +} + +.finalizeTsForwardCross <- function(outPop, + tsSegGenRaw, + recorderAppended, + childIidPred, + femalePop, + malePop, + femaleMap, + maleMap) { + if (recorderAppended && !is.null(childIidPred) && + !identical(as.integer(outPop@iid), as.integer(childIidPred))) { + stop("Internal error: predicted child iid does not match realized iid in direct TS mode", call. = FALSE) + } + + if (is.null(tsSegGenRaw)) { + return(outPop) + } + + if (.keepTsForwardSeg()) { + tsSegGen <- .tsSegGenToTsPos(tsSegGenRaw, femaleMap, maleMap) + outPop@misc$tsSegGen <- .attachTsSegGenIds(tsSegGen, outPop, femalePop, malePop) + } + outPop +} + +#' Append raw meiosis tsSegGen matrix to forward TS recorder +#' +#' @param recorder output of `tsForwardInit()` +#' @param tsSegGen numeric matrix with columns +#' `childLocal, chr, hap, parentSide, parentIndex, parentHap, leftGen, rightGen` +#' @param childIid integer vector mapping child local index to iid +#' @param motherIid integer vector mapping mother parentIndex to iid +#' @param fatherIid integer vector mapping father parentIndex to iid +#' @param femaleMap female genetic maps +#' @param maleMap male genetic maps +#' @param simParam `SimParam` with pedigree +#' @return Updated recorder state +#' @keywords internal +#' @noRd +tsForwardAppendSegGenRaw <- function(recorder, + tsSegGen, + childIid, + motherIid, + fatherIid, + childMotherIid = NULL, + childFatherIid = NULL, + femaleMap, + maleMap, + simParam) { + stopifnot(inherits(recorder, "tsForwardRecorder")) + if (is.null(tsSegGen) || length(tsSegGen) == 0L || nrow(tsSegGen) == 0L) { + return(recorder) + } + seg <- as.matrix(tsSegGen) + if (ncol(seg) != 8L) { + stop("tsSegGen must have 8 columns", call. = FALSE) + } + + childIid <- as.integer(childIid) + motherIid <- as.integer(motherIid) + fatherIid <- as.integer(fatherIid) + if (!is.null(childMotherIid)) { + childMotherIid <- as.integer(childMotherIid) + } + if (!is.null(childFatherIid)) { + childFatherIid <- as.integer(childFatherIid) + } + + childLocal <- as.integer(seg[, 1]) + chr <- as.integer(seg[, 2]) + hap <- as.integer(seg[, 3]) + parentSide <- as.integer(seg[, 4]) + parentIndex <- as.integer(seg[, 5]) + parentHap <- as.integer(seg[, 6]) + leftGen <- as.numeric(seg[, 7]) + rightGen <- as.numeric(seg[, 8]) + nSeg <- length(childLocal) + + if (any(chr < 1L | chr > recorder$nChr)) { + stop("tsSegGen has chromosome index out of bounds", call. = FALSE) + } + if (any(hap < 1L | hap > recorder$ploidy)) { + stop("tsSegGen has child haplotype out of bounds", call. = FALSE) + } + if (any(parentHap < 1L)) { + stop("tsSegGen has invalid parent haplotype", call. = FALSE) + } + if (any(childLocal < 1L | childLocal > length(childIid))) { + stop("tsSegGen childLocal out of bounds", call. = FALSE) + } + if (any(!(parentSide %in% c(1L, 2L)))) { + stop("tsSegGen parentSide must be 1 or 2", call. = FALSE) + } + motherRows <- which(parentSide == 1L) + fatherRows <- which(parentSide == 2L) + if (any(parentIndex[motherRows] < 1L | parentIndex[motherRows] > length(motherIid))) { + stop("tsSegGen mother parentIndex out of bounds", call. = FALSE) + } + if (any(parentIndex[fatherRows] < 1L | parentIndex[fatherRows] > length(fatherIid))) { + stop("tsSegGen father parentIndex out of bounds", call. = FALSE) + } + + childIidBySeg <- childIid[childLocal] + if (!is.null(childMotherIid) || !is.null(childFatherIid)) { + if (is.null(childMotherIid) || is.null(childFatherIid)) { + stop("Both childMotherIid and childFatherIid must be supplied together", call. = FALSE) + } + if (length(childMotherIid) != length(childIid) || + length(childFatherIid) != length(childIid)) { + stop("childMotherIid/childFatherIid must match length(childIid)", call. = FALSE) + } + if (anyDuplicated(childIid) > 0L) { + stop("childIid must be unique when child parent iid vectors are provided", call. = FALSE) + } + } + parentIid <- integer(nSeg) + parentIid[motherRows] <- motherIid[parentIndex[motherRows]] + parentIid[fatherRows] <- fatherIid[parentIndex[fatherRows]] + + if (is.null(recorder$posMeta)) { + recorder$posMeta <- .tsForwardResolvePosMeta() + } + posMeta <- recorder$posMeta + intervals <- .tsForwardSegGenToTsIntervals( + chr = chr, + parentSide = parentSide, + leftGen = leftGen, + rightGen = rightGen, + femaleMap = femaleMap, + maleMap = maleMap, + posMeta = posMeta + ) + left <- intervals$left + right <- intervals$right + + recorder$indTime <- .tsForwardUpdateIndTimeCache(recorder$indTime, simParam$pedigree) + indTime <- recorder$indTime + for (cc in seq_len(recorder$nChr)) { + chrState <- recorder$chr[[cc]] + idxChr <- which(chr == cc) + if (length(idxChr) == 0L) { + next + } + + # For direct append mode, child pedigree rows may not exist yet. + # Derive a fallback child-node time from parent node times in this chunk. + parentMinTimeByChildNodeKey <- new.env(parent = emptyenv(), hash = TRUE) + pKeysChr <- .tsForwardNodeKey(parentIid[idxChr], parentHap[idxChr]) + cKeysChr <- .tsForwardNodeKey(childIidBySeg[idxChr], hap[idxChr]) + for (k in seq_along(idxChr)) { + pKey <- pKeysChr[[k]] + cKey <- cKeysChr[[k]] + if (!exists(pKey, envir = chrState$nodeMap, inherits = FALSE)) { + next + } + pNode <- as.integer(get(pKey, envir = chrState$nodeMap, inherits = FALSE)) + pTime <- as.numeric(chrState$tc$node_table_get_row(pNode)$time) + if (!is.finite(pTime)) { + next + } + if (!exists(cKey, envir = parentMinTimeByChildNodeKey, inherits = FALSE)) { + assign(cKey, pTime, envir = parentMinTimeByChildNodeKey) + } else { + old <- as.numeric(get(cKey, envir = parentMinTimeByChildNodeKey, inherits = FALSE)) + if (pTime < old) { + assign(cKey, pTime, envir = parentMinTimeByChildNodeKey) + } + } + } + + children <- unique(childIidBySeg[idxChr]) + .tsForwardEnsureChildrenIndividuals( + chrState = chrState, + children = children, + simParam = simParam, + cc = cc, + childIid = childIid, + childMotherIid = childMotherIid, + childFatherIid = childFatherIid + ) + + childNodeKeys <- unique(.tsForwardNodeKey(childIidBySeg[idxChr], hap[idxChr])) + missingKeys <- childNodeKeys[!vapply(childNodeKeys, exists, logical(1), + envir = chrState$nodeMap, inherits = FALSE)] + if (length(missingKeys) > 0L) { + keyInfo <- .tsForwardParseNodeKeys(missingKeys) + nodeTimes <- numeric(length(missingKeys)) + for (j in seq_along(missingKeys)) { + iid <- keyInfo$iids[[j]] + t <- NA_real_ + if (iid <= length(indTime)) { + t <- indTime[[iid]] + } + if (!is.finite(t) && + exists(missingKeys[[j]], envir = parentMinTimeByChildNodeKey, inherits = FALSE)) { + t <- as.numeric(get(missingKeys[[j]], + envir = parentMinTimeByChildNodeKey, + inherits = FALSE)) - 1 + } + if (!is.finite(t) && !is.null(childMotherIid) && !is.null(childFatherIid)) { + ii <- match(iid, childIid) + if (!is.na(ii)) { + mIid <- childMotherIid[[ii]] + fIid <- childFatherIid[[ii]] + if (mIid <= length(indTime) && fIid <= length(indTime)) { + t <- min(indTime[[mIid]], indTime[[fIid]]) - 1 + } + } + } + if (!is.finite(t)) { + stop("Could not resolve node time for child iid ", iid, " on chr ", cc, call. = FALSE) + } + nodeTimes[[j]] <- t + } + .tsForwardAddMissingChildNodes(chrState, missingKeys, nodeTimes) + } + + .tsForwardAppendEdgesByKeys( + chrState = chrState, + left = left[idxChr], + right = right[idxChr], + parentKeys = pKeysChr, + childKeys = cKeysChr, + cc = cc + ) + } + + recorder +} + +.tsForwardHasSourceFields <- function(x) { + is.list(x) && ( + !is.null(x[["ts_path"]]) || + !is.null(x[["ts"]]) || + !is.null(x[["ts_xptr"]]) || + !is.null(x[["tc_xptr"]]) || + !is.null(x[["table_xptr"]]) + ) +} + +.tsForwardSourceByChr <- function(founderPop) { + nChr <- founderPop@nChr + src <- attr(founderPop, "tsForwardSource", exact = TRUE) + if (is.null(src)) { + stop( + "No TS source found on founderPop. Build founders with asMapPop() before setTrackTs().", + call. = FALSE + ) + } + if (!is.list(src) || length(src) != nChr) { + stop("Invalid TS source metadata on founderPop", call. = FALSE) + } + for (cc in seq_len(nChr)) { + if (!.tsForwardHasSourceFields(src[[cc]])) { + stop("Missing TS source for chromosome ", cc, call. = FALSE) + } + } + src +} + +.tsForwardPosMetaFromFounder <- function(founderPop) { + meta <- attr(founderPop, "tsForwardPosMeta", exact = TRUE) + if (is.null(meta)) { + meta <- .tsForwardResolvePosMeta() + } + if (is.null(meta) || is.null(meta$posList) || is.null(meta$seqLenList)) { + stop( + "Missing TS position metadata on founderPop. Build founders with asMapPop() before setTrackTs().", + call. = FALSE + ) + } + if (length(meta$posList) != founderPop@nChr || length(meta$seqLenList) != founderPop@nChr) { + stop("TS position metadata length does not match number of chromosomes", call. = FALSE) + } + if ((!is.null(meta$breaksList) && length(meta$breaksList) != founderPop@nChr) || + (!is.null(meta$ratesList) && length(meta$ratesList) != founderPop@nChr)) { + stop("TS rate-map metadata length does not match number of chromosomes", call. = FALSE) + } + meta +} + +#' Initialize forward TS recorder state +#' +#' @param founderPop founder/sample population used to seed TS node maps +#' @return Recorder state object for `tsForwardAppendSeg()` / `tsForwardFinalize()` +#' @keywords internal +#' @noRd +tsForwardInit <- function(founderPop) { + stopifnot(is(founderPop, "Pop") || is(founderPop, "MapPop")) + + nChr <- founderPop@nChr + founderIid <- if (is(founderPop, "Pop")) { + as.integer(founderPop@iid) + } else { + as.integer(seq_len(founderPop@nInd)) + } + sourceByChr <- .tsForwardSourceByChr(founderPop) + posMeta <- .tsForwardPosMetaFromFounder(founderPop) + + out <- list( + chr = vector("list", nChr), + ploidy = founderPop@ploidy, + nChr = nChr, + ts_path = lapply(sourceByChr, function(x) x[["ts_path"]]), + posMeta = posMeta, + indTime = numeric(0) + ) + + for (cc in seq_len(nChr)) { + src <- sourceByChr[[cc]] + tsObj <- asMapPop_load_ts( + ts_path = src[["ts_path"]], + ts = src[["ts"]], + ts_xptr = src[["ts_xptr"]], + tc_xptr = src[["tc_xptr"]], + table_xptr = src[["table_xptr"]] + ) + tc <- tsObj$dump_tables() + samples <- tsObj$samples() + expected <- founderPop@nInd * founderPop@ploidy + if (length(samples) != expected) { + stop("Sample node count does not match founderPop nInd*ploidy on chr ", cc, call. = FALSE) + } + + nodeMap <- new.env(parent = emptyenv(), hash = TRUE) + indMap <- new.env(parent = emptyenv(), hash = TRUE) + + idx <- 1L + for (ind in seq_len(founderPop@nInd)) { + iid <- founderIid[[ind]] + indRow <- tc$node_table_get_row(as.integer(samples[[idx]]))$individual + if (indRow < 0L) { + stop("Sample node has individual = -1 on chr ", cc, call. = FALSE) + } + assign(as.character(iid), as.integer(indRow), envir = indMap) + for (h in seq_len(founderPop@ploidy)) { + key <- .tsForwardNodeKey(iid, h) + assign(key, as.integer(samples[[idx]]), envir = nodeMap) + idx <- idx + 1L + } + } + + out$chr[[cc]] <- list( + tc = tc, + nodeMap = nodeMap, + indMap = indMap, + seqLen = as.numeric(tc$sequence_length()) + ) + } + + class(out) <- "tsForwardRecorder" + out +} + +#' Append one segment table to forward TS recorder +#' +#' @param recorder output of `tsForwardInit()` +#' @param seg segment data frame with `tsSegGen`-style columns +#' @param simParam `SimParam` with pedigree +#' @return Updated recorder state +#' @keywords internal +#' @noRd +tsForwardAppendSeg <- function(recorder, seg, simParam) { + stopifnot(inherits(recorder, "tsForwardRecorder")) + + if (is.null(seg) || nrow(seg) == 0L) { + return(recorder) + } + + requiredCols <- c("chr", "hap", "childIid", "parentIid", "parentHap", "left", "right") + miss <- setdiff(requiredCols, names(seg)) + if (length(miss) > 0L) { + stop("tsSegGen missing columns: ", paste(miss, collapse = ", "), call. = FALSE) + } + + recorder$indTime <- .tsForwardUpdateIndTimeCache(recorder$indTime, simParam$pedigree) + indTime <- recorder$indTime + + for (cc in seq_len(recorder$nChr)) { + chrState <- recorder$chr[[cc]] + df <- seg[seg$chr == cc, , drop = FALSE] + if (nrow(df) == 0L) { + next + } + + children <- unique(as.integer(df$childIid)) + .tsForwardEnsureChildrenIndividuals( + chrState = chrState, + children = children, + simParam = simParam, + cc = cc + ) + + childNodeKeys <- unique(.tsForwardNodeKey(df$childIid, df$hap)) + missingKeys <- childNodeKeys[!vapply(childNodeKeys, exists, logical(1), + envir = chrState$nodeMap, inherits = FALSE)] + if (length(missingKeys) > 0L) { + keyInfo <- .tsForwardParseNodeKeys(missingKeys) + nodeTimes <- as.numeric(indTime[keyInfo$iids]) + .tsForwardAddMissingChildNodes(chrState, missingKeys, nodeTimes) + } + + pKeys <- .tsForwardNodeKey(df$parentIid, df$parentHap) + cKeys <- .tsForwardNodeKey(df$childIid, df$hap) + .tsForwardAppendEdgesByKeys( + chrState = chrState, + left = df$left, + right = df$right, + parentKeys = pKeys, + childKeys = cKeys, + cc = cc + ) + } + + recorder +} + +.tsForwardNormalizeSamplesByChr <- function(samples, nChr) { + if (is.null(samples)) { + return(NULL) + } + if (is.atomic(samples) && !is.list(samples)) { + one <- as.integer(unique(samples)) + one <- one[is.finite(one) & !is.na(one)] + return(rep(list(one), nChr)) + } + if (!is.list(samples)) { + stop("samples must be NULL, an integer vector, or a list of integer vectors", call. = FALSE) + } + if (length(samples) == 1L && nChr > 1L) { + one <- as.integer(unique(samples[[1L]])) + one <- one[is.finite(one) & !is.na(one)] + return(rep(list(one), nChr)) + } + if (length(samples) != nChr) { + stop("samples list length must equal number of chromosomes (", nChr, ")", call. = FALSE) + } + out <- vector("list", nChr) + for (cc in seq_len(nChr)) { + x <- as.integer(unique(samples[[cc]])) + x <- x[is.finite(x) & !is.na(x)] + out[[cc]] <- x + } + out +} + +.tsForwardDefaultSamplesByChr <- function(recorder, indTime) { + has_ind_time <- !(is.null(indTime) || length(indTime) == 0L || !any(is.finite(indTime))) + lastIid <- integer(0) + if (has_ind_time) { + lastTime <- min(indTime[is.finite(indTime)]) + lastIid <- which(indTime == lastTime) + } + + out <- vector("list", recorder$nChr) + for (cc in seq_len(recorder$nChr)) { + nodeMap <- recorder$chr[[cc]]$nodeMap + nNode <- as.integer(recorder$chr[[cc]]$tc$num_nodes()) + + if (length(lastIid) > 0L) { + keys <- as.vector(outer(lastIid, seq_len(recorder$ploidy), paste, sep = "_")) + keep <- vapply(keys, exists, logical(1), envir = nodeMap, inherits = FALSE) + keys <- keys[keep] + if (length(keys) > 0L) { + ids <- as.integer(vapply(keys, function(k) { + get(k, envir = nodeMap, inherits = FALSE) + }, integer(1))) + ids <- ids[ids >= 0L & ids < nNode] + if (length(ids) > 0L) { + out[[cc]] <- sort(unique(ids)) + next + } + } + } + + # Fallback: derive "last generation" from node times in recorder maps. + allKeys <- ls(nodeMap, all.names = TRUE) + if (length(allKeys) == 0L) { + stop("Cannot infer default samples: empty node map on chromosome ", cc, call. = FALSE) + } + nodeIds <- as.integer(vapply(allKeys, function(k) { + get(k, envir = nodeMap, inherits = FALSE) + }, integer(1))) + nodeIds <- nodeIds[nodeIds >= 0L & nodeIds < nNode] + nodeIds <- unique(nodeIds) + if (length(nodeIds) == 0L) { + stop("Cannot infer default samples: no valid node ids in node map on chromosome ", cc, call. = FALSE) + } + times <- as.numeric(vapply(nodeIds, function(nid) { + recorder$chr[[cc]]$tc$node_table_get_row(as.integer(nid))$time + }, numeric(1))) + ok <- is.finite(times) + if (!any(ok)) { + stop("Cannot infer default samples: no finite node times on chromosome ", cc, call. = FALSE) + } + tmin <- min(times[ok]) + out[[cc]] <- sort(unique(nodeIds[ok & times == tmin])) + if (length(out[[cc]]) == 0L) { + stop("Cannot infer default samples from node times on chromosome ", cc, call. = FALSE) + } + } + out +} + +.tsForwardResolveSamplesByChr <- function(recorder, samples, indTime) { + out <- .tsForwardNormalizeSamplesByChr(samples, recorder$nChr) + if (is.null(out)) { + out <- .tsForwardDefaultSamplesByChr(recorder, indTime) + } + for (cc in seq_len(recorder$nChr)) { + x <- as.integer(out[[cc]]) + if (length(x) == 0L) { + stop("samples for chromosome ", cc, " cannot be empty", call. = FALSE) + } + nNode <- as.integer(recorder$chr[[cc]]$tc$num_nodes()) + if (any(x < 0L | x >= nNode)) { + stop("samples out of bounds on chromosome ", cc, call. = FALSE) + } + out[[cc]] <- sort(unique(x)) + } + out +} + +.tsForwardCurrentSampleNodes <- function(tc) { + nNode <- as.integer(tc$num_nodes()) + if (nNode <= 0L) { + return(integer(0)) + } + out <- integer(0) + for (i in seq_len(nNode) - 1L) { + fl <- as.integer(tc$node_table_get_row(i)$flags) + if (isTRUE(bitwAnd(fl, 1L) != 0L)) { + out <- c(out, i) + } + } + out +} + +.tsForwardPastIndividualNodes <- function(tc) { + nNode <- as.integer(tc$num_nodes()) + if (nNode <= 0L) { + return(integer(0)) + } + out <- integer(0) + for (i in seq_len(nNode) - 1L) { + node <- tc$node_table_get_row(i) + t <- as.numeric(node$time) + ind <- as.integer(node$individual) + if (is.finite(t) && t > 0 && !is.na(ind) && ind != -1L) { + out <- c(out, i) + } + } + out +} + +.tsForwardOutputDirForChr <- function(recorder, cc, out_dir = NULL) { + if (!is.null(out_dir)) { + return(out_dir) + } + ts_path <- recorder$ts_path[[cc]] + if (!is.null(ts_path) && is.character(ts_path) && nzchar(ts_path)) { + return(dirname(ts_path)) + } + getwd() +} + +#' Finalize forward recorder into per-chromosome TreeSequence objects +#' +#' @param recorder output of `tsForwardInit()` +#' @param simplify logical; if TRUE, call table-collection simplify before dump +#' @param keep_unary logical; passed to `tc$simplify(keep_unary=...)` when `simplify=TRUE`. +#' Default is TRUE. +#' @param update_sample_flags logical; passed to `tc$simplify(update_sample_flags=...)` +#' when `simplify=TRUE`. Default is FALSE. +#' @param samples NULL (default: last generation nodes), integer vector (all chromosomes), +#' or list of integer vectors by chromosome +#' @param keep_existing_samples logical; if TRUE (default), keep founder/original sample +#' flags and add requested samples on top. If FALSE, replace sample flags with requested samples. +#' @param indTime optional individual-time vector; used only for default sample inference +#' @param update_samples logical; if TRUE apply sample selection/flags before sort/simplify. +#' Default is FALSE for raw finalize behavior. +#' @return list of `RcppTskit::TreeSequence` objects (one per chromosome) +#' @keywords internal +#' @noRd +tsForwardFinalize <- function(recorder, + simplify = FALSE, + keep_unary = TRUE, + update_sample_flags = FALSE, + samples = NULL, + keep_existing_samples = TRUE, + indTime = NULL, + update_samples = FALSE) { + stopifnot(inherits(recorder, "tsForwardRecorder")) + stopifnot(is.logical(simplify), length(simplify) == 1L, !is.na(simplify)) + stopifnot(is.logical(keep_unary), length(keep_unary) == 1L, !is.na(keep_unary)) + stopifnot(is.logical(update_sample_flags), length(update_sample_flags) == 1L, !is.na(update_sample_flags)) + stopifnot(is.logical(keep_existing_samples), length(keep_existing_samples) == 1L, !is.na(keep_existing_samples)) + stopifnot(is.logical(update_samples), length(update_samples) == 1L, !is.na(update_samples)) + + useDefaultSamples <- is.null(samples) + samplesByChr <- NULL + if (isTRUE(update_samples)) { + samplesByChr <- .tsForwardResolveSamplesByChr(recorder, samples, indTime) + } + + ts_list <- vector("list", recorder$nChr) + for (cc in seq_len(recorder$nChr)) { + chrState <- recorder$chr[[cc]] + + sampleNodes <- NULL + if (isTRUE(update_samples)) { + sampleNodes <- as.integer(samplesByChr[[cc]]) + if (isTRUE(simplify) && isTRUE(useDefaultSamples)) { + sampleNodes <- c( + .tsForwardCurrentSampleNodes(chrState$tc), + sampleNodes + ) + } + if (isTRUE(keep_existing_samples)) { + extraSampleNodes <- integer(0) + if (isTRUE(simplify) && isTRUE(useDefaultSamples)) { + extraSampleNodes <- c( + extraSampleNodes, + .tsForwardPastIndividualNodes(chrState$tc) + ) + } + sampleNodes <- sort(unique(c(extraSampleNodes, sampleNodes))) + } else { + sampleNodes <- sort(unique(sampleNodes)) + } + } + + tcOut <- chrState$tc$clone() + if (isTRUE(update_samples) && !isTRUE(simplify)) { + tsForwardSetSampleFlags(tcOut, sampleNodes, clearExisting = !isTRUE(keep_existing_samples)) + } + tcOut$sort() + if (isTRUE(simplify)) { + if (is.null(sampleNodes)) { + sampleNodes <- .tsForwardCurrentSampleNodes(tcOut) + } + tcOut$simplify( + samples = sampleNodes, + keep_unary = keep_unary, + update_sample_flags = update_sample_flags + ) + tcOut$sort() + } + + ts_list[[cc]] <- tcOut$tree_sequence() + } + ts_list +} + +#' Convert table/TS objects to tree sequences and write all chromosomes +#' +#' @param ts_list list of `RcppTskit::TreeSequence`, table collections, or table pointers +#' @param out_dir output directory, default uses `recorder` source dirs +#' @param out_basename output basename prefix +#' @param recorder optional recorder for default output-directory resolution +#' @return character vector of written files +#' @keywords internal +#' @noRd +tsForwardWriteTreeSequences <- function(ts_list, + out_dir = NULL, + out_basename = "AlphaSimR_forward", + recorder = NULL) { + stopifnot(is.list(ts_list), length(ts_list) > 0L) + nChr <- length(ts_list) + if (is.null(out_dir) && is.null(recorder)) { + stop("Provide out_dir or recorder for output-path resolution", call. = FALSE) + } + if (!is.null(recorder)) { + stopifnot(inherits(recorder, "tsForwardRecorder")) + if (recorder$nChr != nChr) { + stop("recorder chromosome count does not match ts_list length", call. = FALSE) + } + } + + .as_ts <- function(x) { + if (inherits(x, "externalptr")) { + tc <- RcppTskit::TableCollection$new(xptr = x) + return(tc$tree_sequence()) + } + if (!is.null(x$dump) && is.function(x$dump)) { + return(x) + } + if (!is.null(x$tree_sequence) && is.function(x$tree_sequence)) { + return(x$tree_sequence()) + } + stop("Each entry in ts_list must be a TreeSequence, table collection, or table pointer", call. = FALSE) + } + + out_paths <- character(nChr) + for (cc in seq_len(nChr)) { + outDirCc <- if (!is.null(recorder)) { + .tsForwardOutputDirForChr(recorder, cc, out_dir = out_dir) + } else { + out_dir + } + outPath <- file.path(outDirCc, paste0(out_basename, "_chr", cc - 1, ".trees")) + ts_obj <- .as_ts(ts_list[[cc]]) + ts_obj$dump(outPath) + out_paths[[cc]] <- outPath + } + out_paths +} + +#' Get recorder from SimParam attribute +#' @keywords internal +#' @noRd +.tsForwardGetRecorder <- function(simParam) { + rec <- attr(simParam, "tsForwardRecorder", exact = TRUE) + if (is.null(rec)) { + return(NULL) + } + if (!inherits(rec, "tsForwardRecorder")) { + stop("simParam attr 'tsForwardRecorder' is not a tsForwardRecorder object", call. = FALSE) + } + rec +} + +#' Set recorder on SimParam attribute +#' @keywords internal +#' @noRd +.tsForwardSetRecorder <- function(simParam, recorder) { + if (!is.null(recorder) && !inherits(recorder, "tsForwardRecorder")) { + stop("recorder must be NULL or a tsForwardRecorder object", call. = FALSE) + } + attr(simParam, "tsForwardRecorder") <- recorder + invisible(simParam) +} + +#' Check Whether a Forward Tree-Sequence Recorder Is Attached +#' +#' @description +#' Returns whether a \code{\link{SimParam}} object currently has an attached +#' forward tree-sequence recorder. +#' +#' @param simParam \code{\link{SimParam}} object. +#' +#' @return Logical scalar. +#' +#' @examples +#' \dontrun{ +#' founderPop = runMacsTS(nInd=10, nChr=1, segSites=100) +#' SP = SimParam$new(founderPop) +#' tsForwardHasRecorder(SP) +#' SP$setTrackTs(TRUE, founderPop=founderPop) +#' tsForwardHasRecorder(SP) +#' } +#' +#' @export +tsForwardHasRecorder <- function(simParam) { + !is.null(.tsForwardGetRecorder(simParam)) +} + +#' Initialize and attach a forward recorder to SimParam +#' @param simParam SimParam object +#' @param founderPop founder/sample population used to seed the recorder node map +#' @return invisibly returns simParam +#' @keywords internal +#' @noRd +tsForwardInitOnSimParam <- function(simParam, founderPop) { + stopifnot(inherits(simParam, "SimParam")) + stopifnot(is(founderPop, "Pop") || is(founderPop, "MapPop")) + rec <- tsForwardInit(founderPop = founderPop) + .tsForwardSetRecorder(simParam, rec) +} + +.tsForwardFinalizeWriteFromSimParam <- function(simParam, + out_dir = NULL, + out_basename = "AlphaSimR_forward", + simplify = FALSE, + keep_unary = TRUE, + update_sample_flags = FALSE, + samples = NULL, + keep_existing_samples = TRUE, + clear = FALSE, + update_samples = FALSE) { + rec <- .tsForwardGetRecorder(simParam) + if (is.null(rec)) { + stop("No tsForwardRecorder attached to simParam", call. = FALSE) + } + indTime <- .tsForwardUpdateIndTimeCache(rec$indTime, simParam$pedigree) + rec$indTime <- indTime + ts_list <- tsForwardFinalize( + recorder = rec, + simplify = simplify, + keep_unary = keep_unary, + update_sample_flags = update_sample_flags, + samples = samples, + keep_existing_samples = keep_existing_samples, + indTime = indTime, + update_samples = update_samples + ) + out_paths <- tsForwardWriteTreeSequences( + ts_list = ts_list, + out_dir = out_dir, + out_basename = out_basename, + recorder = rec + ) + if (isTRUE(clear)) { + .tsForwardSetRecorder(simParam, NULL) + } else { + .tsForwardSetRecorder(simParam, rec) + } + out_paths +} + +#' Finalize Forward Tree-Sequence Recording from SimParam +#' +#' @description +#' Finalizes the forward tree-sequence recorder attached to a +#' \code{\link{SimParam}} object and writes one \code{.trees} file per +#' chromosome. +#' +#' @param simParam \code{\link{SimParam}} object with an attached recorder, +#' usually initialized with \code{simParam$setTrackTs(TRUE, founderPop=...)}. +#' @param out_dir output directory. If \code{NULL}, output paths are resolved +#' from the founder tree-sequence source when possible. +#' @param out_basename output basename. +#' @param simplify logical; if \code{TRUE}, call table-collection simplify +#' before writing. +#' @param keep_unary logical; passed to \code{tc$simplify(keep_unary=...)} when +#' \code{simplify=TRUE}. +#' @param update_sample_flags logical; passed to +#' \code{tc$simplify(update_sample_flags=...)} when \code{simplify=TRUE}. +#' Default is \code{FALSE}. +#' @param samples optional sample set used when simplifying or when +#' \code{keep_existing_samples = FALSE}. +#' @param keep_existing_samples logical; if \code{TRUE}, keep founder/original +#' sample flags when sample updates are requested. +#' @param clear logical; if \code{TRUE}, clear the recorder from +#' \code{simParam} after writing. +#' +#' @return Character vector of output tree file paths. +#' +#' @examples +#' \dontrun{ +#' founderPop = runMacsTS(nInd=10, nChr=1, segSites=100) +#' SP = SimParam$new(founderPop) +#' SP$setTrackTs(TRUE, founderPop=founderPop) +#' paths = tsForwardFinalizeFromSimParam(SP, out_dir=tempdir(), +#' out_basename="AlphaSimR_forward", +#' clear=TRUE) +#' } +#' +#' @export +tsForwardFinalizeFromSimParam <- function(simParam, + out_dir = NULL, + out_basename = "AlphaSimR_forward", + simplify = FALSE, + keep_unary = TRUE, + update_sample_flags = FALSE, + samples = NULL, + keep_existing_samples = TRUE, + clear = FALSE) { + use_sample_updates <- !is.null(samples) || !isTRUE(keep_existing_samples) || isTRUE(simplify) + .tsForwardFinalizeWriteFromSimParam( + simParam = simParam, + out_dir = out_dir, + out_basename = out_basename, + simplify = simplify, + keep_unary = keep_unary, + update_sample_flags = update_sample_flags, + samples = samples, + keep_existing_samples = keep_existing_samples, + clear = clear, + update_samples = use_sample_updates + ) +} + +#' Write Forward Tree Sequences from SimParam with Explicit Samples +#' +#' @description +#' Writes the recorder attached to a \code{\link{SimParam}} object with optional +#' sample updates and simplification. This is a lower-level variant of +#' \code{\link{tsForwardFinalizeFromSimParam}} for workflows that need direct +#' control over sampled nodes. +#' +#' @param simParam \code{\link{SimParam}} object with an attached recorder. +#' @param out_dir output directory. +#' @param out_basename output basename. +#' @param simplify logical; if \code{TRUE}, call table-collection simplify +#' before writing. +#' @param keep_unary logical; passed to \code{tc$simplify(keep_unary=...)} when +#' \code{simplify=TRUE}. Default is \code{TRUE}. +#' @param update_sample_flags logical; passed to +#' \code{tc$simplify(update_sample_flags=...)} when \code{simplify=TRUE}. +#' Default is \code{FALSE}. +#' @param samples \code{NULL} for default last-generation samples, an integer +#' vector used for all chromosomes, or a list of integer vectors by chromosome. +#' @param keep_existing_samples logical; if \code{TRUE}, keep founder/original +#' sample flags and add requested samples on top. +#' @param clear logical; if \code{TRUE}, clear the recorder from +#' \code{simParam} after writing. +#' +#' @return Character vector of output tree file paths. +#' +#' @examples +#' \dontrun{ +#' founderPop = runMacsTS(nInd=10, nChr=1, segSites=100) +#' SP = SimParam$new(founderPop) +#' SP$setTrackTs(TRUE, founderPop=founderPop) +#' paths = tsForwardWriteTreesFromSimParam(SP, out_dir=tempdir(), +#' simplify=TRUE) +#' } +#' +#' @export +tsForwardWriteTreesFromSimParam <- function(simParam, + out_dir = NULL, + out_basename = "AlphaSimR_forward", + simplify = FALSE, + keep_unary = TRUE, + update_sample_flags = FALSE, + samples = NULL, + keep_existing_samples = TRUE, + clear = FALSE) { + .tsForwardFinalizeWriteFromSimParam( + simParam = simParam, + out_dir = out_dir, + out_basename = out_basename, + simplify = simplify, + keep_unary = keep_unary, + update_sample_flags = update_sample_flags, + samples = samples, + keep_existing_samples = keep_existing_samples, + clear = clear, + update_samples = TRUE + ) +} diff --git a/dev/alphaSimR2Ts.R b/dev/alphaSimR2Ts.R new file mode 100644 index 00000000..e8b1f704 --- /dev/null +++ b/dev/alphaSimR2Ts.R @@ -0,0 +1,275 @@ +library(jsonlite) + +recHistMatToSegDf <- function(histMat, nLoci) { + + origin <- as.integer(histMat[, 1]) + starts <- as.integer(histMat[, 2]) + + ends <- c(starts[-1] - 1L, nLoci) + + data.frame( + origin = origin, + locusStart = starts, + locusEnd = ends, + stringsAsFactors = FALSE + ) +} + + +recHistToSegDfWithParents <- function(SP, offspringPop, nLociByChr) { + childIds <- offspringPop@id + ped <- SP$pedigree[childIds, , drop = FALSE] + + out <- list() + k <- 1 + + for (childId in childIds) { + x <- SP$recHist[[childId]] + + motherId <- ped[childId, "mother"] + fatherId <- ped[childId, "father"] + + for (cc in seq_along(x)) { + nLoci <- nLociByChr[[cc]] + + haps <- as.vector(x[[cc]]) + nHap <- length(haps) + + for (h in seq_len(nHap)) { + seg <- recHistMatToSegDf(haps[[h]], nLoci = nLoci) + + parentId <- if (h <= nHap/2) motherId else fatherId + + seg$childId <- childId + seg$chr <- cc + seg$hap <- h + seg$parentId <- parentId + + seg$parentHap <- seg$origin + seg$parentGlobalHapId <- (parentId - 1) * nHap + seg$parentHap + + out[[k]] <- seg[, c("childId", "hap", "chr", + "locusStart","locusEnd", + "parentId","parentHap","parentGlobalHapId")] + k <- k + 1 + } + } + } + + do.call(rbind, out) +} + +bridgeCollectSegFromSimOutput <- function(SP, simOutput) { + bridgeSegDfList <<- list() + + nLociByChr <- lapply(chrKeptPosBpList, length) + + for (k in 2:length(simOutput)) { + segDf <- recHistToSegDfWithParents(SP, simOutput[[k]], nLociByChr) + bridgeSegDfList[[length(bridgeSegDfList) + 1]] <<- segDf + } + + invisible(bridgeSegDfList) +} + + +segDfToEdgeDfUsingBridge <- function(segDf, chr_info) { + # segDF: childID, hap, chr, locusStart, locusEnd, origin + out <- segDf + out$left <- NA_real_ + out$right <- NA_real_ + + for (cc in sort(unique(out$chr))) { + #posBp <- bridgeEnv$chrKeptPosBpList[[cc]] + #if (is.null(posBp)) stop("bridgeEnv$chrKeptPosBpList[[", cc, "]] is NULL.") + posBp <- chrKeptPosBpList[[cc]] + + tsPath <- chr_info[[cc]]$ts_path + ts <- tskit$load(tsPath) + seqLen <- as.numeric(ts$sequence_length) + + idx <- which(out$chr == cc) + + for (i in idx) { + s <- out$locusStart[i] + e <- out$locusEnd[i] + out$left[i] <- if (s == 1) 0 else posBp[s] + out$right[i] <- if (e < length(posBp)) posBp[e + 1] else seqLen + } + } + out +} + +bridgeAllSegToEdgeDf <- function(chr_info) { + allSeg <- do.call(rbind, bridgeSegDfList) + + out <- allSeg + out$left <- NA + out$right <- NA + + for (cc in sort(unique(out$chr))) { + posBp <- chrKeptPosBpList[[cc]] + + tsPath <- chr_info[[cc]]$ts_path + tc <- tc_load(tsPath) + seqLen <- tc$sequence_length() + + idx <- which(out$chr == cc) + for (i in idx) { + s <- out$locusStart[i] + e <- out$locusEnd[i] + out$left[i] <- if (s == 1) 0 else posBp[s] + out$right[i] <- if (e < length(posBp)) posBp[e + 1] else seqLen + } + } + + out +} + +bridgeComputeIndTime <- function(pedigree) { + n <- nrow(pedigree) + indTime <- rep(NA, n) + + for (i in 1:n) { + m <- pedigree[i, "mother"] + f <- pedigree[i, "father"] + + if (m == 0 && f == 0) { + indTime[i] <- 0 + } else { + indTime[i] <- min(indTime[m], indTime[f]) - 1 + } + } + + indTime +} + + +bridgeWriteTrees <- function(chr_info, edgeDf, SP, out_dir = NULL, + out_basename = "AlphaSimR_extended") { + + indTime <- bridgeComputeIndTime(SP$pedigree) + + nodeIdMapByChr <<- vector("list", length(chr_info)) + indIdMapByChr <<- vector("list", length(chr_info)) + + for (cc in seq_along(chr_info)) { + + nodeIdMapByChr[[cc]] <<- list() + indIdMapByChr[[cc]] <<- list() + + ts <- ts_load(chr_info[[cc]]$ts_path) + tc <- ts$dump_tables() + + df <- edgeDf[edgeDf$chr == cc, , drop = FALSE] + if (nrow(df) == 0) next + + # get indIDs for sampled nodes + sampNodeId <- ts$samples() + sampIndRow <- integer(length(sampNodeId)) + for (i in seq_along(sampNodeId)) { + sampIndRow[i] <- tc$node_table_get_row(sampNodeId[i])$individual + } + if (any(sampIndRow < 0)) { + bad <- which(sampIndRow < 0)[1] + stop( + "Sample node", sampNodeId[bad], "has individual = -1. ", + "Cannot reuse founders' individuals. ", + ) + } + + nFounder <- length(sampNodeId) / ploidy + idx <- 1 + for (ind in 1:nFounder) { + indRow <- sampIndRow[idx] + indIdMapByChr[[cc]][[as.character(ind)]] <<- indRow + + for (h in 1:ploidy) { + nodeId <- as.integer(unlist(sampNodeId[[idx]]))[1] + key <- paste(ind, h, sep = "_") + nodeIdMapByChr[[cc]][[key]] <<- nodeId + # list(alphaSimR = list(id = key))) + idx <- idx + 1 + } + } + + # add indIDs for offSpring nodes + nextInd <- as.integer(tc$num_individuals()) + addNewIndividual <- function(alphaId) { + key <- as.character(alphaId) + if (!is.null(indIdMapByChr[[cc]][[key]])) return(indIdMapByChr[[cc]][[key]]) + + m <- SP$pedigree[alphaId, "mother"] + f <- SP$pedigree[alphaId, "father"] + + mRow <- addNewIndividual(m) + fRow <- addNewIndividual(f) + + newId <- nextInd + tc$individual_table_add_row( + parents = list(as.integer(mRow), as.integer(fRow)), + metadata = charToRaw(toJSON( + list(file_id=as.integer(newId)), + auto_unbox = TRUE))) + + indIdMapByChr[[cc]][[key]] <<- as.integer(newId) + + nextInd <<- nextInd + 1L + newId + } + + childIdsNeeded <- sort(as.integer(unique(df$childId))) + for (childId in childIdsNeeded) { + addNewIndividual(childId) + } + + # append child nodes + childKeys <- unique(paste(df$childId, df$hap, sep = "_")) + for (key in childKeys) { + if (is.null(nodeIdMapByChr[[cc]][[key]])) { + childId <- as.integer(sub("_.*$", "", key)) + indRow <- indIdMapByChr[[cc]][[as.character(childId)]] + + tc$node_table_add_row( + flags = 0L, + time = indTime[[childId]], + population = -1L, + individual = indRow, + metadata = as.character(toJSON( + list(alphaSimR = list(id = key)), + auto_unbox = TRUE, force = TRUE)) + ) + nodeIdMapByChr[[cc]][[key]] <<- as.integer(tc$num_nodes() - 1) + } + } + + # append edges + for (i in 1:nrow(df)) { + parentKey <- paste(df$parentId[i], df$parentHap[i], sep = "_") + childKey <- paste(df$childId[i], df$hap[i], sep = "_") + + if (is.null(nodeIdMapByChr[[cc]][[parentKey]])) { + stop("Missing parent node for key=", parentKey, + " on chr=", cc, ". Check founder mapping.") + } + + tc$edge_table_add_row( + left = df$left[i], + right = df$right[i], + parent = nodeIdMapByChr[[cc]][[parentKey]], + child = nodeIdMapByChr[[cc]][[childKey]] + ) + } + + tc$sort() + newTs <- tc$tree_sequence() + + outDirCc <- if (is.null(out_dir)) dirname(chr_info[[cc]]$ts_path) else out_dir + outPath <- file.path(outDirCc, paste0(out_basename, "_chr", cc - 1, ".trees")) + + newTs$dump(outPath) + cat("Wrote:", outPath, "\n") + } + + invisible(TRUE) +} diff --git a/dev/alphaSimR2TsGen.R b/dev/alphaSimR2TsGen.R new file mode 100644 index 00000000..d93ee2d6 --- /dev/null +++ b/dev/alphaSimR2TsGen.R @@ -0,0 +1,121 @@ +library(jsonlite) + +morgan2bpRate <- function(m, x0, breaks, rates, side=c("left","right")) { + # turn breaks into Morgan + segLen <- diff(breaks) + mStart <- c(0, cumsum(rates * segLen)) + # position of the 1st SNP in Morgan + i0 <- findInterval(x0, breaks, rightmost.closed = TRUE) + i0 <- pmin(pmax(i0, 1), length(rates)) + mX0 <- mStart[i0] + rates[i0] * (x0 - breaks[i0]) + # recombination breakpoints in Morgan count from the 1st SNP + M <- m + mX0 + i <- findInterval(M, mStart, rightmost.closed = TRUE) + i <- pmin(pmax(i, 1), length(rates)) + # record zero-recombination-rate regions + mEnd <- mStart[-1] + plateau <- (rates[i] == 0) | (mEnd[i] == mStart[i]) + out <- numeric(length(M)) + + # non-zero-recombination-rate regions + ii <- which(!plateau) + if (length(ii) > 0) { + out[ii] <- breaks[i[ii]] + (M[ii] - mStart[i[ii]]) / rates[i[ii]] + } + + # zero-recombination-rate regions + jj <- which(plateau) + if (length(jj) > 0) { + out[jj] <- if (side == "left") breaks[i[jj]] else breaks[i[jj] + 1L] + } + + out + +} + + + +recHistGenMatToSegDf <- function(histMat, x0, breaks, rates, seqLen) { + + origin <- as.integer(histMat[, 1]) + mStart <- as.numeric(histMat[, 2]) + mNext <- c(mStart[-1], NA_real_) + + left <- morgan2bpRate(mStart, x0, breaks, rates, side="left") + + right <- numeric(length(mStart)) + if (length(mStart) > 1) { + right[1:(length(mStart)-1)] <- morgan2bpRate(mNext[1:(length(mStart)-1)], + x0, breaks, rates, side="right") + } + right[length(mStart)] <- seqLen + left[1] <- 0 + + keep <- right > left + + data.frame( + origin = origin[keep], + left = left[keep], + right = right[keep], + stringsAsFactors = FALSE + ) +} + +recHistGenToSegDfWithParents <- function(SP, offspringPop) { + childIds <- offspringPop@id + ped <- SP$pedigree[childIds, , drop = FALSE] + + out <- list() + k <- 1 + + for (childId in childIds) { + x <- SP$recHistGen[[childId]] + + motherId <- ped[childId, "mother"] + fatherId <- ped[childId, "father"] + + for (cc in seq_along(x)) { + tc <- tc_load(chr_info[[cc]]$ts_path) + seqLen <- as.numeric(tc$sequence_length()) + breaks <- chr_info[[cc]]$breaks + rates <- chr_info[[cc]]$rates + + x0 <- chrKeptPosBpList[[cc]][1] + + haps <- as.vector(x[[cc]]) + nHap <- length(haps) + + for (h in seq_len(nHap)) { + seg <- recHistGenMatToSegDf(haps[[h]], x0, breaks, rates, seqLen) + + parentId <- if (h <= nHap/2) motherId else fatherId + + seg$childId <- childId + seg$chr <- cc + seg$hap <- h + seg$parentId <- parentId + + seg$parentHap <- seg$origin + seg$parentGlobalHapId <- (parentId - 1) * nHap + seg$parentHap + + out[[k]] <- seg[, c("childId", "hap", "chr", + "left","right", + "parentId","parentHap","parentGlobalHapId")] + k <- k + 1 + } + } + } + + do.call(rbind, out) +} + +bridgeCollectSegGenFromSimOutput <- function(SP, simOutput) { + bridgeSegDfListGen <<- list() + + for (k in 2:length(simOutput)) { + segDf <- recHistGenToSegDfWithParents(SP, simOutput[[k]]) + bridgeSegDfListGen[[length(bridgeSegDfListGen) + 1]] <<- segDf + } + + invisible(bridgeSegDfListGen) +} diff --git a/dev/alphaSimR2TsGenPy.R b/dev/alphaSimR2TsGenPy.R new file mode 100644 index 00000000..0a374f58 --- /dev/null +++ b/dev/alphaSimR2TsGenPy.R @@ -0,0 +1,125 @@ +library(reticulate) +library(jsonlite) + +use_virtualenv("~/r-reticulate-env", required = TRUE) +tskit <- import("tskit") + +morgan2bpRate <- function(m, x0, breaks, rates, side=c("left","right")) { + # turn breaks into Morgan + segLen <- diff(breaks) + mStart <- c(0, cumsum(rates * segLen)) + # position of the 1st SNP in Morgan + i0 <- findInterval(x0, breaks, rightmost.closed = TRUE) + i0 <- pmin(pmax(i0, 1), length(rates)) + mX0 <- mStart[i0] + rates[i0] * (x0 - breaks[i0]) + # recombination breakpoints in Morgan count from the 1st SNP + M <- m + mX0 + i <- findInterval(M, mStart, rightmost.closed = TRUE) + i <- pmin(pmax(i, 1), length(rates)) + # record zero-recombination-rate regions + mEnd <- mStart[-1] + plateau <- (rates[i] == 0) | (mEnd[i] == mStart[i]) + out <- numeric(length(M)) + + # non-zero-recombination-rate regions + ii <- which(!plateau) + if (length(ii) > 0) { + out[ii] <- breaks[i[ii]] + (M[ii] - mStart[i[ii]]) / rates[i[ii]] + } + + # zero-recombination-rate regions + jj <- which(plateau) + if (length(jj) > 0) { + out[jj] <- if (side == "left") breaks[i[jj]] else breaks[i[jj] + 1L] + } + + out + +} + +recHistGenMatToSegDfPy <- function(histMat, x0, breaks, rates, seqLen) { + + origin <- as.integer(histMat[, 1]) + mStart <- as.numeric(histMat[, 2]) + mNext <- c(mStart[-1], NA_real_) + + left <- morgan2bpRate(mStart, x0, breaks, rates, side="left") + + right <- numeric(length(mStart)) + if (length(mStart) > 1) { + right[1:(length(mStart)-1)] <- morgan2bpRate(mNext[1:(length(mStart)-1)], + x0, breaks, rates, side="right") + } + right[length(mStart)] <- seqLen + left[1] <- 0 + + keep <- right > left + + data.frame( + origin = origin[keep], + left = left[keep], + right = right[keep], + stringsAsFactors = FALSE + ) +} + + +recHistGenToSegDfWithParentsPy <- function(SP, offspringPop) { + childIds <- offspringPop@id + ped <- SP$pedigree[childIds, , drop = FALSE] + + out <- list() + k <- 1 + + for (childId in childIds) { + x <- SP$recHistGen[[childId]] + + motherId <- ped[childId, "mother"] + fatherId <- ped[childId, "father"] + + for (cc in seq_along(x)) { + ts <- tskit$load(chr_info[[cc]]$ts_path) + seqLen <- as.numeric(ts$sequence_length) + breaks <- chr_info[[cc]]$breaks + rates <- chr_info[[cc]]$rates + + x0 <- chrKeptPosBpList[[cc]][1] + + haps <- as.vector(x[[cc]]) + nHap <- length(haps) + + for (h in seq_len(nHap)) { + seg <- recHistGenMatToSegDfPy(haps[[h]], x0, breaks, rates, seqLen) + + parentId <- if (h <= nHap/2) motherId else fatherId + + seg$childId <- childId + seg$chr <- cc + seg$hap <- h + seg$parentId <- parentId + + seg$parentHap <- seg$origin + seg$parentGlobalHapId <- (parentId - 1) * nHap + seg$parentHap + + out[[k]] <- seg[, c("childId", "hap", "chr", + "left","right", + "parentId","parentHap","parentGlobalHapId")] + k <- k + 1 + } + } + } + + do.call(rbind, out) +} + + +bridgeCollectSegGenFromSimOutputPy <- function(SP, simOutput) { + bridgeSegDfListGen <<- list() + + for (k in 2:length(simOutput)) { + segDf <- recHistGenToSegDfWithParentsPy(SP, simOutput[[k]]) + bridgeSegDfListGen[[length(bridgeSegDfListGen) + 1]] <<- segDf + } + + invisible(bridgeSegDfListGen) +} diff --git a/dev/alphaSimR2TsPy.R b/dev/alphaSimR2TsPy.R new file mode 100644 index 00000000..a08d2848 --- /dev/null +++ b/dev/alphaSimR2TsPy.R @@ -0,0 +1,367 @@ +library(reticulate) +library(jsonlite) + +use_virtualenv("~/r-reticulate-env", required = TRUE) +tskit <- import("tskit") + +genLogRecord <- function(parentPop, offspringPop, simParam, genIndex) { + list( + genIndex = genIndex, + offspringIds = offspringPop@id, + ibd = pullIbdHaplo(offspringPop, simParam = simParam) + ) +} + +ibdToSegDf <- function(ibdMat) { + # chr_locus + cn <- colnames(ibdMat) + # ind_hap + rn <- rownames(ibdMat) + + chr <- as.integer(sub("_.*$", "", cn)) + locus <- as.integer(sub("^.*_", "", cn)) + + childId <- sub("_.*$", "", rn) + hap <- as.integer(sub("^.*_", "", rn)) + + out <- list() + k <- 1 + + num_hap <- length(hap) + uniqueChr <- sort(unique(chr)) + + for (r in seq_len(num_hap)) { + # each row in ibdMat = every child hap + v <- ibdMat[r, ] + for (cc in uniqueChr) { + # get index from chr to extract parent hap (vv) and position (ll) + idx <- which(chr == cc) + vv <- v[idx] + ll <- locus[idx] + + # find breakpoints + chg <- which(diff(vv) != 0) + starts <- c(1, chg + 1) + ends <- c(chg, length(vv)) + + out[[k]] <- data.frame( + childId = childId[r], + hap = hap[r], + chr = cc, + # extract position of ibd change + locusStart = ll[starts], + locusEnd = ll[ends], + origin = vv[starts], + stringsAsFactors = FALSE + ) + k <- k + 1 + } + } + do.call(rbind, out) +} + +recHistMatToSegDfPy <- function(histMat, nLoci) { + + origin <- as.integer(histMat[, 1]) + starts <- as.integer(histMat[, 2]) + + ends <- c(starts[-1] - 1L, nLoci) + + data.frame( + origin = origin, + locusStart = starts, + locusEnd = ends, + stringsAsFactors = FALSE + ) +} + + +recHistToSegDfWithParentsPy <- function(SP, offspringPop, nLociByChr) { + childIds <- offspringPop@id + ped <- SP$pedigree[childIds, , drop = FALSE] + + out <- list() + k <- 1 + + for (childId in childIds) { + x <- SP$recHist[[childId]] + + motherId <- ped[childId, "mother"] + fatherId <- ped[childId, "father"] + + for (cc in seq_along(x)) { + nLoci <- nLociByChr[[cc]] + + haps <- as.vector(x[[cc]]) + nHap <- length(haps) + + for (h in seq_len(nHap)) { + seg <- recHistMatToSegDfPy(haps[[h]], nLoci = nLoci) + + parentId <- if (h <= nHap/2) motherId else fatherId + + seg$childId <- childId + seg$chr <- cc + seg$hap <- h + seg$parentId <- parentId + + seg$parentHap <- seg$origin + seg$parentGlobalHapId <- (parentId - 1) * nHap + seg$parentHap + + out[[k]] <- seg[, c("childId", "hap", "chr", + "locusStart","locusEnd", + "parentId","parentHap","parentGlobalHapId")] + k <- k + 1 + } + } + } + + do.call(rbind, out) +} + +bridgeCollectSegFromSimOutputPy <- function(SP, simOutput) { + bridgeSegDfList <<- list() + + nLociByChr <- lapply(chrKeptPosBpList, length) + + for (k in 2:length(simOutput)) { + segDf <- recHistToSegDfWithParentsPy(SP, simOutput[[k]], nLociByChr) + bridgeSegDfList[[length(bridgeSegDfList) + 1]] <<- segDf + } + + invisible(bridgeSegDfList) +} + + +segDfToEdgeDfUsingBridge <- function(segDf, chr_info) { + # segDF: childID, hap, chr, locusStart, locusEnd, origin + out <- segDf + out$left <- NA_real_ + out$right <- NA_real_ + + for (cc in sort(unique(out$chr))) { + #posBp <- bridgeEnv$chrKeptPosBpList[[cc]] + #if (is.null(posBp)) stop("bridgeEnv$chrKeptPosBpList[[", cc, "]] is NULL.") + posBp <- chrKeptPosBpList[[cc]] + + tsPath <- chr_info[[cc]]$ts_path + ts <- tskit$load(tsPath) + seqLen <- as.numeric(ts$sequence_length) + + idx <- which(out$chr == cc) + + for (i in idx) { + s <- out$locusStart[i] + e <- out$locusEnd[i] + out$left[i] <- if (s == 1) 0 else posBp[s] + out$right[i] <- if (e < length(posBp)) posBp[e + 1] else seqLen + } + } + out +} + +bridgeAllSegToEdgeDfPy <- function(chr_info) { + allSeg <- do.call(rbind, bridgeSegDfList) + + out <- allSeg + out$left <- NA + out$right <- NA + + for (cc in sort(unique(out$chr))) { + posBp <- chrKeptPosBpList[[cc]] + + tsPath <- chr_info[[cc]]$ts_path + ts <- tskit$load(tsPath) + seqLen <- ts$sequence_length + + idx <- which(out$chr == cc) + for (i in idx) { + s <- out$locusStart[i] + e <- out$locusEnd[i] + out$left[i] <- if (s == 1) 0 else posBp[s] + out$right[i] <- if (e < length(posBp)) posBp[e + 1] else seqLen + } + } + + out +} + +bridgeComputeIndTimePy <- function(pedigree) { + n <- nrow(pedigree) + indTime <- rep(NA, n) + + for (i in 1:n) { + m <- pedigree[i, "mother"] + f <- pedigree[i, "father"] + + if (m == 0 && f == 0) { + indTime[i] <- 0 + } else { + indTime[i] <- min(indTime[m], indTime[f]) - 1 + } + } + + indTime +} + + +bridgeWriteTreesPy <- function(chr_info, edgeDf, SP, out_dir = NULL, + out_basename = "AlphaSimR_extended") { + nodeSchema <- tskit$MetadataSchema(list( + codec = "json", + type = "object", + properties = list( + alphaSimR = list( + type = "object", + properties = list( + id = list(type = "string", description = "AlphaSimR node id (childId_hap)") + ), + required = list("id"), + additionalProperties = FALSE + ) + ), + required = list("alphaSimR"), + additionalProperties = FALSE + )) + + indTime <- bridgeComputeIndTimePy(SP$pedigree) + + nodeIdMapByChr <<- vector("list", length(chr_info)) + indIdMapByChr <<- vector("list", length(chr_info)) + + for (cc in seq_along(chr_info)) { + #nodeIdMap <<- list() + nodeIdMapByChr[[cc]] <<- list() + indIdMapByChr[[cc]] <<- list() + + ts <- tskit$load(chr_info[[cc]]$ts_path) + tables <- ts$dump_tables() + reticulate::py_set_attr(tables$nodes, "metadata_schema", nodeSchema) + + # for metadata + n <- tables$nodes$num_rows + encoded <- vector("list", n) + for (i in 0:(n - 1)) { + md_i <- tables$nodes[i]$metadata + encoded[[i + 1]] <- tables$nodes$metadata_schema$encode_row(md_i) + } + # ---- + + + df <- edgeDf[edgeDf$chr == cc, , drop = FALSE] + if (nrow(df) == 0) next + + # get indIDs for sampled nodes + sampNodeId <- ts$samples() + sampIndRow <- integer(length(sampNodeId)) + for (i in seq_along(sampNodeId)) { + sampIndRow[i] <- tables$nodes[sampNodeId[i]]$individual + } + if (any(sampIndRow < 0)) { + bad <- which(sampIndRow < 0)[1] + stop( + "Sample node", sampNodeId[bad], "has individual = -1. ", + "Cannot reuse founders' individuals. ", + ) + } + + nFounder <- length(sampNodeId) / ploidy + idx <- 1 + for (ind in 1:nFounder) { + indRow <- sampIndRow[idx] + indIdMapByChr[[cc]][[as.character(ind)]] <<- indRow + + for (h in 1:ploidy) { + #nodeIdMap[[paste(ind, h, sep = "_")]] <<- as.integer(sampNodeId[[idx]]) + nodeId <- as.integer(unlist(sampNodeId[[idx]]))[1] + key <- paste(ind, h, sep = "_") + nodeIdMapByChr[[cc]][[key]] <<- nodeId + #tables$nodes$metadata[[nodeId + 1]] <- tskit$pack_bytes(list(alphaSimR = list(id = key))) + #tables$nodes[nodeId + 1] <- tables$nodes[nodeId + 1]$replace(metadata=list(alphaSimR = list(id = key))) + encoded[[nodeId + 1]] <- tables$nodes$metadata_schema$encode_row( + list(alphaSimR = list(id = key))) + idx <- idx + 1 + } + } + tables$nodes$packset_metadata(encoded) + + # add indIDs for offSpring nodes + nextInd <- as.integer(tables$individuals$num_rows) + addNewIndividual <- function(alphaId) { + key <- as.character(alphaId) + if (!is.null(indIdMapByChr[[cc]][[key]])) return(indIdMapByChr[[cc]][[key]]) + + m <- SP$pedigree[alphaId, "mother"] + f <- SP$pedigree[alphaId, "father"] + + mRow <- addNewIndividual(m) + fRow <- addNewIndividual(f) + + newId <- nextInd + tables$individuals$add_row( + parents = list(as.integer(mRow), as.integer(fRow)), + metadata = list(file_id=as.integer(newId))) + indIdMapByChr[[cc]][[key]] <<- as.integer(newId) + + nextInd <<- nextInd + 1L + newId + } + + childIdsNeeded <- sort(as.integer(unique(df$childId))) + for (childId in childIdsNeeded) { + addNewIndividual(childId) + } + + # append child nodes + childKeys <- unique(paste(df$childId, df$hap, sep = "_")) + for (key in childKeys) { + #if (is.null(nodeIdMap[[key]])) { + if (is.null(nodeIdMapByChr[[cc]][[key]])) { + childId <- as.integer(sub("_.*$", "", key)) + indRow <- indIdMapByChr[[cc]][[as.character(childId)]] + + tables$nodes$add_row( + flags = 0L, + time = indTime[[childId]], + population = -1L, + individual = indRow, + metadata = list(alphaSimR = list(id = key)) + ) + #nodeIdMap[[key]] <<- as.integer(tables$nodes$num_rows - 1) + nodeIdMapByChr[[cc]][[key]] <<- as.integer(tables$nodes$num_rows - 1) + } + } + + # append edges + for (i in 1:nrow(df)) { + parentKey <- paste(df$parentId[i], df$parentHap[i], sep = "_") + childKey <- paste(df$childId[i], df$hap[i], sep = "_") + + #if (is.null(nodeIdMap[[key]])) { + if (is.null(nodeIdMapByChr[[cc]][[parentKey]])) { + stop("Missing parent node for key=", parentKey, + " on chr=", cc, ". Check founder mapping.") + } + + tables$edges$add_row( + left = df$left[i], + right = df$right[i], + #parent = as.integer(nodeIdMap[[parentKey]]), + #child = as.integer(nodeIdMap[[childKey]]) + parent = nodeIdMapByChr[[cc]][[parentKey]], + child = nodeIdMapByChr[[cc]][[childKey]] + ) + } + + tables$sort() + newTs <- tables$tree_sequence() + + outDirCc <- if (is.null(out_dir)) dirname(chr_info[[cc]]$ts_path) else out_dir + outPath <- file.path(outDirCc, paste0(out_basename, "_chr", cc - 1, ".trees")) + + newTs$dump(outPath) + cat("Wrote:", outPath, "\n") + } + + invisible(TRUE) +} diff --git a/dev/demography_draw_macs_args.py b/dev/demography_draw_macs_args.py new file mode 100644 index 00000000..61e72046 --- /dev/null +++ b/dev/demography_draw_macs_args.py @@ -0,0 +1,35 @@ +from pathlib import Path +import matplotlib.pyplot as plt +import demesdraw +import msprime + +from msprime_from_macs_scenarios import parse_macs_args, build_demography + +NREF = 10_000 # choose the same Nref you use for MaCS<->msprime scaling +OUT = Path("testData/out_phase1_useMacsMut_FALSE") +OUT.mkdir(parents=True, exist_ok=True) + +scenarios = [ + ("single_const", "8 100000 -t 1e-3 -r 1e-4 -s "), + ("single_eN", "8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s "), + ("I2_migration", "8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s "), + ("I2_en_join", "8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s "), +] + +for name, args in scenarios: + macs_arg = parse_macs_args(args) + dem, samples, rec_rate, mut_rate = build_demography(macs_arg, NREF) + + # Save textual check of event interpretation + (OUT / f"{name}.debug.txt").write_text(str(dem.debug()), encoding="utf-8") + + # Demography plot (not tree-sequence plot) + graph = msprime.Demography.to_demes(dem) + fig, ax = plt.subplots(figsize=(8, 5)) + demesdraw.tubes(graph, ax=ax, seed=1, log_time=True) + ax.set_title(f"{name}\n{args}") + fig.tight_layout() + fig.savefig(OUT / f"{name}.demography.png", dpi=200) + plt.close(fig) + +print(f"Saved plots to: {OUT}") diff --git a/dev/makeFoundersFromTs.R b/dev/makeFoundersFromTs.R new file mode 100644 index 00000000..34ec04b0 --- /dev/null +++ b/dev/makeFoundersFromTs.R @@ -0,0 +1,265 @@ +sample_segregating_variants <- function(ts, segSites, seed) { + + # Sample segregating variants from the tree sequence. + # + # Parameters + # ========== + # ts: tskit.TreeSequence + # The tree sequence to sample from. + # segSites: int + # The number of segregating sites to sample. + # seed: int + # The random seed to use for sampling. + # + # Returns + # ======= + # list of int + # The positions of the sampled segregating sites. + # Set the random seed for reproducibility. + set.seed(seed) + num_samples <- as.integer(ts$num_samples()) + + # 2. Pre-allocate H matrix and P vector based on required sample size (segSites) + # We only need space for 'segSites' number of variants + H <- matrix(NA_integer_, nrow = num_samples, ncol = segSites) + P <- numeric(segSites) + + it <- ts$variants() + + # k tracks how many biallelic variants we have encountered so far + k <- 0 + # current_size tracks how many variants are currently in our reservoir + current_size <- 0 + # 3. Iterate through variants + repeat { + v <- it$next_variant() + if (is.null(v)) break + + g <- v$genotypes + + # Filter for biallelic sites + if (length(unique(g)) == 2) { + k <- k + 1 + + if (current_size < segSites) { + # Case A: Reservoir is not full yet + current_size <- current_size + 1 + H[, current_size] <- g + P[current_size] <- v$position + } else { + # Case B: Reservoir is full, use Prob. entry: j/k + # sample.int(k, 1) returns a value from 1 to k + j <- sample.int(k, 1) + + if (j <= segSites) { + # Replace the existing variant at index j + H[, j] <- g + P[j] <- v$position + } + } + } + } + + # 4. Final check: if we found fewer biallelic sites than segSites, trim the output + if (k < segSites) { + if (k > 0) { + H <- H[, 1:k, drop = FALSE] + P <- P[1:k] + } else { + H <- matrix(nrow = num_samples, ncol = 0) + P <- numeric(0) + } + } + + return(list(H = H, P = P)) +} + + +segregating_variants <- function(ts) { + # 1. Get dimensions for pre-allocation + max_sites <- as.integer(ts$num_sites()) + num_samples <- as.integer(ts$num_samples()) + + # 2. Pre-allocate H matrix (Rows: samples, Cols: sites) + # Using integer matrix to save memory (similar to np.int8) + H_full <- matrix(NA_integer_, nrow = num_samples, ncol = max_sites) + # Pre-allocate P vector for positions + P_full <- numeric(max_sites) + + it <- ts$variants() + count <- 0 + + # 3. Iterate through variants + repeat { + v <- it$next_variant() + if (is.null(v)) break + + g <- v$genotypes + + # Filter for biallelic sites (exactly 2 unique alleles) + if (length(unique(g)) == 2) { + count <- count + 1 + # Fill the matrix column directly + H_full[, count] <- g + P_full[count] <- v$position + } + } + + # 4. Trim the results to the actual number of kept variants + if (count > 0) { + H <- H_full[, 1:count, drop = FALSE] + P <- P_full[1:count] + } else { + H <- matrix(nrow = num_samples, ncol = 0) + P <- numeric(0) + } + + return(list(H = H, P = P)) +} + +segregating_variants_debug <- function(ts) { + # 1. Get dimensions for pre-allocation + max_sites <- ts$num_sites() + num_samples <- ts$num_samples() + + # DEBUG: Print initial metadata + message(paste("Expected max sites:", max_sites)) + message(paste("Expected num samples (from ts):", num_samples)) + + # 2. Pre-allocate H matrix + H_full <- matrix(NA_integer_, nrow = num_samples, ncol = max_sites) + P_full <- numeric(max_sites) + + it <- ts$variants() + count <- 0 + + # 3. Iterate through variants + repeat { + v <- it$next_variant() + if (is.null(v)) break + + g <- v$genotypes + + # DEBUG: Check dimensions on the first iteration + if (count == 0) { + message(paste("Actual length of genotype vector (g):", length(g))) + message(paste("Matrix H_full has", nrow(H_full), "rows")) + + if (length(g) != nrow(H_full)) { + stop("DIMENSION MISMATCH: The genotype vector length does not match matrix rows!") + } + } + + # Filter for biallelic sites + if (length(unique(g)) == 2) { + count <- count + 1 + + # DEBUG: Check for column overflow + if (count > max_sites) { + stop(paste("INDEX OVERFLOW: count (", count, ") exceeded max_sites (", max_sites, ")")) + } + + # Fill the matrix column directly + H_full[, count] <- g + P_full[count] <- v$position + } + } + + # 4. Trim the results + if (count > 0) { + H <- H_full[, 1:count, drop = FALSE] + P <- P_full[1:count] + } else { + H <- matrix(nrow = num_samples, ncol = 0) + P <- numeric(0) + } + + message(paste("Success! Final count of biallelic variants:", count)) + return(list(H = H, P = P)) +} + +# rec map used in msprime: +rateMap2cumMorgan <- function(x, breaks, rates) { + stopifnot(length(breaks) == length(rates) + 1) + + o <- order(breaks) + breaks <- breaks[o] + + # M_i = m(breaks[i]) + seg_len <- diff(breaks) + M_start <- c(0, cumsum(rates * seg_len)) # length = length(breaks) + + i <- findInterval(x, breaks, rightmost.closed = FALSE) + i <- pmin(pmax(i, 1), length(rates)) + + m <- M_start[i] + rates[i] * (x - breaks[i]) + return(m) +} + + +ts2chrData <- function(ts_path, breaks, rates, segSites, site_sampling_seed) { + ts = ts_load(ts_path) + num_pos <- ts$num_sites() + + if (!is.null(segSites)) { + + if (num_pos < segSites) { + stop("Insufficient sites (only ", num_pos, " sites in the tree sequence).") + } + message(segSites, " variants sampled ", "(Random seed: ", site_sampling_seed, ")") + out <- sample_segregating_variants(ts, segSites, site_sampling_seed) + + if (length(out[[2]]) < segSites) { + stop("Insufficient sites (only ", length(out[[2]]), " sites after filtering non-biallelic sites).") + } + message(segSites, " variants sampled ", "(Random seed: ", site_sampling_seed, ")") + } + else { + out <- segregating_variants(ts) + } + + H <- out[[1]] + pos <- out[[2]] + + ordPos <- order(pos) + + pos <- pos[ordPos] + + mpos <- rateMap2cumMorgan(pos, breaks, rates) + + # relative position, so the 1st element is 0 + mpos <- mpos - min(mpos) + + ordMap <- order(mpos) + mpos <- mpos[ordMap] + pos <- pos[ordMap] + H <- H[, ordMap, drop = FALSE] + + + list( + genMap = list(mpos), + haplotypes = list(H), + keptPosBp = pos + ) +} + +asMapPop <- function(chr_info, ploidy = 2, inbred = FALSE, segSites = NULL, site_sampling_seed = 42) { + ploidy <<- ploidy + chr_data <- lapply(chr_info, function(info) { + ts2chrData( + ts_path = info$ts_path, + breaks = info$breaks, + rates = info$rates, + segSites = info$segSites, + site_sampling_seed = site_sampling_seed + ) + }) + + # save pos in bp for tskit tables + chrKeptPosBpList <<- lapply(chr_data, `[[`, "keptPosBp") + + genMap <- do.call(c, lapply(chr_data, `[[`, "genMap")) + haplotypes <- do.call(c, lapply(chr_data, `[[`, "haplotypes")) + + newMapPop(genMap = genMap, haplotypes = haplotypes, inbred = inbred, ploidy = ploidy) +} diff --git a/dev/makeFoundersFromTsPy.R b/dev/makeFoundersFromTsPy.R new file mode 100644 index 00000000..de6f52cf --- /dev/null +++ b/dev/makeFoundersFromTsPy.R @@ -0,0 +1,152 @@ +#library(reticulate) +library(jsonlite) + +#use_virtualenv("~/r-reticulate-env", required = TRUE) +#msprime <- import("msprime") +#tskit <- import("tskit") + +reticulate::py_run_string(" +import numpy as np + +def sample_segregating_variants(ts, segSites, seed): + rng = np.random.default_rng(int(seed)) + + kept_pos = [] + kept_g = [] + k = 0 + + for v in ts.variants(): + g = v.genotypes + + if len(np.unique(g)) != 2: + continue + + # reservoir sampling + k += 1 + if len(kept_g) < segSites: + kept_g.append(g.copy()) + kept_pos.append(v.site.position) + else: + # Prob. entry: j/k + j = rng.integers(0, k) + if j < segSites: + kept_g[j] = g.copy() + kept_pos[j] = v.site.position + + H = np.stack(kept_g, axis=1).astype(np.int8) + P = np.array(kept_pos, dtype=float) + return H, P +") + +reticulate::py_run_string(" +import numpy as np + +def segregating_variants(ts): + + kept_pos = [] + kept_g = [] + + for v in ts.variants(): + g = v.genotypes + + if len(np.unique(g)) != 2: + continue + + kept_g.append(g.copy()) + kept_pos.append(v.site.position) + + H = np.stack(kept_g, axis=1).astype(np.int8) + P = np.array(kept_pos, dtype=float) + return H, P +") + + +# rec map used in msprime: +rateMap2cumMorgan <- function(x, breaks, rates) { + stopifnot(length(breaks) == length(rates) + 1) + + o <- order(breaks) + breaks <- breaks[o] + + # M_i = m(breaks[i]) + seg_len <- diff(breaks) + M_start <- c(0, cumsum(rates * seg_len)) # length = length(breaks) + + i <- findInterval(x, breaks, rightmost.closed = FALSE) + i <- pmin(pmax(i, 1), length(rates)) + + m <- M_start[i] + rates[i] * (x - breaks[i]) + return(m) +} + + +ts2chrDataPy <- function(ts_path, breaks, rates, segSites, site_sampling_seed) { + ts = tskit$load(ts_path) + + pos <- ts$tables$sites$position + + if (!is.null(segSites)) { + # stopifnot(length(pos) >= segSites) + if (length(pos) < segSites) { + stop("Insufficient sites (only ", length(pos), " sites in the tree sequence).") + } + message(segSites, " variants sampled ", "(Random seed: ", site_sampling_seed, ")") + out <- py$sample_segregating_variants(ts, segSites, seed=site_sampling_seed) + #if (length(out[[2]]) < segSites) { + # warning("Not enough sites kept after filtering non-biallelic sites.") + #} + if (length(out[[2]]) < segSites) { + stop("Insufficient sites (only ", length(out[[2]]), " sites after filtering non-biallelic sites).") + } + message(segSites, " variants sampled ", "(Random seed: ", site_sampling_seed, ")") + } + else { + out <- py$segregating_variants(ts) + } + + H <- out[[1]] + pos <- out[[2]] + + ordPos <- order(pos) + + pos <- pos[ordPos] + + mpos <- rateMap2cumMorgan(pos, breaks, rates) + + # relative position, so the 1st element is 0 + mpos <- mpos - min(mpos) + + ordMap <- order(mpos) + mpos <- mpos[ordMap] + pos <- pos[ordMap] + H <- H[, ordMap, drop = FALSE] + + + list( + genMap = list(mpos), + # haplotypes <- list(H) + haplotypes = list(H), + keptPosBp = pos + ) +} + +asMapPopPy <- function(chr_info, ploidy = 2, inbred = FALSE, segSites = NULL, site_sampling_seed = 42) { + ploidy <<- ploidy + chr_data <- lapply(chr_info, function(info) { + ts2chrDataPy( + ts_path = info$ts_path, + breaks = info$breaks, + rates = info$rates, + segSites = info$segSites, + site_sampling_seed = site_sampling_seed + ) + }) + + # save pos in bp for tskit tables + chrKeptPosBpList <<- lapply(chr_data, `[[`, "keptPosBp") + + genMap <- do.call(c, lapply(chr_data, `[[`, "genMap")) + haplotypes <- do.call(c, lapply(chr_data, `[[`, "haplotypes")) + + newMapPop(genMap = genMap, haplotypes = haplotypes, inbred = inbred, ploidy = ploidy) +} diff --git a/dev/msprime_from_macs_scenarios.py b/dev/msprime_from_macs_scenarios.py new file mode 100644 index 00000000..3a5a89d1 --- /dev/null +++ b/dev/msprime_from_macs_scenarios.py @@ -0,0 +1,310 @@ +""" +Generate msprime tree-sequence replicates from MaCS-style scenario strings. + +This script maps a supported subset of MaCS args to msprime demography: + - sample_size sequence_length + -t, -r + -I (with optional global migration parameter) + -eN, -en, -eM, -em, -ej + -s (ignored placeholder) + +Outputs: + 1) .trees files for each scenario/replicate/chromosome + 2) manifest CSV with paths/seeds/basic TS counts +""" + + + +import argparse +import csv +from pathlib import Path + +import msprime + +def parse_macs_args(args): + tok = [x for x in args.strip().split() if x] + if len(tok) < 2: + raise ValueError("MaCS args must start with ' '.") + + macs_arg = {'sample_size': int(tok[0]), + 'sequence_length': int(tok[1]), + 'num_pops': 1, + 'pop_samples':[], + 'events':[]} + + i = 2 + n = len(tok) + while i < n: + flag = tok[i] + if flag == "-t": + macs_arg['theta'] = float(tok[i + 1]) + i += 2 + elif flag == "-r": + macs_arg['rec'] = float(tok[i + 1]) + i += 2 + elif flag == "-I": + k = int(tok[i + 1]) + pop_samples = [int(tok[i + 2 + j]) for j in range(k)] + j = i + 2 + k + mig = 0.0 + if j < n and not tok[j].startswith("-"): + mig = float(tok[j]) + j += 1 + macs_arg['num_pops'] = k + macs_arg['pop_samples'] = pop_samples + macs_arg['global_migration'] = mig + i = j + elif flag == "-eN": + macs_arg['events'].append( + {"type": "eN", + "t": float(tok[i + 1]), + "x": float(tok[i + 2])}) + i += 3 + elif flag == "-en": + macs_arg['events'].append( + { + "type": "en", + "t": float(tok[i + 1]), + "pop": int(tok[i + 2]), + "x": float(tok[i + 3]), + } + ) + i += 4 + elif flag == "-eM": + macs_arg['events'].append( + {"type": "eM", + "t": float(tok[i + 1]), + "M": float(tok[i + 2])}) + i += 3 + elif flag == "-em": + macs_arg['events'].append( + { + "type": "em", + "t": float(tok[i + 1]), + "src": int(tok[i + 2]), + "dst": int(tok[i + 3]), + "Mij": float(tok[i + 4]), + } + ) + i += 5 + elif flag == "-ej": + macs_arg['events'].append( + { + "type": "ej", + "t": float(tok[i + 1]), + "src": int(tok[i + 2]), + "dst": int(tok[i + 3]), + } + ) + i += 4 + elif flag == "-s": + # In AlphaSimR wrappers this is a seed placeholder. + # Ignore optional value if present. + if i + 1 < n and not tok[i + 1].startswith("-"): + i += 2 + else: + i += 1 + else: + raise ValueError(f"Unsupported MaCS token: {flag}") + + if macs_arg['num_pops'] == 1 and len(macs_arg['pop_samples'])==0: + macs_arg['pop_samples'] = [macs_arg['sample_size']] + + if sum(macs_arg['pop_samples']) != macs_arg['sample_size']: + raise ValueError( + f"-I population samples sum to {sum(macs_arg['pop_samples'])}, " + f"but sample_size is {macs_arg['sample_size']}." + ) + return macs_arg + + +def directed_pairs(pop_names): + return [(src, dst) for src in pop_names for dst in pop_names if src != dst] + + +def scaled_time_to_generations(t_coal, nref): + return t_coal * 4.0 * nref + + +def scaled_rec_to_per_bp(r_arg, nref): + return r_arg / (4.0 * nref) + + +def scaled_mut_to_per_bp(theta, nref): + return theta / (4.0 * nref) + + +def scaled_global_M_to_pairwise_m(M, k_pops, nref): + if k_pops <= 1: + return 0.0 + return (M / (k_pops - 1.0)) / (4.0 * nref) + + +def scaled_pair_Mij_to_m(Mij, nref): + return Mij / (4.0 * nref) + + +def build_demography(macs_arg, nref): + dem = msprime.Demography() + pop_names = [f"p{i + 1}" for i in range(macs_arg['num_pops'])] + for name in pop_names: + dem.add_population(name=str(name), initial_size=nref, initially_active=True) + + if macs_arg['num_pops'] > 1: + m0 = scaled_global_M_to_pairwise_m(macs_arg['global_migration'], macs_arg['num_pops'], nref) + if m0!=0: + for src, dst in directed_pairs(pop_names): + dem.set_migration_rate(str(src), str(dst), m0) + + events = sorted(macs_arg['events'], key=lambda e: e["t"]) + for ev in events: + t_gen = scaled_time_to_generations(ev["t"], nref) + typ = ev["type"] + if typ == "eN": + size = ev["x"] * nref + for name in pop_names: + dem.add_population_parameters_change(time=t_gen, population=str(name), initial_size=size) + elif typ == "en": + pop_name = f"p{ev['pop']}" + size = ev["x"] * nref + dem.add_population_parameters_change(time=t_gen, population=str(pop_name), initial_size=size) + elif typ == "eM": + m = scaled_global_M_to_pairwise_m(ev["M"], macs_arg['num_pops'], nref) + for src, dst in directed_pairs(pop_names): + dem.add_migration_rate_change(time=t_gen, source=str(src), dest=str(dst), rate=m) + elif typ == "em": + src = f"p{ev['src']}" + dst = f"p{ev['dst']}" + m = scaled_pair_Mij_to_m(ev["Mij"], nref) + dem.add_migration_rate_change(time=t_gen, source=str(src), dest=str(dst), rate=m) + elif typ == "ej": + src = f"p{ev['src']}" + dst = f"p{ev['dst']}" + dem.add_population_split(time=t_gen, derived=[str(src)], ancestral=str(dst)) + else: + raise ValueError(f"Unhandled event type: {typ}") + + rec_rate = scaled_rec_to_per_bp(macs_arg['rec'], nref) + mut_rate = scaled_mut_to_per_bp(macs_arg['theta'], nref) + pop_hap = [int(macs_arg["pop_samples"][i]) for i in range(macs_arg["num_pops"])] + if any(n % 2 != 0 for n in pop_hap): + raise ValueError("Cannot map MaCS haploid sample counts to ploidy=2 (odd count present).") + samples = {f"p{i + 1}": pop_hap[i] // 2 for i in range(macs_arg["num_pops"])} + # ploidy = 1 + #samples = {f"p{i + 1}": int(macs_arg['pop_samples'][i]) for i in range(macs_arg['num_pops'])} + print(dem, samples, rec_rate) + return dem, samples, rec_rate, mut_rate + + +def default_scenarios(): + return [ + { + "id": 1, + "name": "single_const", + "args": "8 100000 -t 1e-3 -r 1e-4 -s ", + }, + { + "id": 2, + "name": "single_eN", + "args": "8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ", + }, + { + "id": 3, + "name": "I2_migration", + "args": "8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ", + }, + { + "id": 4, + "name": "I2_en_join", + "args": "8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ", + }, + ] + + +def make_seed(base_seed, scenario_id, rep_id, chr_id): + return int(base_seed + scenario_id * 100000 + rep_id * 1000 + (chr_id - 1)) + + +def run(args): + out_dir = Path(args.out_dir) + out_dir.mkdir(parents=True, exist_ok=True) + + scenarios = default_scenarios() + rows = [] + + for sc in scenarios: + macs_arg = parse_macs_args(sc["args"]) + dem, samples, rec_rate, mut_rate = build_demography(macs_arg, args.nref) + for rep in range(1, args.nrep + 1): + for chr_id in range(1, args.nchr + 1): + seed = make_seed(args.base_seed, int(sc["id"]), rep, chr_id) + ts = msprime.sim_ancestry( + samples=samples, + ploidy=2, + demography=dem, + sequence_length=macs_arg['sequence_length'], + recombination_rate=rec_rate, + model=args.model, + random_seed=seed, + ) + mts = msprime.sim_mutations(ts, rate=mut_rate, random_seed=seed+100) + tree_path = out_dir / f"{sc['name']}_rep{rep:02d}_chr{chr_id:02d}.trees" + mts.dump(tree_path) + + rows.append( + { + "scenario_id": sc["id"], + "scenario": sc["name"], + "rep": rep, + "chr": chr_id, + "args": sc["args"], + "nref": args.nref, + "seed_chr": seed, + "model": args.model, + "sequence_length": macs_arg['sequence_length'], + "rec_rate_bp": rec_rate, + "mut_rate_bp": mut_rate, + "num_trees": ts.num_trees, + "num_nodes": ts.num_nodes, + "num_edges": ts.num_edges, + "num_mutations": mts.num_mutations, + "max_root_time": float(ts.max_root_time), + "tree_path": str(tree_path), + } + ) + if args.verbose: + print( + f"[ok] {sc['name']} rep={rep:02d} chr={chr_id:02d} " + f"trees={ts.num_trees} nodes={ts.num_nodes} edges={ts.num_edges}" + ) + + manifest_path = out_dir / "msprime_manifest.csv" + with manifest_path.open("w", newline="", encoding="utf-8") as f: + writer = csv.DictWriter(f, fieldnames=list(rows[0].keys())) + writer.writeheader() + writer.writerows(rows) + print(f"Saved manifest: {manifest_path}") + print(f"Saved trees under: {out_dir}") + + +def build_parser() -> argparse.ArgumentParser: + p = argparse.ArgumentParser(description=__doc__) + p.add_argument("--nrep", type=int, default=50, help="Replicates per scenario.") + p.add_argument("--nchr", type=int, default=1, help="Independent chromosomes per replicate.") + p.add_argument("--nref", type=float, default=10000.0, help="Reference Ne for MaCS->msprime scaling.") + p.add_argument("--base-seed", type=int, default=700000, help="Base seed for deterministic seed schedule.") + p.add_argument("--model", type=str, default="smc_prime", help="msprime ancestry model.") + p.add_argument( + "--out-dir", + type=str, + default="testData/out_msprime_from_macs", + help="Output directory for .trees and manifest CSV.", + ) + p.add_argument("--verbose", action="store_true", help="Print progress lines.") + return p + + +if __name__ == "__main__": + parser = build_parser() + ns = parser.parse_args() + run(ns) diff --git a/dev/msprime_macs_scenarios_compare.py b/dev/msprime_macs_scenarios_compare.py new file mode 100644 index 00000000..168c004e --- /dev/null +++ b/dev/msprime_macs_scenarios_compare.py @@ -0,0 +1,198 @@ +from pathlib import Path +import csv +import statistics as st + +def print_phase1_summary( + macsts_manifest="testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_manifest.csv", + msprime_manifest="testData/out_msprime_from_macs/msprime_manifest.csv", + try_load_macsts_trees=True, + comparison_table_path="testData/method_comparison_long.csv", +): + macsts_manifest = Path(macsts_manifest) + msprime_manifest = Path(msprime_manifest) + + def read_csv_rows(path): + with path.open(newline="", encoding="utf-8") as f: + return list(csv.DictReader(f)) + + def mean_sd(xs): + xs = [float(x) for x in xs if x is not None] + if len(xs) == 0: + return float("nan"), float("nan") + if len(xs) == 1: + return xs[0], 0.0 + return st.mean(xs), st.stdev(xs) + + macsts_rows = read_csv_rows(macsts_manifest) + msprime_rows = read_csv_rows(msprime_manifest) + + by_scn_macsts = {} + for r in macsts_rows: + by_scn_macsts.setdefault(r["scenario"], []).append(r) + + by_scn_msprime = {} + for r in msprime_rows: + by_scn_msprime.setdefault(r["scenario"], []).append(r) + + # Optional: load MaCSTS trees for edge/node/tree/root stats + macsts_tree_stats = {} + if try_load_macsts_trees: + try: + import tskit + for scn, rows in by_scn_macsts.items(): + e, n, t, h, m = [], [], [], [], [] + for r in rows: + p = Path(r["tree_path"]) + if not p.exists(): + p = macsts_manifest.parent.parent / p # handle relative path in CSV + ts = tskit.load(str(p)) + e.append(ts.num_edges) + n.append(ts.num_nodes) + t.append(ts.num_trees) + h.append(float(ts.max_root_time)) + m.append(ts.num_mutations) + macsts_tree_stats[scn] = { + "num_edges": mean_sd(e), + "num_nodes": mean_sd(n), + "num_trees": mean_sd(t), + "max_root_time": mean_sd(h), + "num_mutations": mean_sd(m) + } + except Exception as ex: + print(f"[note] skipped MaCSTS tree loading: {ex}") + + scenarios = sorted(set(by_scn_macsts) | set(by_scn_msprime)) + + for scn in scenarios: + print(f"\n=== {scn} ===") + + # Mutation summary from MaCS vs MaCSTS manifest + if scn in by_scn_macsts: + d = by_scn_macsts[scn] + macs = [float(r["macs_num_mutations"]) for r in d] + macsts = [float(r["macsts_num_mutations"]) for r in d] + delta = [a - b for a, b in zip(macs, macsts)] + + macs_mean, macs_sd = mean_sd(macs) + macsts_mean, macsts_sd = mean_sd(macsts) + delta_mean, delta_sd = mean_sd(delta) + rel_diff = (delta_mean / macs_mean) if macs_mean != 0 else float("nan") + + print( + f"scenario={scn}, n={len(d)}, " + f"macs_mut_mean={macs_mean:.4f}, macs_mut_sd={macs_sd:.4f}, " + f"macsts_mut_mean={macsts_mean:.4f}, macsts_mut_sd={macsts_sd:.4f}, " + f"mut_diff_mean={delta_mean:.4f}, mut_diff_sd={delta_sd:.4f}, " + f"rel_diff={rel_diff:.6f}" + ) + + # msprime stats from manifest (already has edges/nodes/tree/root) + if scn in by_scn_msprime: + d = by_scn_msprime[scn] + edges = [float(r["num_edges"]) for r in d] + nodes = [float(r["num_nodes"]) for r in d] + trees = [float(r["num_trees"]) for r in d] + roots = [float(r["max_root_time"]) for r in d] + muts = [float(r["num_mutations"]) for r in d] if "num_mutations" in d[0] else [] + + e_m, e_sd = mean_sd(edges) + n_m, n_sd = mean_sd(nodes) + t_m, t_sd = mean_sd(trees) + h_m, h_sd = mean_sd(roots) + print( + f"msprime: edges_mean={e_m:.4f}, edges_sd={e_sd:.4f}, " + f"nodes_mean={n_m:.4f}, nodes_sd={n_sd:.4f}, " + f"trees_mean={t_m:.4f}, trees_sd={t_sd:.4f}, " + f"root_time_mean={h_m:.4f}, root_time_sd={h_sd:.4f}" + ) + if muts: + m_m, m_sd = mean_sd(muts) + print(f"msprime: num_mut_mean={m_m:.4f}, num_mut_sd={m_sd:.4f}") + + # Optional MaCSTS tree stats + if scn in macsts_tree_stats: + s = macsts_tree_stats[scn] + print( + f"macsts-ts: edges_mean={s['num_edges'][0]:.4f}, edges_sd={s['num_edges'][1]:.4f}, " + f"nodes_mean={s['num_nodes'][0]:.4f}, nodes_sd={s['num_nodes'][1]:.4f}, " + f"trees_mean={s['num_trees'][0]:.4f}, trees_sd={s['num_trees'][1]:.4f}, " + f"root_time_mean={s['max_root_time'][0]:.4f}, root_time_sd={s['max_root_time'][1]:.4f}," + f"num_mut_mean={s['num_mutations'][0]:.4f}, mut_sd={s['num_mutations'][1]:.4f}" + ) + + # Long-format per-replicate table for downstream comparison + long_rows = [] + macsts_tree_by_key = {} + if try_load_macsts_trees: + try: + for r in macsts_rows: + p = Path(r["tree_path"]) + if not p.exists(): + p = macsts_manifest.parent.parent / p + ts = tskit.load(str(p)) + macsts_tree_by_key[(r["scenario"], int(r["rep"]), int(r["chr"]))] = { + "num_trees": ts.num_trees, + "num_edges": ts.num_edges, + "num_nodes": ts.num_nodes, + "max_root_time": float(ts.max_root_time), + } + except Exception as ex: + print(f"[note] could not enrich macsTS tree stats in long table: {ex}") + + for r in macsts_rows: + key = (r["scenario"], int(r["rep"]), int(r["chr"])) + ts_stats = macsts_tree_by_key.get(key, {}) + long_rows.append({ + "Scenarios": r["scenario"], + "Methods": "macs", + "rep_index": int(r["rep"]), + "num_mut": int(r["macs_num_mutations"]), + "num_trees": "NA", + "num_edges": "NA", + "num_nodes": "NA", + "max_root_time": "NA", + }) + long_rows.append({ + "Scenarios": r["scenario"], + "Methods": "macsTS", + "rep_index": int(r["rep"]), + "num_mut": int(r["macsts_num_mutations"]), + "num_trees": ts_stats.get("num_trees", "NA"), + "num_edges": ts_stats.get("num_edges", "NA"), + "num_nodes": ts_stats.get("num_nodes", "NA"), + "max_root_time": ts_stats.get("max_root_time", "NA"), + }) + + for r in msprime_rows: + long_rows.append({ + "Scenarios": r["scenario"], + "Methods": "msprime", + "rep_index": int(r["rep"]), + "num_mut": int(float(r["num_mutations"])) if "num_mutations" in r else "NA", + "num_trees": int(float(r["num_trees"])) if "num_trees" in r else "NA", + "num_edges": int(float(r["num_edges"])) if "num_edges" in r else "NA", + "num_nodes": int(float(r["num_nodes"])) if "num_nodes" in r else "NA", + "max_root_time": float(r["max_root_time"]) if "max_root_time" in r else "NA", + }) + + comparison_table_path = Path(comparison_table_path) + comparison_table_path.parent.mkdir(parents=True, exist_ok=True) + with comparison_table_path.open("w", newline="", encoding="utf-8") as f: + w = csv.DictWriter( + f, + fieldnames=[ + "Scenarios", + "Methods", + "rep_index", + "num_mut", + "num_trees", + "num_edges", + "num_nodes", + "max_root_time", + ], + ) + w.writeheader() + w.writerows(long_rows) + print(f"\nSaved long comparison table: {comparison_table_path}") + +print_phase1_summary() diff --git a/dev/multiple_chr.py b/dev/multiple_chr.py new file mode 100644 index 00000000..e6d9d91a --- /dev/null +++ b/dev/multiple_chr.py @@ -0,0 +1,54 @@ +import io +import msprime +from pathlib import Path + +output_path = "/Users/jliang2/Projects/test_TSK2ASR/data/simulations/normal" +Path(output_path).mkdir(parents=True, exist_ok=True) + +mut_rate = 1.25e-8 +mut_random_seed = 5678 + +ped_txt = """\ +# id parent0 parent1 time is_sample +0 2 3 0.0 1 +1 4 5 0.0 1 +2 6 7 1.0 0 +3 8 9 1.0 0 +4 6 7 1.0 0 +5 10 11 1.0 0 +6 . . 2.0 0 +7 . . 2.0 0 +8 . . 2.0 0 +9 . . 2.0 0 +10 . . 2.0 0 +11 . . 2.0 0 +""" + +Ls = [1000000, 2000000, 3000000] +#rs = [1e-8, 2e-8, 3e-8] +rate=[1e-7, 1e-8, 1e-7] + + +ts_chroms = [] +pedigree = msprime.parse_pedigree(io.StringIO(ped_txt), sequence_length=1) + +for i in range(len(Ls)): + pedigree.sequence_length = Ls[i] + rate_map = msprime.RateMap( + position=[0, round(Ls[i] / 3), 2 * round(Ls[i] / 3), Ls[i]], + rate=rate) + + ped_ts = msprime.sim_ancestry( + initial_state=pedigree, model="fixed_pedigree", + recombination_rate=rate_map, random_seed=i+1) + + ts_chroms.append( + msprime.sim_ancestry( + initial_state=ped_ts, population_size=1000, + recombination_rate=rate_map, model="dtwf", random_seed=i+100)) + +for i, ts in enumerate(ts_chroms): + print(f"chromosome {i} has length {ts.sequence_length} and {ts.num_trees} trees") + tree_seq_mut = msprime.sim_mutations(ts, rate=mut_rate, random_seed=mut_random_seed) + tree_seq_mut_tree_result = output_path + f"/msprime_chr{i}.trees" + tree_seq_mut.dump(tree_seq_mut_tree_result) diff --git a/dev/notes.md b/dev/notes.md new file mode 100644 index 00000000..17c2bb39 --- /dev/null +++ b/dev/notes.md @@ -0,0 +1,121 @@ +How I set up an R package using the tskit C API: + +1. Create a basic R package structure (in an existing R project folder) + +I removed other files and created a package directory with: +``` +AlphaSimRTmp/ + DESCRIPTION + R/ + src/ +``` + +(R will not recognise the directory as a package unless DESCRIPTION, R/, and src/ all exist) + +2. Write a minimal DESCRIPTION + +I added a minimal DESCRIPTION file. + +``` +Package: AlphaSimRTmp +Type: Package +Version: 0.0.1 +Imports: Rcpp +LinkingTo: Rcpp +``` + +3. Vendor tskit and kastore (only C API files) + +Tskit and karstore are from: https://github.com/tskit-dev/tskit/archive/refs/tags/1.0.0.zip +Inside src/, I created a deps/ directory and copied in only the C API parts: + +``` +src/deps/ + tskit/ + kastore/ + tskit.h +``` +tskit folder from: tskit-1.0.0/c/tskit +karstore folder from: tskit-1.0.0/c/subprojects/kastore +tskit.h from: tskit-1.0.0/c/tskit.h + +(I did not copy meson.build, examples, Python code and documentation etc.) + +4. Create a minimal C++ test file + +I added src/minimal.cpp with: + +#include + +two exported Rcpp functions: + +one to report the tskit version + +one smoke test that loads a .trees file using +tsk_table_collection_init → load → tsk_treeseq_init + +5. Create an initial NAMESPACE so Rcpp::compileAttributes() could run + +Before anything would compile, I created a minimal NAMESPACE in R: + +``` +writeLines(c( + "useDynLib(AlphaSimRTmp, .registration=TRUE)", + "importFrom(Rcpp, evalCpp)" +), "NAMESPACE") +``` + +6. Write Makevars to compile vendored C code + +In src/Makevars, I: + +added include paths for deps, deps/tskit, and deps/kastore; + +explicitly listed all tskit and kastore .c files; + +added custom rules to compile .c files in subdirectories; + +linked the resulting .o files into the package shared library. + +7. Generate Rcpp and roxygen outputs + +From the package root, in R: +``` +Rcpp::compileAttributes() +roxygen2::roxygenise() +``` +After this, R/RcppExports.R, src/RcppExports.cpp were created, but the minimal handwritten NAMESPACE was not replaced. + +8. Add zzz.R so roxygen2 can generate a correct NAMESPACE + +Before generating documentation, I created R/zzz.R with the following contents: +``` +#' @useDynLib AlphaSimRTmp, .registration = TRUE +#' @importFrom Rcpp evalCpp +NULL +``` + +This ensures that roxygen2 writes the required useDynLib() and importFrom(Rcpp, evalCpp) entries into NAMESPACE. + +9. I remove the handwritten NAMESPACE and generated it with running `roxygen2::roxygenise()` again. + +10. Clean install the package (not necessary; just because of bugs in lazy-load database caused by repeated installs) + +``` +rm -rf ~/Library/R/arm64/4.5/library/AlphaSimRTmp +rm -rf ~/Library/R/arm64/4.5/library/00LOCK-AlphaSimRTmp +R CMD INSTALL --preclean AlphaSimRTmp +``` + +11. Test + +In a fresh R session: +``` +> library(AlphaSimRTmp) +> tskit_version_test() +major minor patch + 1 3 0 +> +> tskit_smoke_load_free("...Projects/test_TSK2ASR/data/simulations/normal/msprime_chr1.trees") +[1] 1 +``` diff --git a/dev/notesRealBreakpoints.md b/dev/notesRealBreakpoints.md new file mode 100644 index 00000000..4f8f37e1 --- /dev/null +++ b/dev/notesRealBreakpoints.md @@ -0,0 +1,320 @@ +notesRealBreakpoints +================ +2026-02-18 + +## Test data + +Use `AlphaSimR_test/dev/multiple_chr.py` to simulate 2 chromosomes and 2 +dip individuals with pedigree. Or directly use `msprime_chr0.trees` and +`msprime_chr1.trees` in `AlphaSimR_test/dev/testData`. + +## Try this version + +In this version, a recHistGen object (similar to recHist) was added to +record the real recombination breakpoints. + +### Load tree sequences + + library(AlphaSimR) + use_virtualenv("~/r-reticulate-env", required = TRUE) + tskit <- import("tskit") + devtools::load_all() + + # two chromosomes + L1 <- 1e6 + L2 <- 2e6 + # here, use the same recombination map as used in msprime + chr_info <- list( + list(ts_path=".../AlphaSimR_test/dev/testData/msprime_chr0.trees", + breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), + #breaks=c(0, L1/2, L1), rates=c(1e-5, 2e-5), segSites=60), + list(ts_path=".../AlphaSimR_test/dev/testData/msprime_chr1.trees", + breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) + #breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-4, 1e-5, 1e-4), segSites=155) + ) + + founderGenomes1 <- asMapPop(chr_info = chr_info, inbred=FALSE, ploidy=2L) + +### Run AlphaSimR + + set.seed(42) + SP = SimParam$new(founderGenomes1) + SP$setSexes("yes_sys") + SP$addTraitA(nQtlPerChr = 5, + mean = 500, + var = 450) + + SP$setTrackPed(TRUE) + # try the new function here, it automatically set setTrackRec also. + SP$setTrackRecGen(TRUE) + basePop = newPop(founderGenomes1) + + # the 2 objects are same now: + SP$recHistGen + SP$recHist + + basePop = setPheno(basePop, + h2 = 0.5) + + #--- n generations + nCycles<-2 + + # very simple container for each cycles sim output + simOutput<-list(basePop) + cycle<-1 + for(cycle in 1:nCycles){ + cat(paste0(" C",cycle)) + # choose the best from last cycle + chosenParents<- selectInd(pop=simOutput[[cycle]], nInd=6, use = "gv") + # make crosses + offspringPop<-randCross(pop=chosenParents, nCrosses=2, nProgeny = 5) + # phenotype new offspring + offspringPop<-setPheno(pop = offspringPop, h2 = 0.5) + # add new offspring to simOutput list + simOutput[[cycle+1]]<-offspringPop + } + +Now we can see the difference between recHist and recHistGen: + + RHG <- SP$recHistGen + RH <- SP$recHist + # ind 3; chr 2; hap 1. Maybe not the same output, please check RHG and RH to find a hap with recombination + rh <- RH[[3]][[2]][[1]] + rhg <- RHG[[3]][[2]][[1]] + gm <- SP$genMap[[2]] + +Col 1: original Hap; Col2: start from where (recHist: index of SNP; +recHistGen: positions in Morgan) + + > rh + [,1] [,2] + [1,] 2 1 + [2,] 1 112 + > rhg + [,1] [,2] + [1,] 2 0.00000000 + [2,] 1 0.09354741 + +So, if everything goes well, rh\[2,2\]-1 \< rhg\[2,2\] \< rh\[2,2\]. We +can check it with genMap (SNP index -\> SNP position in Morgan): + + > gm[[111]] + [1] 0.0923321 + > gm[[112]] + [1] 0.0939209 + +### Collect information for ts tables + + pos_list <- attr(founderGenomes1, "tsForwardPosMeta", exact = TRUE)$posList + # for RecHist + bridgeSegDfList <- bridgeCollectSegFromSimOutput(SP, simOutput, pos_list = pos_list) + # for RecHistGen + bridgeSegDfListGen <- bridgeCollectSegGenFromSimOutput( + SP, simOutput, chr_info = chr_info, pos_list = pos_list + ) + +For RecHist, the indexes of SNPs have to be turned into positions: + + edgeDf <- bridgeAllSegToEdgeDf(chr_info, bridgeSegDfList, pos_list = pos_list) + +### Write tree files and check + + bridgeWriteTrees(chr_info, edgeDf, SP) + +In python: + + import tskit + origin = tskit.load('.../AlphaSimR_test/dev/testData/msprime_chr0.trees') + marker_ts = tskit.load('.../AlphaSimR_test/dev/testData/AlphaSimR_extended_chr0.trees') + + # Statistics: + # chr1 + origin.num_trees + 298 + marker_ts.num_trees + 298 + # chr 1 is too short for new recombination events. But 40 new nodes (2 x 20 ind) added. + origin.num_nodes + 260 + marker_ts.num_nodes + 300 + + # chr2 + origin = tskit.load('.../AlphaSimR_test/dev/testData/msprime_chr1.trees') + marker_ts = tskit.load('.../AlphaSimR_test/dev/testData/AlphaSimR_extended_chr1.trees') + # now here are new recombination events: + origin.num_trees + 620 + marker_ts.num_trees + 623 + # and still 40 new nodes: + origin.num_nodes + 491 + marker_ts.num_nodes + 531 + +We can plot the pedigree by (information in individual table): + + from matplotlib import pyplot as plt + import networkx as nx + import tskit + def draw_pedigree(ped_ts): + G = nx.DiGraph() + for ind in ped_ts.individuals(): + time = ped_ts.node(ind.nodes[0]).time + pop = ped_ts.node(ind.nodes[0]).population + G.add_node(ind.id, time=time, population=pop) + for p in ind.parents: + if p != tskit.NULL: + G.add_edge(ind.id, p) + pos = nx.multipartite_layout(G, subset_key="time", align="horizontal") + colours = plt.rcParams['axes.prop_cycle'].by_key()['color'] + node_colours = [colours[node_attr["population"]] for node_attr in G.nodes.values()] + nx.draw_networkx(G, pos, with_labels=True, node_color=node_colours) + plt.show() + + draw_pedigree(origin) + +![](../man/figures/originInd.png) + +The new individuals added: + + draw_pedigree(marker_ts) + +![](../man/figures/addInd.png) + +For RecHistGen, the returned segment list stores physical breakpoints +and can be directly used: + + bridgeWriteTrees(chr_info, do.call(rbind, bridgeSegDfListGen), SP) + +### More recombinations? + +Let’s use the same msprime .tree files, but set higher recombination +rates to see the difference between recHist and recHistGen when there +are double crossing over between 2 sampled SNPs. + + L1 <- 1e6 + L2 <- 2e6 + chr_info <- list( + list(ts_path=".../AlphaSimR_test/dev/testData/msprime_chr0.trees", + #breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), + breaks=c(0, L1/2, L1), rates=c(1e-5, 2e-5), segSites=60), + list(ts_path=".../AlphaSimR_test/dev/testData/msprime_chr1.trees", + #breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) + breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-4, 1e-5, 1e-4), segSites=155) + ) + + founderGenomes2 <- asMapPop(chr_info = chr_info, inbred=FALSE, ploidy=2L) + set.seed(42) + SP2 = SimParam$new(founderGenomes2) + SP2$setSexes("yes_sys") + SP2$addTraitA(nQtlPerChr = 5, + mean = 500, + var = 450) + + SP2$setTrackPed(TRUE) + # try the new function here, it automatically set setTrackRec also. + SP2$setTrackRecGen(TRUE) + basePop2 = newPop(founderGenomes2, simParam = SP2) + basePop2 = setPheno(basePop2, + h2 = 0.5, + simParam = SP2) + + #--- n generations + nCycles<-2 + + # very simple container for each cycles sim output + simOutput2<-list(basePop2) + cycle<-1 + for(cycle in 1:nCycles){ + cat(paste0(" C",cycle)) + # choose the best from last cycle + chosenParents<- selectInd(pop=simOutput2[[cycle]], nInd=6, use = "gv", simParam = SP2) + # make crosses + offspringPop<-randCross(pop=chosenParents, nCrosses=2, nProgeny = 5, simParam = SP2) + # phenotype new offspring + offspringPop<-setPheno(pop = offspringPop, h2 = 0.5, simParam = SP2) + # add new offspring to simOutput list + simOutput2[[cycle+1]]<-offspringPop + } + +check ind 3; chr 1; hap 1: + + RHG <- SP2$recHistGen + RH <- SP2$recHist + gm <- SP2$genMap[[1]] + + rh <- RH[[3]][[1]][[1]] + rhg <- RHG[[3]][[1]][[1]] + +Now we can see 10 more recombination events in recHistGen: + + > rh + [,1] [,2] + [1,] 2 1 + [2,] 1 8 + [3,] 2 36 + [4,] 1 44 + [5,] 2 47 + [6,] 1 50 + [7,] 2 52 + > rhg + [,1] [,2] + [1,] 2 0.000000 + [2,] 1 1.306539 + [3,] 2 2.243464 + [4,] 1 2.423857 + [5,] 2 2.608929 + [6,] 1 2.831431 + [7,] 2 4.993668 + [8,] 1 5.958832 + [9,] 2 6.238179 + [10,] 1 7.697307 + [11,] 2 7.882583 + [12,] 1 8.537422 + [13,] 2 9.214039 + [14,] 1 9.696815 + [15,] 2 10.348671 + [16,] 1 11.282477 + [17,] 2 12.080616 + +To see where the recombination events (between which SNPs) recorded in +recHistGen: + + > x <- rhg[,2] + > + > left <- findInterval(x, gm) + > right <- pmin(left + 1, length(gm)) + > + > out <- data.frame( + + x = x, + + left_i = left, + + left_v = gm[left], + + right_i = right, + + right_v = gm[right] + + ) + > + > out + x left_i left_v right_i right_v + 1 0.000000 1 0.00000 2 0.00609 + 2 1.306539 7 1.06375 8 1.36458 + 3 2.243464 10 1.77918 11 2.51330 + 4 2.423857 10 1.77918 11 2.51330 + 5 2.608929 12 2.57886 13 2.86640 + 6 2.831431 12 2.57886 13 2.86640 + 7 4.993668 35 4.64742 36 5.39801 + 8 5.958832 38 5.73197 39 6.43739 + 9 6.238179 38 5.73197 39 6.43739 + 10 7.697307 41 7.61275 42 8.31825 + 11 7.882583 41 7.61275 42 8.31825 + 12 8.537422 43 8.51587 44 8.67657 + 13 9.214039 46 8.85817 47 9.52313 + 14 9.696815 47 9.52313 48 10.44305 + 15 10.348671 47 9.52313 48 10.44305 + 16 11.282477 49 10.92943 50 11.29281 + 17 12.080616 51 11.94669 52 12.37887 + +The double crossing overs between 2 sampled SNPs (e.g. rows 3 & 4; 5 & +6; 8 & 9; 10 & 11; 14 & 15) were ignored by recHist but kept by +recHistGen. diff --git a/dev/notesRealBreakpoints.rmd b/dev/notesRealBreakpoints.rmd new file mode 100644 index 00000000..8ce08d36 --- /dev/null +++ b/dev/notesRealBreakpoints.rmd @@ -0,0 +1,322 @@ +--- +title: "notesRealBreakpoints" +output: + github_document: + output_file: ../README.md +date: "2026-02-18" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +## Test data + +Use `AlphaSimR_test/dev/multiple_chr.py` to simulate 2 chromosomes and 2 dip individuals with pedigree. Or directly use `msprime_chr0.trees` and `msprime_chr1.trees` in `AlphaSimR_test/dev/testData`. + +## Try this version + +In this version, a recHistGen object (similar to recHist) was added to record the real recombination breakpoints. + +### Load tree sequences + +``` +library(AlphaSimR) +use_virtualenv("~/r-reticulate-env", required = TRUE) +tskit <- import("tskit") +devtools::load_all() + +# two chromosomes +L1 <- 1e6 +L2 <- 2e6 +# here, use the same recombination map as used in msprime +chr_info <- list( + list(ts_path=".../AlphaSimR_test/dev/testData/msprime_chr0.trees", + breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), + #breaks=c(0, L1/2, L1), rates=c(1e-5, 2e-5), segSites=60), + list(ts_path=".../AlphaSimR_test/dev/testData/msprime_chr1.trees", + breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) + #breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-4, 1e-5, 1e-4), segSites=155) +) + +founderGenomes1 <- asMapPop(chr_info = chr_info, inbred=FALSE, ploidy=2L) +``` + +### Run AlphaSimR + +``` +set.seed(42) +SP = SimParam$new(founderGenomes1) +SP$setSexes("yes_sys") +SP$addTraitA(nQtlPerChr = 5, + mean = 500, + var = 450) + +SP$setTrackPed(TRUE) +# try the new function here, it automatically set setTrackRec also. +SP$setTrackRecGen(TRUE) +basePop = newPop(founderGenomes1) + +# the 2 objects are same now: +SP$recHistGen +SP$recHist + +basePop = setPheno(basePop, + h2 = 0.5) + +#--- n generations +nCycles<-2 + +# very simple container for each cycles sim output +simOutput<-list(basePop) +cycle<-1 +for(cycle in 1:nCycles){ + cat(paste0(" C",cycle)) + # choose the best from last cycle + chosenParents<- selectInd(pop=simOutput[[cycle]], nInd=6, use = "gv") + # make crosses + offspringPop<-randCross(pop=chosenParents, nCrosses=2, nProgeny = 5) + # phenotype new offspring + offspringPop<-setPheno(pop = offspringPop, h2 = 0.5) + # add new offspring to simOutput list + simOutput[[cycle+1]]<-offspringPop +} +``` +Now we can see the difference between recHist and recHistGen: +``` +RHG <- SP$recHistGen +RH <- SP$recHist +# ind 3; chr 2; hap 1. Maybe not the same output, please check RHG and RH to find a hap with recombination +rh <- RH[[3]][[2]][[1]] +rhg <- RHG[[3]][[2]][[1]] +gm <- SP$genMap[[2]] +``` +Col 1: original Hap; Col2: start from where (recHist: index of SNP; recHistGen: positions in Morgan) +``` +> rh + [,1] [,2] +[1,] 2 1 +[2,] 1 112 +> rhg + [,1] [,2] +[1,] 2 0.00000000 +[2,] 1 0.09354741 +``` +So, if everything goes well, rh[2,2]-1 < rhg[2,2] < rh[2,2]. We can check it with genMap (SNP index -> SNP position in Morgan): +``` +> gm[[111]] +[1] 0.0923321 +> gm[[112]] +[1] 0.0939209 +``` + +### Collect information for ts tables + +``` +pos_list <- attr(founderGenomes1, "tsForwardPosMeta", exact = TRUE)$posList +# for RecHist +bridgeSegDfList <- bridgeCollectSegFromSimOutput(SP, simOutput, pos_list = pos_list) +# for RecHistGen +bridgeSegDfListGen <- bridgeCollectSegGenFromSimOutput( + SP, simOutput, chr_info = chr_info, pos_list = pos_list +) +``` + +For RecHist, the indexes of SNPs have to be turned into positions: +``` +edgeDf <- bridgeAllSegToEdgeDf(chr_info, bridgeSegDfList, pos_list = pos_list) +``` +### Write tree files and check +``` +bridgeWriteTrees(chr_info, edgeDf, SP) +``` +In python: +``` +import tskit +origin = tskit.load('.../AlphaSimR_test/dev/testData/msprime_chr0.trees') +marker_ts = tskit.load('.../AlphaSimR_test/dev/testData/AlphaSimR_extended_chr0.trees') + +# Statistics: +# chr1 +origin.num_trees +298 +marker_ts.num_trees +298 +# chr 1 is too short for new recombination events. But 40 new nodes (2 x 20 ind) added. +origin.num_nodes +260 +marker_ts.num_nodes +300 + +# chr2 +origin = tskit.load('.../AlphaSimR_test/dev/testData/msprime_chr1.trees') +marker_ts = tskit.load('.../AlphaSimR_test/dev/testData/AlphaSimR_extended_chr1.trees') +# now here are new recombination events: +origin.num_trees +620 +marker_ts.num_trees +623 +# and still 40 new nodes: +origin.num_nodes +491 +marker_ts.num_nodes +531 +``` +We can plot the pedigree by (information in individual table): +``` +from matplotlib import pyplot as plt +import networkx as nx +import tskit +def draw_pedigree(ped_ts): + G = nx.DiGraph() + for ind in ped_ts.individuals(): + time = ped_ts.node(ind.nodes[0]).time + pop = ped_ts.node(ind.nodes[0]).population + G.add_node(ind.id, time=time, population=pop) + for p in ind.parents: + if p != tskit.NULL: + G.add_edge(ind.id, p) + pos = nx.multipartite_layout(G, subset_key="time", align="horizontal") + colours = plt.rcParams['axes.prop_cycle'].by_key()['color'] + node_colours = [colours[node_attr["population"]] for node_attr in G.nodes.values()] + nx.draw_networkx(G, pos, with_labels=True, node_color=node_colours) + plt.show() + +draw_pedigree(origin) +``` +![](../man/figures/originInd.png) + +The new individuals added: +``` +draw_pedigree(marker_ts) +``` +![](../man/figures/addInd.png) + +For RecHistGen, the returned segment list stores physical breakpoints and can be directly used: +``` +bridgeWriteTrees(chr_info, do.call(rbind, bridgeSegDfListGen), SP) +``` +### More recombinations? +Let's use the same msprime .tree files, but set higher recombination rates to see the difference between recHist and recHistGen when there are double crossing over between 2 sampled SNPs. +``` +L1 <- 1e6 +L2 <- 2e6 +chr_info <- list( + list(ts_path=".../AlphaSimR_test/dev/testData/msprime_chr0.trees", + #breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), + breaks=c(0, L1/2, L1), rates=c(1e-5, 2e-5), segSites=60), + list(ts_path=".../AlphaSimR_test/dev/testData/msprime_chr1.trees", + #breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) + breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-4, 1e-5, 1e-4), segSites=155) +) + +founderGenomes2 <- asMapPop(chr_info = chr_info, inbred=FALSE, ploidy=2L) +set.seed(42) +SP2 = SimParam$new(founderGenomes2) +SP2$setSexes("yes_sys") +SP2$addTraitA(nQtlPerChr = 5, + mean = 500, + var = 450) + +SP2$setTrackPed(TRUE) +# try the new function here, it automatically set setTrackRec also. +SP2$setTrackRecGen(TRUE) +basePop2 = newPop(founderGenomes2, simParam = SP2) +basePop2 = setPheno(basePop2, + h2 = 0.5, + simParam = SP2) + +#--- n generations +nCycles<-2 + +# very simple container for each cycles sim output +simOutput2<-list(basePop2) +cycle<-1 +for(cycle in 1:nCycles){ + cat(paste0(" C",cycle)) + # choose the best from last cycle + chosenParents<- selectInd(pop=simOutput2[[cycle]], nInd=6, use = "gv", simParam = SP2) + # make crosses + offspringPop<-randCross(pop=chosenParents, nCrosses=2, nProgeny = 5, simParam = SP2) + # phenotype new offspring + offspringPop<-setPheno(pop = offspringPop, h2 = 0.5, simParam = SP2) + # add new offspring to simOutput list + simOutput2[[cycle+1]]<-offspringPop +} +``` +check ind 3; chr 1; hap 1: +``` +RHG <- SP2$recHistGen +RH <- SP2$recHist +gm <- SP2$genMap[[1]] + +rh <- RH[[3]][[1]][[1]] +rhg <- RHG[[3]][[1]][[1]] +``` +Now we can see 10 more recombination events in recHistGen: +``` +> rh + [,1] [,2] +[1,] 2 1 +[2,] 1 8 +[3,] 2 36 +[4,] 1 44 +[5,] 2 47 +[6,] 1 50 +[7,] 2 52 +> rhg + [,1] [,2] + [1,] 2 0.000000 + [2,] 1 1.306539 + [3,] 2 2.243464 + [4,] 1 2.423857 + [5,] 2 2.608929 + [6,] 1 2.831431 + [7,] 2 4.993668 + [8,] 1 5.958832 + [9,] 2 6.238179 +[10,] 1 7.697307 +[11,] 2 7.882583 +[12,] 1 8.537422 +[13,] 2 9.214039 +[14,] 1 9.696815 +[15,] 2 10.348671 +[16,] 1 11.282477 +[17,] 2 12.080616 +``` +To see where the recombination events (between which SNPs) recorded in recHistGen: +``` +> x <- rhg[,2] +> +> left <- findInterval(x, gm) +> right <- pmin(left + 1, length(gm)) +> +> out <- data.frame( ++ x = x, ++ left_i = left, ++ left_v = gm[left], ++ right_i = right, ++ right_v = gm[right] ++ ) +> +> out + x left_i left_v right_i right_v +1 0.000000 1 0.00000 2 0.00609 +2 1.306539 7 1.06375 8 1.36458 +3 2.243464 10 1.77918 11 2.51330 +4 2.423857 10 1.77918 11 2.51330 +5 2.608929 12 2.57886 13 2.86640 +6 2.831431 12 2.57886 13 2.86640 +7 4.993668 35 4.64742 36 5.39801 +8 5.958832 38 5.73197 39 6.43739 +9 6.238179 38 5.73197 39 6.43739 +10 7.697307 41 7.61275 42 8.31825 +11 7.882583 41 7.61275 42 8.31825 +12 8.537422 43 8.51587 44 8.67657 +13 9.214039 46 8.85817 47 9.52313 +14 9.696815 47 9.52313 48 10.44305 +15 10.348671 47 9.52313 48 10.44305 +16 11.282477 49 10.92943 50 11.29281 +17 12.080616 51 11.94669 52 12.37887 +``` +The double crossing overs between 2 sampled SNPs (e.g. rows 3 & 4; 5 & 6; 8 & 9; 10 & 11; 14 & 15) were ignored by recHist but kept by recHistGen. diff --git a/dev/notesTestGrowTsTables.md b/dev/notesTestGrowTsTables.md new file mode 100644 index 00000000..05cd4f5d --- /dev/null +++ b/dev/notesTestGrowTsTables.md @@ -0,0 +1,191 @@ +``` +rm(list = ls()) +``` + +0. load dependencies (already in the R scripts, but if you have different setting plz just do this in your way) +``` +library(reticulate) +library(AlphaSimR) + +use_virtualenv("~/r-reticulate-env", required = TRUE) +msprime <- import("msprime") +tskit <- import("tskit") +``` +1. load functions +``` +devtools::load_all() +#--- or ---- +source("R/makeFoundersFromTs.R") +source("R/alphaSimR2Ts.R") +``` + +2. read the .trees files with 2 chromosomes and 2 dip individuals (from msprime) +note: chrKeptPosBpList added, so we know the position and index of sampled SNPs in the original .trees files (alphaSimR only record their index) +``` +L1 <- 1e6 +L2 <- 2e6 + +chr_info <- list( + list(ts_path="dev/testData/msprime_chr0.trees", + breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), + list(ts_path="dev/testData/msprime_chr1.trees", + breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) +) + +founderGenomes <- asMapPop(chr_info = chr_info, inbred=FALSE, ploidy=2L) +``` + +3. run alphaSimR to set the founder genomes and parameters +``` +set.seed(42) +SP = SimParam$new(founderGenomes) +SP$setSexes("yes_sys") +SP$addTraitA(nQtlPerChr = 5, + mean = 500, + var = 450) +SP$setTrackPed(TRUE) +SP$setTrackRec(TRUE) +basePop = newPop(founderGenomes) +basePop = setPheno(basePop, + h2 = 0.5) +``` + +4. run addition 2 generations +``` +#--- n generations +nCycles<-2 + +# keep founderPop and offspringPop in SimOutput +simOutput<-list(basePop) +cycle<-1 +for(cycle in 1:nCycles){ + cat(paste0(" C",cycle)) + # choose the best from last cycle + chosenParents<- selectInd(pop=simOutput[[cycle]], nInd=6, use = "gv") + # make crosses + offspringPop<-randCross(pop=chosenParents, nCrosses=2, nProgeny = 5) + # phenotype new offspring + offspringPop<-setPheno(pop = offspringPop, h2 = 0.5) + # add new offspring to simOutput list + simOutput[[cycle+1]]<-offspringPop +} +``` + +5. Link recHist (from SP, based on sampled SNPs) with parent-child hap (in tskit positions, from chrKeptPosBpList) +``` +bridgeCollectSegFromSimOutput(SP, simOutput) +``` + +6. make an edge table from bridgeSegDfList +``` +edgeDf <- bridgeAllSegToEdgeDf(chr_info) +``` + +7. write tskit tables (nodes and edges) +note1: time of founder generation: 0; time of offspring: time of the youngest parent - 1 +note2: check nodeIdMapByChr for ids of alphaSimR and tskit +note3: n ploidy is from asMapPop, so variable number of ploidy along generations is not allowed +note4: be careful with the metadata in the future (different behaviors between Python and R even with Reticulate) +``` +bridgeWriteTrees(chr_info, edgeDf, SP) +``` + +8. We can see that there is no new recombination break points in chr1, let's play with chr2 + +``` +# in Python: +import tskit +ts0 = tskit.load('.../dev/testData/msprime_chr1.trees') +ts1 = tskit.load('.../dev/testData/_AlphaSimR_extended_chr1.trees') +``` + +From edgeDf, there's a breakpoint at 1549443 +``` +ts0_1549443 = ts0.at(1549442) +ts0_1549444 = ts0.at(1549443) +ts1_1549443 = ts1.at(1549442) +ts1_1549444 = ts1.at(1549443) +``` +Same tree in the original file: +``` +print(ts0_1549443.draw_text()) +``` +``` +Output: + 182 + ┏━┻━┓ + 32 ┃ + ┏┻━┓ ┃ +12 1621 +┏┻┓ ┃ ┃ +0 2 1 3 +``` + +``` +print(ts0_1549444.draw_text()) +``` +``` +Output: + 182 + ┏━┻━┓ + 32 ┃ + ┏┻━┓ ┃ +12 1621 +┏┻┓ ┃ ┃ +0 2 1 3 +``` +Different trees in the new file +``` +print(ts1_1549443.draw_text()) +``` +``` +Output: + 182 + ┏━━━━━━━━━━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━━━━━━━━┓ + ┃ 32 + ┃ ┏━━━━━━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━━━━━┓ + 21 16 12 + ┃ ┃ ┏━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━┓ + 3 1 2 0 + ┏━━━┳━━━┳━━━┳┻━━━━┳━━━━━━━┓ ┏━━━┳━━━┳━┻━━━━━━━━━┓ ┏━━━┳━┻━┳━━━┓ ┏━━━┳━━━┳━━━━━━━━━┳━━━┻━━━━━━━━━┳━━━━━━━━━━━┓ +491 493 505 497 499 501 494 504 508 492 495 503 507 509 496 506 510 498 500 502 + ┃ ┏━┻━┓ ┏━┻━┓ ┏━━━┳━━━╋━━━┳━━━┓ ┏━━━┳━┻━┳━━━┓ ┏━━━╋━━━┓ ┏━━━╋━━━┓ + 511 512 520 523 529 522 524 526 528 530 513 515 517 519 514 516 518 521 525 527 +``` +``` +print(ts1_1549444.draw_text()) +``` +``` +Output: + 182 + ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓ + 32 ┃ + ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓ ┃ + 12 16 21 + ┏━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━┓ ┃ ┃ + 2 0 1 3 + ┏━━━┳━━━╋━━━┳━━━┓ ┏━━━┳━━━┳━━━━━━━━━┳━━━┻━━━━━━━━━┳━━━━━━━━━━━┓ ┏━━━┳━━━┳━┻━━━━━━━━━┓ ┏━━━┳━━━┳━━┻━━┳━━━━━━━┓ +491 495 503 507 509 496 506 510 498 500 502 494 504 508 492 493 505 497 499 501 + ┏━━━┳━┻━┳━━━┓ ┏━━━╋━━━┓ ┏━━━╋━━━┓ ┏━━━┳━━━╋━━━┳━━━┓ ┃ ┏━┻━┓ ┏━┻━┓ + 513 515 517 519 514 516 518 521 525 527 522 524 526 528 530 511 512 520 523 529 + +``` +difference: one of the parent nodes of node 491 (3_1 in alphaSimR) changed from 3 (2_2) to 2 (2_1), the same as edgeDf. + + +New nodes look like: +``` +ts1.tables.nodes[491] +``` +``` +Output: +NodeTableRow(flags=0, time=-1.0, population=-1, individual=-1, metadata={'alphaSimR': {'id': '3_1'}}) +``` +Founder nodes look like: +``` +ts1.tables.nodes[0] +``` +``` +Output: +NodeTableRow(flags=1, time=0.0, population=0, individual=0, metadata={'alphaSimR': {'id': '1_1'}}) +``` diff --git a/dev/reservoir_sampling.Rmd b/dev/reservoir_sampling.Rmd new file mode 100644 index 00000000..a0376b95 --- /dev/null +++ b/dev/reservoir_sampling.Rmd @@ -0,0 +1,51 @@ +#segSites = n +#qualifiedSites = N + +Algorithm: if we make segSites as a list with size $n$, for the first $n$ qualifiedSites, along the chromosome, we just put it in the list; for the others (e.g. index $i$), we generate a random number from 0 to $i$, if $i <= n$, we put it in the list, or we discard it. + +1. Probability of a site $i$ entry the list +$$ +P(entry) = +\begin{cases} +1, & i <= n, \\ +\frac{n}{i}, & i > n . +\end{cases} +$$ +2. Probability of a site $i$ in the list being replace at step $j$ $(in$ +$$ +P(not\ being\ replaced)=\prod_{j=i+1}^N \frac{j-1}{j}\\ += \frac{i}{i+1}*\frac{i+1}{i+2}*\frac{i+2}{i+3}...\frac{N-1}{N}\\ += \frac{i}{N} +$$ +3. Probability of a site $i$ in the list at the end $(j=N)$ +$$ +P(in\ the\ list)=P(entry) * P(not\ being\ replaced) +$$ +$$ +P(in\ the\ list) = +\begin{cases} +1*\frac{n}{N}, & i <= n, \\ +\frac{n}{i}*\frac{i}{N}, & i > n . +\end{cases}\\ +=\begin{cases} +\frac{n}{N}, & i <= n, \\ +\frac{n}{N}, & i > n . +\end{cases} +$$ +So, all the qualifiedSites along the chromosome have the same probability being sampled. diff --git a/dev/reservoir_sampling.html b/dev/reservoir_sampling.html new file mode 100644 index 00000000..a98e4da8 --- /dev/null +++ b/dev/reservoir_sampling.html @@ -0,0 +1,452 @@ + + + + + + + + + + + + + +reservoir_sampling.knit + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +

#segSites = n #qualifiedSites = N

+

Algorithm: if we make segSites as a list with size \(n\), for the first \(n\) qualifiedSites, along the chromosome, +we just put it in the list; for the others (e.g. index \(i\)), we generate a random number from 0 to +\(i\), if \(i +<= n\), we put it in the list, or we discard it.

+
    +
  1. Probability of a site \(i\) entry +the list \[ +P(entry) = +\begin{cases} +1, & i <= n, \\ +\frac{n}{i}, & i > n . +\end{cases} +\]
  2. +
  3. Probability of a site \(i\) in the +list being replace at step \(j\) \((i<j<=N)\) \[ +P(being\ replaced)=P(j\ entry)*P(sample\ i\ from\ list) += \frac{n}{j}*\frac{1}{n}=\frac{1}{j} +\]
  4. +
  5. Probability of a site \(i\) in the +list NOT being replace at step \(j\) +\((i<j<=N)\) \[ +P(not\ being\ replaced)=1-\frac{1}{j}=\frac{j-1}{j} +\]
  6. +
  7. Probability of a site \(i\) in the +list NOT being replace at the end \((j=N)\) For \(i<=n\) \[ +P(not\ being\ replaced)=\prod_{j=n+1}^N \frac{j-1}{j}\\ += \frac{n}{n+1}*\frac{n+1}{n+2}*\frac{n+2}{n+3}...\frac{N-1}{N}\\ += \frac{n}{N} +\] For \(i>n\) \[ +P(not\ being\ replaced)=\prod_{j=i+1}^N \frac{j-1}{j}\\ += \frac{i}{i+1}*\frac{i+1}{i+2}*\frac{i+2}{i+3}...\frac{N-1}{N}\\ += \frac{i}{N} +\]
  8. +
  9. Probability of a site \(i\) in the +list at the end \((j=N)\) \[ +P(in\ the\ list)=P(entry) * P(not\ being\ replaced) +\] \[ +P(in\ the\ list) = +\begin{cases} +1*\frac{n}{N}, & i <= n, \\ +\frac{n}{i}*\frac{i}{N}, & i > n . +\end{cases}\\ +=\begin{cases} +\frac{n}{N}, & i <= n, \\ +\frac{n}{N}, & i > n . +\end{cases} +\] So, all the qualifiedSites along the chromosome have the same +probability being sampled.
  10. +
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/dev/smokeStep1.R b/dev/smokeStep1.R new file mode 100644 index 00000000..f9233b55 --- /dev/null +++ b/dev/smokeStep1.R @@ -0,0 +1,22 @@ +## Step 1 smoke test: read site positions via C API + +library(AlphaSimRTmp) + +tsPath <- "/Users/jliang2/Projects/test_TSK2ASR/data/simulations/normal/msprime_chr1.trees" + +pos <- tsSitesPosition(tsPath) + +cat("numSites =", length(pos), "\n") +cat("firstPositions =", paste(head(pos, 10), collapse = ", "), "\n") +cat("lastPositions =", paste(tail(pos, 3), collapse = ", "), "\n") + +library(reticulate) +use_virtualenv("~/r-reticulate-env", required = TRUE) +tskit <- import("tskit") +ts <- tskit$load(tsPath) +posPy <- ts$tables$sites$position +posPy <- as.numeric(py_to_r(ts$tables$sites$position)) + +cat("numSites =", length(posPy), "\n") +cat("firstPositions =", paste(head(posPy, 10), collapse = ", "), "\n") +cat("lastPositions =", paste(tail(posPy, 3), collapse = ", "), "\n") diff --git a/dev/smokeStep2.R b/dev/smokeStep2.R new file mode 100644 index 00000000..977e1a97 --- /dev/null +++ b/dev/smokeStep2.R @@ -0,0 +1,158 @@ +library(AlphaSimR) +use_virtualenv("~/r-reticulate-env", required = TRUE) +tskit <- import("tskit") +devtools::load_all() + +# two chromosomes +L1 <- 1e6 +L2 <- 2e6 +chr_info <- list( + list(ts_path="/Users/jliang2/R_scripts/AlphaSimR_test/dev/testData/msprime_chr0.trees", + breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), + #breaks=c(0, L1/2, L1), rates=c(1e-5, 2e-5), segSites=60), + list(ts_path="/Users/jliang2/R_scripts/AlphaSimR_test/dev/testData/msprime_chr1.trees", + breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) + #breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-4, 1e-5, 1e-4), segSites=155) +) + +founderGenomes1 <- asMapPop(chr_info = chr_info, inbred=FALSE, ploidy=2L) + +set.seed(42) +SP = SimParam$new(founderGenomes1) +SP$setSexes("yes_sys") +SP$addTraitA(nQtlPerChr = 5, + mean = 500, + var = 450) + +SP$setTrackPed(TRUE) +# try the new function here, it automatically set setTrackRec also. +SP$setTrackRecGen(TRUE) +SP$recHistGen +basePop = newPop(founderGenomes1) +# the 2 objects are same now: +SP$recHistGen +SP$recHist +basePop = setPheno(basePop, + h2 = 0.5) + +#--- n generations +nCycles<-2 + +# very simple container for each cycles sim output +simOutput<-list(basePop) +cycle<-1 +for(cycle in 1:nCycles){ + cat(paste0(" C",cycle)) + # choose the best from last cycle + chosenParents<- selectInd(pop=simOutput[[cycle]], nInd=6, use = "gv") + # make crosses + offspringPop<-randCross(pop=chosenParents, nCrosses=2, nProgeny = 5) + # phenotype new offspring + offspringPop<-setPheno(pop = offspringPop, h2 = 0.5) + # add new offspring to simOutput list + simOutput[[cycle+1]]<-offspringPop +} + +# see the difference between recHist and recHistGen +RHG <- SP$recHistGen +RH <- SP$recHist +# ind 3; chr 2; hap 1. Maybe not the same output, please check RHG and RH to find a hap with recombination +rh <- RH[[3]][[2]][[1]] +rhg <- RHG[[3]][[2]][[1]] +gm <- SP$genMap[[2]] +rh +rhg +gm[[111]] +gm[[112]] + + +pos_list <- attr(founderGenomes1, "tsForwardPosMeta", exact = TRUE)$posList +# for RecHist +bridgeSegDfList <- bridgeCollectSegFromSimOutput(SP, simOutput, pos_list = pos_list) +# for RecHistGen +bridgeSegDfListGen <- bridgeCollectSegGenFromSimOutput( + SP, simOutput, chr_info = chr_info, pos_list = pos_list +) + +# for RecHist +edgeDf <- bridgeAllSegToEdgeDf(chr_info, bridgeSegDfList, pos_list = pos_list) +bridgeWriteTrees(chr_info, edgeDf, SP) +# load the tree in Python... +#origin = tskit.load('/Users/jliang2/R_scripts/AlphaSimR_test/dev/testData/msprime_chr0.trees') +#marker_ts = tskit.load('/Users/jliang2/R_scripts/AlphaSimR_test/dev/testData/AlphaSimR_extended_chr0.trees') +# check the number of trees, nodes, and individual + +# for RecHistGen +bridgeWriteTrees(chr_info, do.call(rbind, bridgeSegDfListGen), SP) +# real_break_ts = tskit.load('/Users/jliang2/R_scripts/AlphaSimR_test/dev/testData/AlphaSimR_extended_chr0.trees') + + +L1 <- 1e6 +L2 <- 2e6 +chr_info <- list( + list(ts_path="/Users/jliang2/R_scripts/AlphaSimR_test/dev/testData/msprime_chr0.trees", + #breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), + breaks=c(0, L1/2, L1), rates=c(1e-5, 2e-5), segSites=60), + list(ts_path="/Users/jliang2/R_scripts/AlphaSimR_test/dev/testData/msprime_chr1.trees", + #breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) + breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-4, 1e-5, 1e-4), segSites=155) +) + +founderGenomes2 <- asMapPop(chr_info = chr_info, inbred=FALSE, ploidy=2L) +set.seed(42) +SP2 = SimParam$new(founderGenomes2) +SP2$setSexes("yes_sys") +SP2$addTraitA(nQtlPerChr = 5, + mean = 500, + var = 450) + +SP2$setTrackPed(TRUE) +# try the new function here, it automatically set setTrackRec also. +SP2$setTrackRecGen(TRUE) +basePop2 = newPop(founderGenomes2, simParam = SP2) +basePop2 = setPheno(basePop2, + h2 = 0.5, + simParam = SP2) + +#--- n generations +nCycles<-2 + +# very simple container for each cycles sim output +simOutput2<-list(basePop2) +cycle<-1 +for(cycle in 1:nCycles){ + cat(paste0(" C",cycle)) + # choose the best from last cycle + chosenParents<- selectInd(pop=simOutput2[[cycle]], nInd=6, use = "gv", simParam = SP2) + # make crosses + offspringPop<-randCross(pop=chosenParents, nCrosses=2, nProgeny = 5, simParam = SP2) + # phenotype new offspring + offspringPop<-setPheno(pop = offspringPop, h2 = 0.5, simParam = SP2) + # add new offspring to simOutput list + simOutput2[[cycle+1]]<-offspringPop +} + +RHG <- SP2$recHistGen +RH <- SP2$recHist +gm <- SP2$genMap[[1]] + +rh <- RH[[3]][[1]][[1]] +rhg <- RHG[[3]][[1]][[1]] +rh +rhg +x <- rhg[,2] + +left <- findInterval(x, gm) +right <- pmin(left + 1, length(gm)) + +out <- data.frame( + x = x, + left_i = left, + left_v = gm[left], + right_i = right, + right_v = gm[right] +) + +out + + diff --git a/dev/testData/AlphaSimR_extended_chr0.trees b/dev/testData/AlphaSimR_extended_chr0.trees new file mode 100644 index 00000000..5ef63a20 Binary files /dev/null and b/dev/testData/AlphaSimR_extended_chr0.trees differ diff --git a/dev/testData/AlphaSimR_extended_chr1.trees b/dev/testData/AlphaSimR_extended_chr1.trees new file mode 100644 index 00000000..c7a57384 Binary files /dev/null and b/dev/testData/AlphaSimR_extended_chr1.trees differ diff --git a/dev/testData/MaCSTS.trees b/dev/testData/MaCSTS.trees new file mode 100644 index 00000000..9a3469b9 Binary files /dev/null and b/dev/testData/MaCSTS.trees differ diff --git a/dev/testData/MaCSTS_split.trees b/dev/testData/MaCSTS_split.trees new file mode 100644 index 00000000..f6d1bb80 Binary files /dev/null and b/dev/testData/MaCSTS_split.trees differ diff --git a/dev/testData/method_comparison_long.csv b/dev/testData/method_comparison_long.csv new file mode 100644 index 00000000..f13ef508 --- /dev/null +++ b/dev/testData/method_comparison_long.csv @@ -0,0 +1,601 @@ +Scenarios,Methods,rep_index,num_mut,num_trees,num_edges,num_nodes,max_root_time +single_const,macs,1,292,NA,NA,NA,NA +single_const,macsTS,1,274,20,58,34,130606.67486238344 +single_const,macs,2,266,NA,NA,NA,NA +single_const,macsTS,2,259,20,79,34,66005.3804633436 +single_const,macs,3,193,NA,NA,NA,NA +single_const,macsTS,3,251,27,94,41,97189.61165763761 +single_const,macs,4,298,NA,NA,NA,NA +single_const,macsTS,4,253,25,78,39,65334.22278608841 +single_const,macs,5,330,NA,NA,NA,NA +single_const,macsTS,5,194,12,49,26,40542.349834653956 +single_const,macs,6,278,NA,NA,NA,NA +single_const,macsTS,6,236,15,58,29,99754.70327058528 +single_const,macs,7,291,NA,NA,NA,NA +single_const,macsTS,7,235,19,58,33,81351.6226623958 +single_const,macs,8,193,NA,NA,NA,NA +single_const,macsTS,8,189,20,72,34,45808.648703602405 +single_const,macs,9,111,NA,NA,NA,NA +single_const,macsTS,9,207,14,49,28,52290.36921998231 +single_const,macs,10,337,NA,NA,NA,NA +single_const,macsTS,10,330,29,90,43,108039.19374581998 +single_const,macs,11,335,NA,NA,NA,NA +single_const,macsTS,11,311,30,100,44,113649.96430071855 +single_const,macs,12,306,NA,NA,NA,NA +single_const,macsTS,12,267,21,75,35,51015.734816689255 +single_const,macs,13,417,NA,NA,NA,NA +single_const,macsTS,13,244,25,90,39,62294.86784261862 +single_const,macs,14,434,NA,NA,NA,NA +single_const,macsTS,14,355,39,141,53,85962.47399816292 +single_const,macs,15,233,NA,NA,NA,NA +single_const,macsTS,15,265,24,81,38,52379.8410795243 +single_const,macs,16,285,NA,NA,NA,NA +single_const,macsTS,16,209,16,61,30,51910.67205473233 +single_const,macs,17,205,NA,NA,NA,NA +single_const,macsTS,17,224,16,67,30,37299.09394026202 +single_const,macs,18,215,NA,NA,NA,NA +single_const,macsTS,18,269,22,77,36,107270.56774403263 +single_const,macs,19,227,NA,NA,NA,NA +single_const,macsTS,19,348,29,102,43,106109.72033449716 +single_const,macs,20,129,NA,NA,NA,NA +single_const,macsTS,20,242,25,82,39,180889.71939212296 +single_const,macs,21,142,NA,NA,NA,NA +single_const,macsTS,21,198,13,48,27,40733.29310353212 +single_const,macs,22,227,NA,NA,NA,NA +single_const,macsTS,22,270,18,63,32,116571.33270898793 +single_const,macs,23,143,NA,NA,NA,NA +single_const,macsTS,23,181,17,74,31,20853.662115284733 +single_const,macs,24,293,NA,NA,NA,NA +single_const,macsTS,24,312,21,84,35,44483.345315484105 +single_const,macs,25,332,NA,NA,NA,NA +single_const,macsTS,25,234,22,65,36,67424.19620455234 +single_const,macs,26,153,NA,NA,NA,NA +single_const,macsTS,26,239,16,62,30,138458.70842711534 +single_const,macs,27,151,NA,NA,NA,NA +single_const,macsTS,27,279,24,83,38,127154.58609573975 +single_const,macs,28,321,NA,NA,NA,NA +single_const,macsTS,28,174,17,61,31,75246.39881131018 +single_const,macs,29,195,NA,NA,NA,NA +single_const,macsTS,29,409,21,72,35,144267.165835303 +single_const,macs,30,150,NA,NA,NA,NA +single_const,macsTS,30,222,23,85,37,61765.568583130436 +single_const,macs,31,401,NA,NA,NA,NA +single_const,macsTS,31,214,19,68,33,73704.80979141926 +single_const,macs,32,357,NA,NA,NA,NA +single_const,macsTS,32,342,24,87,38,71921.98605015522 +single_const,macs,33,230,NA,NA,NA,NA +single_const,macsTS,33,208,19,65,33,62462.15513139269 +single_const,macs,34,139,NA,NA,NA,NA +single_const,macsTS,34,216,17,61,31,53851.52711376086 +single_const,macs,35,128,NA,NA,NA,NA +single_const,macsTS,35,198,12,46,26,78535.85514919674 +single_const,macs,36,298,NA,NA,NA,NA +single_const,macsTS,36,271,20,78,34,66206.5982829437 +single_const,macs,37,242,NA,NA,NA,NA +single_const,macsTS,37,199,15,60,29,89040.392438991 +single_const,macs,38,177,NA,NA,NA,NA +single_const,macsTS,38,350,22,77,36,75469.88806207768 +single_const,macs,39,213,NA,NA,NA,NA +single_const,macsTS,39,265,13,43,27,112632.1812667316 +single_const,macs,40,163,NA,NA,NA,NA +single_const,macsTS,40,272,14,46,28,144548.0409556127 +single_const,macs,41,271,NA,NA,NA,NA +single_const,macsTS,41,171,12,44,26,107499.00379442984 +single_const,macs,42,303,NA,NA,NA,NA +single_const,macsTS,42,213,19,65,33,170059.4997680087 +single_const,macs,43,254,NA,NA,NA,NA +single_const,macsTS,43,131,13,40,27,63943.069447406204 +single_const,macs,44,176,NA,NA,NA,NA +single_const,macsTS,44,305,22,75,36,182669.6538095107 +single_const,macs,45,247,NA,NA,NA,NA +single_const,macsTS,45,262,20,71,34,80752.16600785403 +single_const,macs,46,351,NA,NA,NA,NA +single_const,macsTS,46,385,25,88,39,122260.87848955863 +single_const,macs,47,298,NA,NA,NA,NA +single_const,macsTS,47,212,24,85,38,66341.7417650338 +single_const,macs,48,248,NA,NA,NA,NA +single_const,macsTS,48,272,24,81,38,135496.13544562747 +single_const,macs,49,308,NA,NA,NA,NA +single_const,macsTS,49,266,22,86,36,45448.485984450235 +single_const,macs,50,317,NA,NA,NA,NA +single_const,macsTS,50,253,18,61,32,99598.88751005831 +single_eN,macs,1,160,NA,NA,NA,NA +single_eN,macsTS,1,203,12,36,26,58148.70761784874 +single_eN,macs,2,320,NA,NA,NA,NA +single_eN,macsTS,2,379,34,119,48,73237.30318935837 +single_eN,macs,3,414,NA,NA,NA,NA +single_eN,macsTS,3,329,31,110,45,59987.83427408926 +single_eN,macs,4,340,NA,NA,NA,NA +single_eN,macsTS,4,397,35,115,49,56439.30980824561 +single_eN,macs,5,314,NA,NA,NA,NA +single_eN,macsTS,5,208,17,62,31,61655.10045304916 +single_eN,macs,6,334,NA,NA,NA,NA +single_eN,macsTS,6,400,33,110,47,90116.32855844595 +single_eN,macs,7,182,NA,NA,NA,NA +single_eN,macsTS,7,337,43,153,57,67011.4782614623 +single_eN,macs,8,284,NA,NA,NA,NA +single_eN,macsTS,8,259,14,49,28,43365.41669535897 +single_eN,macs,9,300,NA,NA,NA,NA +single_eN,macsTS,9,340,34,122,48,94502.37456357364 +single_eN,macs,10,354,NA,NA,NA,NA +single_eN,macsTS,10,324,20,63,34,105198.40350853864 +single_eN,macs,11,324,NA,NA,NA,NA +single_eN,macsTS,11,264,23,79,37,66312.76351695477 +single_eN,macs,12,564,NA,NA,NA,NA +single_eN,macsTS,12,396,35,121,49,64750.072254029415 +single_eN,macs,13,193,NA,NA,NA,NA +single_eN,macsTS,13,266,23,85,37,62843.40133262198 +single_eN,macs,14,62,NA,NA,NA,NA +single_eN,macsTS,14,122,12,50,26,40806.2636329889 +single_eN,macs,15,372,NA,NA,NA,NA +single_eN,macsTS,15,277,30,105,44,96234.80967745245 +single_eN,macs,16,260,NA,NA,NA,NA +single_eN,macsTS,16,250,29,99,43,56696.10425093216 +single_eN,macs,17,283,NA,NA,NA,NA +single_eN,macsTS,17,286,21,72,35,57343.15317752674 +single_eN,macs,18,241,NA,NA,NA,NA +single_eN,macsTS,18,161,19,71,33,54196.02216942763 +single_eN,macs,19,309,NA,NA,NA,NA +single_eN,macsTS,19,383,25,86,39,76826.81946095033 +single_eN,macs,20,359,NA,NA,NA,NA +single_eN,macsTS,20,327,18,66,32,88701.81044253254 +single_eN,macs,21,292,NA,NA,NA,NA +single_eN,macsTS,21,274,17,65,31,50449.55770401915 +single_eN,macs,22,274,NA,NA,NA,NA +single_eN,macsTS,22,388,31,106,45,70169.78689802613 +single_eN,macs,23,99,NA,NA,NA,NA +single_eN,macsTS,23,168,16,52,30,74425.03144068009 +single_eN,macs,24,296,NA,NA,NA,NA +single_eN,macsTS,24,384,35,128,49,77314.17173828399 +single_eN,macs,25,390,NA,NA,NA,NA +single_eN,macsTS,25,431,36,134,50,58974.239835569344 +single_eN,macs,26,462,NA,NA,NA,NA +single_eN,macsTS,26,469,34,118,48,85835.71488334516 +single_eN,macs,27,219,NA,NA,NA,NA +single_eN,macsTS,27,394,28,105,42,75219.45389647888 +single_eN,macs,28,418,NA,NA,NA,NA +single_eN,macsTS,28,285,26,94,40,66174.77320616253 +single_eN,macs,29,281,NA,NA,NA,NA +single_eN,macsTS,29,251,14,54,28,46879.72773540639 +single_eN,macs,30,286,NA,NA,NA,NA +single_eN,macsTS,30,301,22,77,36,65981.22543811104 +single_eN,macs,31,280,NA,NA,NA,NA +single_eN,macsTS,31,237,22,76,36,58123.1952900851 +single_eN,macs,32,436,NA,NA,NA,NA +single_eN,macsTS,32,284,24,76,38,57339.635819378615 +single_eN,macs,33,379,NA,NA,NA,NA +single_eN,macsTS,33,379,21,76,35,67313.65198213924 +single_eN,macs,34,177,NA,NA,NA,NA +single_eN,macsTS,34,123,8,36,22,47949.231529550314 +single_eN,macs,35,266,NA,NA,NA,NA +single_eN,macsTS,35,220,11,38,25,62608.54938748934 +single_eN,macs,36,278,NA,NA,NA,NA +single_eN,macsTS,36,389,32,116,46,67328.62744153728 +single_eN,macs,37,304,NA,NA,NA,NA +single_eN,macsTS,37,313,27,94,41,58620.81909963436 +single_eN,macs,38,422,NA,NA,NA,NA +single_eN,macsTS,38,319,31,111,45,71086.09316638751 +single_eN,macs,39,425,NA,NA,NA,NA +single_eN,macsTS,39,285,13,49,27,53742.71646574813 +single_eN,macs,40,443,NA,NA,NA,NA +single_eN,macsTS,40,275,24,84,38,50174.49762119274 +single_eN,macs,41,362,NA,NA,NA,NA +single_eN,macsTS,41,448,27,90,41,62652.78292888323 +single_eN,macs,42,342,NA,NA,NA,NA +single_eN,macsTS,42,129,12,47,26,69844.15714169925 +single_eN,macs,43,319,NA,NA,NA,NA +single_eN,macsTS,43,329,35,124,49,56479.26214014877 +single_eN,macs,44,368,NA,NA,NA,NA +single_eN,macsTS,44,254,23,67,37,101945.72699971082 +single_eN,macs,45,355,NA,NA,NA,NA +single_eN,macsTS,45,418,42,138,56,86714.95866792956 +single_eN,macs,46,356,NA,NA,NA,NA +single_eN,macsTS,46,306,23,89,37,62318.73367420454 +single_eN,macs,47,357,NA,NA,NA,NA +single_eN,macsTS,47,375,28,90,42,57971.59387918696 +single_eN,macs,48,327,NA,NA,NA,NA +single_eN,macsTS,48,342,32,100,46,75423.99618262045 +single_eN,macs,49,438,NA,NA,NA,NA +single_eN,macsTS,49,361,26,90,40,55701.874157323844 +single_eN,macs,50,361,NA,NA,NA,NA +single_eN,macsTS,50,448,40,134,54,62089.414036778006 +I2_migration,macs,1,582,NA,NA,NA,NA +I2_migration,macsTS,1,627,33,110,47,125595.0592035079 +I2_migration,macs,2,539,NA,NA,NA,NA +I2_migration,macsTS,2,505,38,140,52,69051.04466396774 +I2_migration,macs,3,528,NA,NA,NA,NA +I2_migration,macsTS,3,605,48,166,62,139258.2963791596 +I2_migration,macs,4,491,NA,NA,NA,NA +I2_migration,macsTS,4,536,45,157,59,103649.84187421224 +I2_migration,macs,5,549,NA,NA,NA,NA +I2_migration,macsTS,5,458,44,151,58,147820.3717300555 +I2_migration,macs,6,627,NA,NA,NA,NA +I2_migration,macsTS,6,467,33,100,47,106171.06252651944 +I2_migration,macs,7,524,NA,NA,NA,NA +I2_migration,macsTS,7,517,41,134,55,173291.5683727674 +I2_migration,macs,8,498,NA,NA,NA,NA +I2_migration,macsTS,8,643,40,123,54,174791.06245591235 +I2_migration,macs,9,596,NA,NA,NA,NA +I2_migration,macsTS,9,551,42,141,56,90119.13525790816 +I2_migration,macs,10,492,NA,NA,NA,NA +I2_migration,macsTS,10,428,31,98,45,95075.75913438266 +I2_migration,macs,11,566,NA,NA,NA,NA +I2_migration,macsTS,11,499,35,127,49,79081.60485874035 +I2_migration,macs,12,541,NA,NA,NA,NA +I2_migration,macsTS,12,494,45,147,59,121775.70943984257 +I2_migration,macs,13,441,NA,NA,NA,NA +I2_migration,macsTS,13,471,28,100,42,78114.97528089151 +I2_migration,macs,14,473,NA,NA,NA,NA +I2_migration,macsTS,14,532,29,103,43,106166.65191412302 +I2_migration,macs,15,607,NA,NA,NA,NA +I2_migration,macsTS,15,493,31,111,45,83665.48344197539 +I2_migration,macs,16,504,NA,NA,NA,NA +I2_migration,macsTS,16,504,39,132,53,103299.11013445014 +I2_migration,macs,17,532,NA,NA,NA,NA +I2_migration,macsTS,17,540,45,156,59,88757.00554271559 +I2_migration,macs,18,622,NA,NA,NA,NA +I2_migration,macsTS,18,522,37,132,51,62917.25814639296 +I2_migration,macs,19,364,NA,NA,NA,NA +I2_migration,macsTS,19,439,36,119,50,101256.01177174292 +I2_migration,macs,20,458,NA,NA,NA,NA +I2_migration,macsTS,20,471,31,107,45,96603.20711064144 +I2_migration,macs,21,459,NA,NA,NA,NA +I2_migration,macsTS,21,489,37,113,51,158103.7816584265 +I2_migration,macs,22,471,NA,NA,NA,NA +I2_migration,macsTS,22,434,23,87,37,71859.57364798218 +I2_migration,macs,23,488,NA,NA,NA,NA +I2_migration,macsTS,23,464,30,108,44,91331.82904515398 +I2_migration,macs,24,500,NA,NA,NA,NA +I2_migration,macsTS,24,476,28,99,42,61123.035132749435 +I2_migration,macs,25,523,NA,NA,NA,NA +I2_migration,macsTS,25,500,27,89,41,124239.0158935418 +I2_migration,macs,26,581,NA,NA,NA,NA +I2_migration,macsTS,26,533,38,130,52,163712.94130790394 +I2_migration,macs,27,637,NA,NA,NA,NA +I2_migration,macsTS,27,521,34,115,48,111428.88359968473 +I2_migration,macs,28,500,NA,NA,NA,NA +I2_migration,macsTS,28,538,38,145,52,65652.4919728632 +I2_migration,macs,29,517,NA,NA,NA,NA +I2_migration,macsTS,29,734,56,188,70,141720.26896218708 +I2_migration,macs,30,533,NA,NA,NA,NA +I2_migration,macsTS,30,471,33,106,47,106588.62693968821 +I2_migration,macs,31,525,NA,NA,NA,NA +I2_migration,macsTS,31,565,43,149,57,95128.1296007667 +I2_migration,macs,32,478,NA,NA,NA,NA +I2_migration,macsTS,32,524,30,95,44,167372.02797098926 +I2_migration,macs,33,654,NA,NA,NA,NA +I2_migration,macsTS,33,422,24,86,38,71365.55178817052 +I2_migration,macs,34,405,NA,NA,NA,NA +I2_migration,macsTS,34,505,34,107,48,173942.95068443177 +I2_migration,macs,35,522,NA,NA,NA,NA +I2_migration,macsTS,35,489,29,103,43,84211.49213274148 +I2_migration,macs,36,500,NA,NA,NA,NA +I2_migration,macsTS,36,551,48,160,62,100764.74136591831 +I2_migration,macs,37,551,NA,NA,NA,NA +I2_migration,macsTS,37,571,40,136,54,100509.16382435102 +I2_migration,macs,38,548,NA,NA,NA,NA +I2_migration,macsTS,38,442,29,97,43,71547.32702351622 +I2_migration,macs,39,490,NA,NA,NA,NA +I2_migration,macsTS,39,476,34,113,48,132531.25966989965 +I2_migration,macs,40,607,NA,NA,NA,NA +I2_migration,macsTS,40,464,34,116,48,89430.71699339058 +I2_migration,macs,41,568,NA,NA,NA,NA +I2_migration,macsTS,41,647,33,111,47,136410.0867010556 +I2_migration,macs,42,441,NA,NA,NA,NA +I2_migration,macsTS,42,529,33,112,47,147578.25136597085 +I2_migration,macs,43,533,NA,NA,NA,NA +I2_migration,macsTS,43,591,36,116,50,132280.1214687966 +I2_migration,macs,44,503,NA,NA,NA,NA +I2_migration,macsTS,44,443,29,102,43,85604.37570948259 +I2_migration,macs,45,554,NA,NA,NA,NA +I2_migration,macsTS,45,557,38,134,52,91444.366083548 +I2_migration,macs,46,551,NA,NA,NA,NA +I2_migration,macsTS,46,562,41,137,55,114930.89187933954 +I2_migration,macs,47,412,NA,NA,NA,NA +I2_migration,macsTS,47,493,33,103,47,111626.95008240972 +I2_migration,macs,48,449,NA,NA,NA,NA +I2_migration,macsTS,48,391,23,83,37,100456.89821919928 +I2_migration,macs,49,444,NA,NA,NA,NA +I2_migration,macsTS,49,442,35,102,49,165026.4308093184 +I2_migration,macs,50,486,NA,NA,NA,NA +I2_migration,macsTS,50,527,41,134,55,92467.67606152399 +I2_en_join,macs,1,440,NA,NA,NA,NA +I2_en_join,macsTS,1,422,22,78,36,90455.38931129313 +I2_en_join,macs,2,584,NA,NA,NA,NA +I2_en_join,macsTS,2,451,31,102,45,107851.61578425579 +I2_en_join,macs,3,485,NA,NA,NA,NA +I2_en_join,macsTS,3,646,35,112,49,183858.70189677476 +I2_en_join,macs,4,595,NA,NA,NA,NA +I2_en_join,macsTS,4,523,37,124,51,116752.63943077975 +I2_en_join,macs,5,385,NA,NA,NA,NA +I2_en_join,macsTS,5,418,27,94,41,154141.1439168411 +I2_en_join,macs,6,425,NA,NA,NA,NA +I2_en_join,macsTS,6,386,28,98,42,82638.96955724066 +I2_en_join,macs,7,459,NA,NA,NA,NA +I2_en_join,macsTS,7,470,23,73,37,207774.83980101155 +I2_en_join,macs,8,513,NA,NA,NA,NA +I2_en_join,macsTS,8,524,33,110,47,74595.09543570883 +I2_en_join,macs,9,619,NA,NA,NA,NA +I2_en_join,macsTS,9,541,40,123,54,149456.85982834117 +I2_en_join,macs,10,514,NA,NA,NA,NA +I2_en_join,macsTS,10,442,31,96,45,121567.6442901922 +I2_en_join,macs,11,367,NA,NA,NA,NA +I2_en_join,macsTS,11,538,39,133,53,106157.48704784577 +I2_en_join,macs,12,558,NA,NA,NA,NA +I2_en_join,macsTS,12,495,33,117,47,94031.1620166754 +I2_en_join,macs,13,288,NA,NA,NA,NA +I2_en_join,macsTS,13,502,30,108,44,104611.39856162715 +I2_en_join,macs,14,511,NA,NA,NA,NA +I2_en_join,macsTS,14,484,27,81,41,130161.8159830226 +I2_en_join,macs,15,676,NA,NA,NA,NA +I2_en_join,macsTS,15,515,42,143,56,83964.44708974562 +I2_en_join,macs,16,386,NA,NA,NA,NA +I2_en_join,macsTS,16,317,21,62,35,70640.02667351977 +I2_en_join,macs,17,508,NA,NA,NA,NA +I2_en_join,macsTS,17,540,35,120,49,103361.30568765034 +I2_en_join,macs,18,383,NA,NA,NA,NA +I2_en_join,macsTS,18,451,32,115,46,72980.98320142283 +I2_en_join,macs,19,602,NA,NA,NA,NA +I2_en_join,macsTS,19,527,35,111,49,197078.8600888442 +I2_en_join,macs,20,431,NA,NA,NA,NA +I2_en_join,macsTS,20,508,37,121,51,90327.2967897602 +I2_en_join,macs,21,450,NA,NA,NA,NA +I2_en_join,macsTS,21,418,34,121,48,110186.92787382715 +I2_en_join,macs,22,545,NA,NA,NA,NA +I2_en_join,macsTS,22,498,37,127,51,124027.34308081327 +I2_en_join,macs,23,512,NA,NA,NA,NA +I2_en_join,macsTS,23,546,31,106,45,135894.73377142084 +I2_en_join,macs,24,528,NA,NA,NA,NA +I2_en_join,macsTS,24,494,37,126,51,82304.45301359073 +I2_en_join,macs,25,462,NA,NA,NA,NA +I2_en_join,macsTS,25,585,32,111,46,106878.15529906558 +I2_en_join,macs,26,491,NA,NA,NA,NA +I2_en_join,macsTS,26,378,18,64,32,54813.6687179415 +I2_en_join,macs,27,623,NA,NA,NA,NA +I2_en_join,macsTS,27,571,36,123,50,123821.58156083069 +I2_en_join,macs,28,608,NA,NA,NA,NA +I2_en_join,macsTS,28,422,31,101,45,114562.44899022473 +I2_en_join,macs,29,461,NA,NA,NA,NA +I2_en_join,macsTS,29,371,31,94,45,73204.11409907653 +I2_en_join,macs,30,451,NA,NA,NA,NA +I2_en_join,macsTS,30,358,17,58,31,126643.50152549303 +I2_en_join,macs,31,560,NA,NA,NA,NA +I2_en_join,macsTS,31,435,35,113,49,93812.34602557738 +I2_en_join,macs,32,406,NA,NA,NA,NA +I2_en_join,macsTS,32,435,28,97,42,173833.53023783205 +I2_en_join,macs,33,511,NA,NA,NA,NA +I2_en_join,macsTS,33,525,48,151,62,138952.43262708606 +I2_en_join,macs,34,522,NA,NA,NA,NA +I2_en_join,macsTS,34,520,31,109,45,95206.40144126478 +I2_en_join,macs,35,489,NA,NA,NA,NA +I2_en_join,macsTS,35,463,32,103,46,96966.11837531606 +I2_en_join,macs,36,401,NA,NA,NA,NA +I2_en_join,macsTS,36,587,46,138,60,132442.54970897004 +I2_en_join,macs,37,534,NA,NA,NA,NA +I2_en_join,macsTS,37,508,46,157,60,136801.611158379 +I2_en_join,macs,38,521,NA,NA,NA,NA +I2_en_join,macsTS,38,484,37,125,51,131151.69116822493 +I2_en_join,macs,39,508,NA,NA,NA,NA +I2_en_join,macsTS,39,488,35,121,49,69016.19080364131 +I2_en_join,macs,40,411,NA,NA,NA,NA +I2_en_join,macsTS,40,425,37,129,51,94834.223990139 +I2_en_join,macs,41,474,NA,NA,NA,NA +I2_en_join,macsTS,41,465,29,103,43,97902.31158913208 +I2_en_join,macs,42,521,NA,NA,NA,NA +I2_en_join,macsTS,42,589,39,124,53,145067.56728698316 +I2_en_join,macs,43,456,NA,NA,NA,NA +I2_en_join,macsTS,43,646,35,130,49,109362.72265163346 +I2_en_join,macs,44,584,NA,NA,NA,NA +I2_en_join,macsTS,44,490,41,138,55,77247.08875282347 +I2_en_join,macs,45,550,NA,NA,NA,NA +I2_en_join,macsTS,45,359,20,65,34,118079.92958954102 +I2_en_join,macs,46,465,NA,NA,NA,NA +I2_en_join,macsTS,46,389,19,63,33,79540.0147356808 +I2_en_join,macs,47,480,NA,NA,NA,NA +I2_en_join,macsTS,47,552,30,96,44,92562.34819935205 +I2_en_join,macs,48,505,NA,NA,NA,NA +I2_en_join,macsTS,48,451,36,114,50,110286.92669633475 +I2_en_join,macs,49,607,NA,NA,NA,NA +I2_en_join,macsTS,49,423,17,61,31,81610.0812337726 +I2_en_join,macs,50,455,NA,NA,NA,NA +I2_en_join,macsTS,50,433,35,127,49,52605.5527063386 +single_const,msprime,1,183,15,56,29,51515.624918270456 +single_const,msprime,2,182,10,39,24,38763.80929698479 +single_const,msprime,3,336,27,87,41,109851.59102262642 +single_const,msprime,4,302,19,60,33,71899.5063036042 +single_const,msprime,5,173,16,59,30,52296.832527444945 +single_const,msprime,6,385,22,72,36,107743.52694763753 +single_const,msprime,7,168,16,64,30,30982.913633311287 +single_const,msprime,8,185,15,53,29,42181.611232091986 +single_const,msprime,9,184,20,65,34,59486.900392048585 +single_const,msprime,10,368,27,100,41,133055.80730249957 +single_const,msprime,11,262,31,114,45,48101.23294676906 +single_const,msprime,12,308,17,62,31,63690.27186884565 +single_const,msprime,13,199,21,74,35,49134.08270938573 +single_const,msprime,14,247,19,62,33,145182.40082078552 +single_const,msprime,15,244,24,91,38,62951.162590399596 +single_const,msprime,16,169,20,71,34,61498.16018360143 +single_const,msprime,17,266,22,74,36,111984.27213178847 +single_const,msprime,18,212,18,62,32,62641.42329757322 +single_const,msprime,19,275,20,69,34,80908.66388577598 +single_const,msprime,20,226,18,67,32,48753.6405100759 +single_const,msprime,21,351,23,85,37,62544.20329534801 +single_const,msprime,22,414,33,115,47,113011.0036309333 +single_const,msprime,23,276,28,110,42,63308.11472786501 +single_const,msprime,24,290,33,116,47,72418.28878141462 +single_const,msprime,25,221,23,82,37,56335.882104651864 +single_const,msprime,26,241,21,73,35,51653.59431584614 +single_const,msprime,27,281,29,106,43,102642.5271660279 +single_const,msprime,28,168,19,75,33,34588.383891724756 +single_const,msprime,29,204,17,62,31,62059.40939102222 +single_const,msprime,30,346,27,97,41,61260.760688875846 +single_const,msprime,31,291,28,91,42,120961.95623420269 +single_const,msprime,32,245,25,80,39,101173.91313550806 +single_const,msprime,33,304,30,103,44,63214.719234547876 +single_const,msprime,34,168,24,90,38,59006.04499853586 +single_const,msprime,35,344,49,164,63,98439.678484823 +single_const,msprime,36,172,14,49,28,50947.17699231931 +single_const,msprime,37,233,22,75,36,107320.9949119463 +single_const,msprime,38,289,20,71,34,79909.61109567845 +single_const,msprime,39,375,26,75,40,215760.75977841174 +single_const,msprime,40,319,17,66,31,69801.66186033799 +single_const,msprime,41,248,17,58,31,220971.26340291178 +single_const,msprime,42,80,11,34,25,109586.0356718846 +single_const,msprime,43,324,45,155,59,80630.78342095218 +single_const,msprime,44,263,27,104,41,54966.31877490516 +single_const,msprime,45,301,24,86,38,110946.77752676011 +single_const,msprime,46,197,17,58,31,67986.62845344585 +single_const,msprime,47,116,20,68,34,36060.08235496283 +single_const,msprime,48,313,19,59,33,126691.67299354449 +single_const,msprime,49,166,16,52,30,56095.740271687566 +single_const,msprime,50,312,25,82,39,88200.64578802258 +single_eN,msprime,1,278,28,92,42,65349.221239219914 +single_eN,msprime,2,291,14,47,28,60601.858488352605 +single_eN,msprime,3,415,34,123,48,57700.03535382562 +single_eN,msprime,4,440,32,110,46,76756.02982500306 +single_eN,msprime,5,315,30,91,44,70233.68216998836 +single_eN,msprime,6,300,26,84,40,77770.58646889063 +single_eN,msprime,7,352,25,88,39,60711.685354389985 +single_eN,msprime,8,287,20,70,34,60906.76361323841 +single_eN,msprime,9,414,40,133,54,79944.65892375396 +single_eN,msprime,10,394,31,106,45,70883.21756212738 +single_eN,msprime,11,461,33,123,47,73185.65542500555 +single_eN,msprime,12,301,25,84,39,54214.5164817196 +single_eN,msprime,13,273,22,75,36,69316.99951743032 +single_eN,msprime,14,371,36,129,50,73958.80454455342 +single_eN,msprime,15,288,25,78,39,72251.77689228117 +single_eN,msprime,16,298,21,69,35,53200.65206122284 +single_eN,msprime,17,216,19,69,33,44701.715341613424 +single_eN,msprime,18,303,30,97,44,58467.65305087444 +single_eN,msprime,19,217,18,53,32,67179.14113887127 +single_eN,msprime,20,428,26,92,40,67345.61920307747 +single_eN,msprime,21,255,22,72,36,98197.94041900555 +single_eN,msprime,22,322,34,120,48,73182.20215592455 +single_eN,msprime,23,334,21,78,35,55335.493334815896 +single_eN,msprime,24,360,26,93,40,83432.89937189074 +single_eN,msprime,25,385,40,130,54,106811.08207251274 +single_eN,msprime,26,293,18,62,32,72244.85713844906 +single_eN,msprime,27,313,25,89,39,61504.11927676364 +single_eN,msprime,28,276,16,51,30,67348.08434313306 +single_eN,msprime,29,329,27,94,41,68020.2817782327 +single_eN,msprime,30,371,24,90,38,73755.84780580996 +single_eN,msprime,31,359,32,113,46,112980.87085682394 +single_eN,msprime,32,208,20,59,34,52219.14757403417 +single_eN,msprime,33,365,37,127,51,63248.632349512416 +single_eN,msprime,34,304,19,67,33,53891.48572153046 +single_eN,msprime,35,210,15,60,29,50358.69328985923 +single_eN,msprime,36,240,24,85,38,54082.961824516686 +single_eN,msprime,37,459,30,113,44,62921.43534671086 +single_eN,msprime,38,330,17,59,31,61021.66401499905 +single_eN,msprime,39,457,31,110,45,77492.89793784614 +single_eN,msprime,40,260,15,52,29,62864.54151974913 +single_eN,msprime,41,435,37,123,51,100651.98483044902 +single_eN,msprime,42,271,18,58,32,73950.93821976396 +single_eN,msprime,43,275,27,82,41,93497.79468971904 +single_eN,msprime,44,442,28,107,42,74339.58448917311 +single_eN,msprime,45,387,33,110,47,101236.0734923974 +single_eN,msprime,46,330,18,67,32,57038.03720408608 +single_eN,msprime,47,356,26,89,40,72114.30160262527 +single_eN,msprime,48,389,27,104,41,100002.2178829616 +single_eN,msprime,49,244,17,55,31,65854.7399945304 +single_eN,msprime,50,343,24,85,38,65002.540328711504 +I2_migration,msprime,1,546,38,137,52,97564.58412883535 +I2_migration,msprime,2,382,30,90,44,117642.80370111366 +I2_migration,msprime,3,567,45,160,59,84207.66407721497 +I2_migration,msprime,4,417,33,109,47,109918.36926777275 +I2_migration,msprime,5,489,45,155,59,114973.54073907119 +I2_migration,msprime,6,483,36,129,50,114188.44189606888 +I2_migration,msprime,7,608,48,166,62,93753.24179771724 +I2_migration,msprime,8,508,34,102,48,116856.75958831569 +I2_migration,msprime,9,463,29,103,43,62770.346245957306 +I2_migration,msprime,10,518,38,124,52,135423.86365044612 +I2_migration,msprime,11,453,37,115,51,118090.57466322677 +I2_migration,msprime,12,628,38,127,52,209534.1610295494 +I2_migration,msprime,13,536,43,149,57,89912.36330586261 +I2_migration,msprime,14,483,42,141,56,128912.51711145912 +I2_migration,msprime,15,618,45,152,59,158871.44365126808 +I2_migration,msprime,16,544,36,114,50,159695.05489009136 +I2_migration,msprime,17,463,38,120,52,99170.41393187974 +I2_migration,msprime,18,499,27,96,41,106487.65319013289 +I2_migration,msprime,19,561,37,130,52,101057.78304616034 +I2_migration,msprime,20,446,30,106,44,107384.27427104083 +I2_migration,msprime,21,448,30,104,44,96818.1513162082 +I2_migration,msprime,22,465,38,130,52,95245.67309246887 +I2_migration,msprime,23,519,27,95,41,80206.69234565251 +I2_migration,msprime,24,532,55,176,69,160077.76387616264 +I2_migration,msprime,25,385,28,83,42,144681.399583353 +I2_migration,msprime,26,495,41,128,55,117771.10101605413 +I2_migration,msprime,27,489,26,81,40,110262.67331368584 +I2_migration,msprime,28,493,33,124,47,120967.20685852526 +I2_migration,msprime,29,420,32,101,46,139142.03401837248 +I2_migration,msprime,30,607,54,167,68,164135.22989891114 +I2_migration,msprime,31,594,34,109,48,145106.40932381916 +I2_migration,msprime,32,505,38,135,52,75733.69112892961 +I2_migration,msprime,33,497,35,124,49,109977.00581672597 +I2_migration,msprime,34,650,49,159,63,121041.38130669676 +I2_migration,msprime,35,482,28,100,42,61154.63265076551 +I2_migration,msprime,36,572,53,172,67,128486.13469860726 +I2_migration,msprime,37,533,48,159,62,95052.05016785166 +I2_migration,msprime,38,555,40,126,54,129105.13464317753 +I2_migration,msprime,39,694,36,116,50,108180.6860369713 +I2_migration,msprime,40,481,29,95,43,130476.93001143142 +I2_migration,msprime,41,480,26,90,40,78868.02124460539 +I2_migration,msprime,42,556,39,124,53,119361.57872816 +I2_migration,msprime,43,628,46,150,60,155208.89518427377 +I2_migration,msprime,44,494,35,124,49,97188.69526910788 +I2_migration,msprime,45,469,32,117,46,67242.4266414875 +I2_migration,msprime,46,463,15,50,29,70366.02587526909 +I2_migration,msprime,47,472,37,116,51,81929.4748655115 +I2_migration,msprime,48,475,28,92,42,115961.5565377741 +I2_migration,msprime,49,420,30,100,44,125649.90496392331 +I2_migration,msprime,50,577,41,140,55,101972.0338190745 +I2_en_join,msprime,1,520,37,128,51,88064.37475288789 +I2_en_join,msprime,2,538,29,95,43,102022.72632240821 +I2_en_join,msprime,3,508,30,103,44,118759.6618453868 +I2_en_join,msprime,4,479,29,93,43,110921.88324171577 +I2_en_join,msprime,5,380,18,60,32,107826.72923659543 +I2_en_join,msprime,6,434,28,101,42,62612.626182878535 +I2_en_join,msprime,7,429,28,93,42,91517.83086066617 +I2_en_join,msprime,8,508,37,125,51,110710.74581906163 +I2_en_join,msprime,9,439,30,101,44,92681.35855864939 +I2_en_join,msprime,10,551,37,123,51,114305.29809637179 +I2_en_join,msprime,11,599,42,146,56,132781.0284582705 +I2_en_join,msprime,12,518,21,73,35,123530.34848851709 +I2_en_join,msprime,13,409,28,91,42,95590.32795791008 +I2_en_join,msprime,14,477,35,116,49,88920.540199851 +I2_en_join,msprime,15,470,38,123,52,134691.8823494508 +I2_en_join,msprime,16,482,27,93,41,81440.42239981552 +I2_en_join,msprime,17,413,34,118,48,89006.92352507866 +I2_en_join,msprime,18,530,47,152,61,109201.08759579713 +I2_en_join,msprime,19,413,27,89,41,102939.78991988773 +I2_en_join,msprime,20,546,38,125,52,135238.74755217478 +I2_en_join,msprime,21,651,35,121,49,81607.07191886393 +I2_en_join,msprime,22,522,36,105,50,151949.8203850263 +I2_en_join,msprime,23,452,34,118,48,89961.69857797603 +I2_en_join,msprime,24,491,35,114,49,97904.68440797148 +I2_en_join,msprime,25,405,23,80,37,115452.8229915257 +I2_en_join,msprime,26,511,39,126,53,114677.69989790722 +I2_en_join,msprime,27,466,29,95,43,95506.38537926153 +I2_en_join,msprime,28,580,44,155,58,83579.41444430909 +I2_en_join,msprime,29,423,39,129,53,95313.99758613606 +I2_en_join,msprime,30,435,37,133,51,57249.201972139046 +I2_en_join,msprime,31,457,29,92,43,122457.13829746937 +I2_en_join,msprime,32,453,35,125,49,94070.54039875766 +I2_en_join,msprime,33,565,38,122,52,102975.86477934282 +I2_en_join,msprime,34,441,24,86,38,105387.28917250219 +I2_en_join,msprime,35,403,21,69,35,154081.72616774266 +I2_en_join,msprime,36,481,30,101,44,85368.92444472763 +I2_en_join,msprime,37,600,40,134,54,133494.6392175415 +I2_en_join,msprime,38,438,25,88,39,95210.50516400867 +I2_en_join,msprime,39,467,41,142,55,121279.25515798831 +I2_en_join,msprime,40,444,40,130,54,142588.6776950081 +I2_en_join,msprime,41,436,32,111,46,101501.03501702432 +I2_en_join,msprime,42,580,38,126,52,137147.77205237906 +I2_en_join,msprime,43,484,24,86,38,70167.56944579098 +I2_en_join,msprime,44,473,37,124,51,127339.60094870909 +I2_en_join,msprime,45,519,35,109,49,157011.9311568176 +I2_en_join,msprime,46,459,25,84,39,110942.62839244043 +I2_en_join,msprime,47,556,35,122,49,100145.88432616864 +I2_en_join,msprime,48,309,21,64,35,85136.93693449725 +I2_en_join,msprime,49,409,29,104,43,75896.71347412044 +I2_en_join,msprime,50,504,35,112,49,112863.5251947745 diff --git a/dev/testData/msprime_chr0.trees b/dev/testData/msprime_chr0.trees new file mode 100644 index 00000000..6942f0fd Binary files /dev/null and b/dev/testData/msprime_chr0.trees differ diff --git a/dev/testData/msprime_chr1.trees b/dev/testData/msprime_chr1.trees new file mode 100644 index 00000000..b5477e21 Binary files /dev/null and b/dev/testData/msprime_chr1.trees differ diff --git a/dev/testData/msprime_combined.vcf b/dev/testData/msprime_combined.vcf new file mode 100644 index 00000000..e4d3e156 --- /dev/null +++ b/dev/testData/msprime_combined.vcf @@ -0,0 +1,242 @@ +##fileformat=VCFv4.2 +##FILTER= +##source=tskit 0.6.4 +##contig= +##FORMAT= +##contig= +##bcftools_concatVersion=1.24-8-gf098ab5a+htslib-1.24-40-g70dc8705 +##bcftools_concatCommand=concat -O v -o msprime_combined.vcf msprime_chr0.vcf msprime_chr1.vcf; Date=Tue Aug 18 11:52:07 2026 +#CHROM POS ID REF ALT QUAL FILTER INFO FORMAT tsk_0 tsk_1 +chr0 4649 0 C G . PASS . GT 1|0 1|0 +chr0 5258 1 A T . PASS . GT 0|1 0|0 +chr0 44375 2 C A . PASS . GT 0|1 0|0 +chr0 59104 3 C G . PASS . GT 0|0 0|1 +chr0 73422 4 A T . PASS . GT 1|0 1|0 +chr0 80055 5 T G . PASS . GT 1|0 1|0 +chr0 82448 6 T A . PASS . GT 0|0 0|1 +chr0 107520 7 C A . PASS . GT 0|0 0|1 +chr0 111024 8 T G . PASS . GT 0|0 0|1 +chr0 139631 9 A C . PASS . GT 1|0 1|1 +chr0 141107 10 G T . PASS . GT 1|0 1|1 +chr0 174813 11 G A . PASS . GT 1|0 1|0 +chr0 182567 12 C G . PASS . GT 0|1 0|0 +chr0 214455 13 T C . PASS . GT 0|0 0|1 +chr0 255979 14 A C . PASS . GT 0|1 0|0 +chr0 262535 15 A G . PASS . GT 1|0 1|0 +chr0 291289 16 A G . PASS . GT 1|0 1|1 +chr0 317414 17 C A . PASS . GT 0|1 0|1 +chr0 326042 18 A T . PASS . GT 1|1 1|0 +chr0 336255 19 G C . PASS . GT 0|0 0|1 +chr0 354685 20 G A . PASS . GT 0|1 0|0 +chr0 364018 21 A C . PASS . GT 0|0 0|1 +chr0 376059 22 T G . PASS . GT 0|0 0|1 +chr0 376421 23 G A . PASS . GT 1|1 1|0 +chr0 377337 24 T G . PASS . GT 1|1 1|0 +chr0 380806 25 A C . PASS . GT 0|0 0|1 +chr0 381107 26 T C . PASS . GT 1|1 1|0 +chr0 381734 27 A T . PASS . GT 0|0 0|1 +chr0 383326 28 C T . PASS . GT 0|0 0|1 +chr0 383967 29 A C . PASS . GT 0|0 0|1 +chr0 384867 30 C T . PASS . GT 1|0 1|0 +chr0 385091 31 G C . PASS . GT 0|0 0|1 +chr0 385493 32 G C . PASS . GT 1|1 1|0 +chr0 388716 33 G C . PASS . GT 0|0 0|1 +chr0 403375 34 T G . PASS . GT 0|0 0|1 +chr0 403390 35 T C . PASS . GT 1|1 1|0 +chr0 406933 36 T G . PASS . GT 0|0 0|1 +chr0 408336 37 A G . PASS . GT 0|0 0|1 +chr0 433658 38 T A . PASS . GT 1|1 1|0 +chr0 435593 39 C T . PASS . GT 1|1 1|0 +chr0 451414 40 G C . PASS . GT 0|0 0|1 +chr0 463465 41 T C . PASS . GT 0|0 0|1 +chr0 469391 42 C A . PASS . GT 1|1 1|0 +chr0 522225 43 G A . PASS . GT 0|0 0|1 +chr0 536865 44 C G . PASS . GT 0|0 0|1 +chr0 538923 45 G A . PASS . GT 0|0 0|1 +chr0 574194 46 G C . PASS . GT 0|0 0|1 +chr0 614796 47 A C . PASS . GT 0|0 0|1 +chr0 625579 48 C A . PASS . GT 0|0 0|1 +chr0 632962 49 C A . PASS . GT 0|0 0|1 +chr0 668237 50 A C . PASS . GT 0|1 0|0 +chr0 678118 51 A G . PASS . GT 1|0 1|0 +chr0 686153 52 C A . PASS . GT 1|0 1|0 +chr0 692062 53 A C . PASS . GT 0|1 0|0 +chr0 694069 54 G A . PASS . GT 0|1 0|0 +chr0 695233 55 A T . PASS . GT 0|1 0|0 +chr0 713918 56 C G . PASS . GT 1|1 1|0 +chr0 728481 57 G C . PASS . GT 1|0 1|1 +chr0 774477 58 C G . PASS . GT 0|0 0|1 +chr0 775874 59 A G . PASS . GT 1|0 1|0 +chr0 789758 60 T C . PASS . GT 1|0 1|0 +chr0 795794 61 T C . PASS . GT 0|1 0|1 +chr0 798796 62 C G . PASS . GT 0|1 0|0 +chr0 800316 63 C G . PASS . GT 1|0 1|0 +chr0 816965 64 G T . PASS . GT 0|1 0|0 +chr0 844868 65 G C . PASS . GT 1|0 1|0 +chr0 849659 66 A C . PASS . GT 1|0 1|0 +chr0 871268 67 G C . PASS . GT 1|0 1|0 +chr0 894379 68 G T . PASS . GT 0|1 0|0 +chr0 896780 69 T A . PASS . GT 1|0 1|1 +chr0 906834 70 C A . PASS . GT 1|0 1|1 +chr0 908408 71 G C . PASS . GT 0|1 0|0 +chr0 920106 72 C A . PASS . GT 0|1 0|0 +chr0 940903 73 C T . PASS . GT 0|0 0|1 +chr0 942923 74 T C . PASS . GT 1|0 1|0 +chr0 958518 75 T G . PASS . GT 0|1 0|1 +chr0 958935 76 T G . PASS . GT 0|1 0|1 +chr0 964524 77 T C . PASS . GT 1|0 1|0 +chr1 10234 0 T A . PASS . GT 1|0 1|0 +chr1 11285 1 T G . PASS . GT 1|0 1|1 +chr1 13545 2 A T . PASS . GT 0|0 0|1 +chr1 61928 3 T A . PASS . GT 0|0 0|1 +chr1 152898 4 A T . PASS . GT 1|1 1|0 +chr1 153962 5 T A . PASS . GT 1|1 1|0 +chr1 163734 6 G C . PASS . GT 1|0 1|0 +chr1 164620 7 C T . PASS . GT 1|0 1|0 +chr1 167695 8 A T . PASS . GT 1|0 1|0 +chr1 181792 9 T G . PASS . GT 1|0 1|0 +chr1 189630 10 C A . PASS . GT 0|0 0|1 +chr1 197772 11 C T . PASS . GT 1|1 1|0 +chr1 214169 12 A G . PASS . GT 1|1 1|0 +chr1 254401 13 A C . PASS . GT 1|0 1|0 +chr1 258878 14 G A . PASS . GT 1|0 1|0 +chr1 274055 15 T A . PASS . GT 0|1 0|0 +chr1 287109 16 T A . PASS . GT 1|0 1|0 +chr1 288266 17 A T . PASS . GT 1|0 1|0 +chr1 296651 18 A T . PASS . GT 0|0 0|1 +chr1 312545 19 C T . PASS . GT 0|1 0|0 +chr1 318202 20 G T . PASS . GT 0|1 0|0 +chr1 324372 21 T C . PASS . GT 0|0 0|1 +chr1 324464 22 C A . PASS . GT 1|0 1|0 +chr1 362275 23 G T . PASS . GT 0|0 0|1 +chr1 364334 24 G C . PASS . GT 1|0 1|0 +chr1 376441 25 C A . PASS . GT 0|0 0|1 +chr1 379313 26 T A . PASS . GT 1|1 1|0 +chr1 395848 27 T A . PASS . GT 1|0 1|0 +chr1 397953 28 T A . PASS . GT 0|0 0|1 +chr1 400616 29 C A . PASS . GT 1|1 1|0 +chr1 406995 30 T C . PASS . GT 0|0 0|1 +chr1 418124 31 C T . PASS . GT 0|0 0|1 +chr1 428370 32 G A . PASS . GT 1|1 1|0 +chr1 431749 33 A G . PASS . GT 1|1 1|0 +chr1 445963 34 C A . PASS . GT 1|1 1|0 +chr1 465548 35 A G . PASS . GT 0|0 0|1 +chr1 486833 36 T C . PASS . GT 1|1 1|0 +chr1 512685 37 G T . PASS . GT 1|0 1|1 +chr1 574865 38 G C . PASS . GT 1|0 1|0 +chr1 590950 39 T C . PASS . GT 1|0 1|0 +chr1 594406 40 G T . PASS . GT 1|0 1|0 +chr1 604150 41 G T . PASS . GT 0|0 0|1 +chr1 607248 42 G C . PASS . GT 1|0 1|0 +chr1 620227 43 G A . PASS . GT 1|0 1|0 +chr1 627012 44 C T . PASS . GT 0|1 0|0 +chr1 634291 45 G C . PASS . GT 0|1 0|0 +chr1 688285 46 T C . PASS . GT 1|0 1|0 +chr1 693735 47 T G . PASS . GT 1|0 1|0 +chr1 697303 48 C G . PASS . GT 0|1 0|1 +chr1 716528 49 T A . PASS . GT 0|1 0|1 +chr1 723935 50 A C . PASS . GT 1|0 1|0 +chr1 728617 51 T A . PASS . GT 1|0 1|0 +chr1 739690 52 G A . PASS . GT 0|1 0|1 +chr1 743730 53 C A . PASS . GT 0|1 0|1 +chr1 759096 54 C A . PASS . GT 0|1 0|1 +chr1 759625 55 G T . PASS . GT 0|1 0|1 +chr1 761333 56 G T . PASS . GT 1|0 1|0 +chr1 781210 57 C T . PASS . GT 0|1 0|1 +chr1 781670 58 A T . PASS . GT 1|0 1|0 +chr1 804019 59 A T . PASS . GT 0|1 0|1 +chr1 807209 60 C T . PASS . GT 1|0 1|0 +chr1 818133 61 A G . PASS . GT 1|0 1|0 +chr1 846475 62 C A . PASS . GT 0|1 0|1 +chr1 856290 63 T G . PASS . GT 1|0 1|0 +chr1 856799 64 A T . PASS . GT 1|0 1|0 +chr1 870411 65 C A . PASS . GT 1|0 1|0 +chr1 870890 66 A C . PASS . GT 1|0 1|0 +chr1 879882 67 C G . PASS . GT 1|0 1|0 +chr1 948022 68 C T . PASS . GT 1|0 1|0 +chr1 979659 69 G C . PASS . GT 0|1 0|1 +chr1 980048 70 T A . PASS . GT 0|1 0|1 +chr1 982703 71 G T . PASS . GT 0|0 0|1 +chr1 1059380 72 G T . PASS . GT 1|0 1|0 +chr1 1089920 73 C G . PASS . GT 1|0 1|0 +chr1 1121736 74 C T . PASS . GT 0|1 0|1 +chr1 1131816 75 G A . PASS . GT 0|1 0|1 +chr1 1142680 76 C G . PASS . GT 0|1 0|1 +chr1 1156441 77 T A . PASS . GT 0|1 0|1 +chr1 1161624 78 T G . PASS . GT 0|1 0|1 +chr1 1210608 79 A G . PASS . GT 1|0 1|0 +chr1 1217374 80 C T . PASS . GT 1|0 1|0 +chr1 1243918 81 A C . PASS . GT 1|0 1|0 +chr1 1254702 82 T A . PASS . GT 0|1 0|1 +chr1 1271453 83 C A . PASS . GT 1|0 1|0 +chr1 1283865 84 A T . PASS . GT 0|0 0|1 +chr1 1349672 85 G C . PASS . GT 0|0 0|1 +chr1 1351966 86 T G . PASS . GT 0|1 0|0 +chr1 1365491 87 A G . PASS . GT 0|1 0|0 +chr1 1369456 88 A G . PASS . GT 1|0 1|0 +chr1 1382891 89 C T . PASS . GT 0|0 0|1 +chr1 1392566 90 G C . PASS . GT 0|1 0|1 +chr1 1393971 91 C A . PASS . GT 1|0 1|0 +chr1 1396528 92 G T . PASS . GT 0|1 0|1 +chr1 1397524 93 C G . PASS . GT 0|0 0|1 +chr1 1404843 94 A G . PASS . GT 0|1 0|0 +chr1 1406072 95 G T . PASS . GT 0|1 0|0 +chr1 1411991 96 G T . PASS . GT 1|0 1|0 +chr1 1413100 97 T A . PASS . GT 1|1 1|0 +chr1 1413287 98 G C . PASS . GT 1|1 1|0 +chr1 1422112 99 G A . PASS . GT 0|1 0|0 +chr1 1429561 100 C G . PASS . GT 0|0 0|1 +chr1 1437441 101 A C . PASS . GT 1|1 1|0 +chr1 1438127 102 C T . PASS . GT 0|0 0|1 +chr1 1451387 103 C A . PASS . GT 1|0 1|0 +chr1 1479337 104 T G . PASS . GT 0|0 0|1 +chr1 1479811 105 A T . PASS . GT 0|0 0|1 +chr1 1512851 106 T A . PASS . GT 1|1 1|0 +chr1 1513103 107 A C . PASS . GT 0|0 0|1 +chr1 1520032 108 G A . PASS . GT 0|0 0|1 +chr1 1526815 109 A C . PASS . GT 1|1 1|0 +chr1 1533555 110 A T . PASS . GT 1|1 1|0 +chr1 1549443 111 C A . PASS . GT 0|0 0|1 +chr1 1592652 112 C T . PASS . GT 0|0 0|1 +chr1 1613438 113 C A . PASS . GT 0|1 0|0 +chr1 1616898 114 A G . PASS . GT 1|0 1|0 +chr1 1634162 115 C T . PASS . GT 0|0 0|1 +chr1 1649738 116 C G . PASS . GT 0|1 0|1 +chr1 1657580 117 A C . PASS . GT 1|0 1|0 +chr1 1659151 118 T C . PASS . GT 0|1 0|1 +chr1 1692907 119 A T . PASS . GT 0|1 0|0 +chr1 1694788 120 T G . PASS . GT 0|1 0|1 +chr1 1695002 121 T G . PASS . GT 1|0 1|0 +chr1 1724846 122 C A . PASS . GT 0|0 0|1 +chr1 1732057 123 T C . PASS . GT 0|0 0|1 +chr1 1734398 124 A C . PASS . GT 0|0 0|1 +chr1 1764244 125 C A . PASS . GT 1|0 1|1 +chr1 1773243 126 C A . PASS . GT 0|0 0|1 +chr1 1779431 127 G C . PASS . GT 0|1 0|1 +chr1 1785716 128 T G . PASS . GT 1|0 1|1 +chr1 1820040 129 G A . PASS . GT 0|1 0|1 +chr1 1826142 130 A G . PASS . GT 0|1 0|0 +chr1 1833537 131 A C . PASS . GT 1|0 1|0 +chr1 1853033 132 T A . PASS . GT 1|0 1|1 +chr1 1858253 133 A G . PASS . GT 1|0 1|0 +chr1 1872155 134 T A . PASS . GT 1|0 1|0 +chr1 1879146 135 T C . PASS . GT 0|0 0|1 +chr1 1882622 136 G A . PASS . GT 1|0 0|0 +chr1 1884380 137 G C . PASS . GT 0|1 1|1 +chr1 1895311 138 T C . PASS . GT 1|1 0|1 +chr1 1895689 139 G C . PASS . GT 0|0 1|0 +chr1 1896298 140 A G . PASS . GT 0|1 0|1 +chr1 1899683 141 C A . PASS . GT 1|0 0|0 +chr1 1899985 142 C G . PASS . GT 0|0 0|1 +chr1 1937627 143 G C . PASS . GT 0|1 0|0 +chr1 1938359 144 A C . PASS . GT 0|0 1|0 +chr1 1939201 145 T C . PASS . GT 1|0 1|1 +chr1 1939945 146 T G . PASS . GT 0|1 0|0 +chr1 1942742 147 G C . PASS . GT 1|0 1|0 +chr1 1957814 148 A C . PASS . GT 1|0 1|0 +chr1 1958285 149 G C . PASS . GT 1|0 1|0 +chr1 1964630 150 T G . PASS . GT 0|0 1|0 +chr1 1976702 151 T G . PASS . GT 1|0 0|0 +chr1 1980455 152 A T . PASS . GT 0|0 0|1 +chr1 1994922 153 G C . PASS . GT 0|1 0|0 +chr1 1998099 154 A G . PASS . GT 1|0 1|0 diff --git a/dev/testData/msprime_combined_missing.vcf b/dev/testData/msprime_combined_missing.vcf new file mode 100644 index 00000000..0641e37d --- /dev/null +++ b/dev/testData/msprime_combined_missing.vcf @@ -0,0 +1,242 @@ +##fileformat=VCFv4.2 +##FILTER= +##source=tskit 0.6.4 +##contig= +##FORMAT= +##contig= +##bcftools_concatVersion=1.24-8-gf098ab5a+htslib-1.24-40-g70dc8705 +##bcftools_concatCommand=concat -O v -o msprime_combined.vcf msprime_chr0.vcf msprime_chr1.vcf; Date=Tue Aug 18 11:52:07 2026 +#CHROM POS ID REF ALT QUAL FILTER INFO FORMAT tsk_0 tsk_1 +chr0 4649 0 C G . PASS . GT 1|0 1|0 +chr0 5258 1 A T . PASS . GT 0|1 0|0 +chr0 44375 2 C A . PASS . GT 0|1 0|0 +chr0 59104 3 C G . PASS . GT 0|0 0|1 +chr0 73422 4 A T . PASS . GT .|0 1|0 +chr0 80055 5 T G . PASS . GT 1|0 1|0 +chr0 82448 6 T A . PASS . GT 0|0 0|1 +chr0 107520 7 C A . PASS . GT 0|0 0|1 +chr0 111024 8 T G . PASS . GT 0|0 0|1 +chr0 139631 9 A C . PASS . GT 1|0 1|1 +chr0 141107 10 G T . PASS . GT 1|0 1|1 +chr0 174813 11 G A . PASS . GT 1|0 1|0 +chr0 182567 12 C G . PASS . GT .|1 0|0 +chr0 214455 13 T C . PASS . GT 0|0 0|1 +chr0 255979 14 A C . PASS . GT 0|1 0|0 +chr0 262535 15 A G . PASS . GT 1|0 1|0 +chr0 291289 16 A G . PASS . GT .|0 1|1 +chr0 317414 17 C A . PASS . GT 0|1 0|1 +chr0 326042 18 A T . PASS . GT 1|1 1|0 +chr0 336255 19 G C . PASS . GT 0|. 0|1 +chr0 354685 20 G A . PASS . GT 0|1 0|0 +chr0 364018 21 A C . PASS . GT 0|0 0|1 +chr0 376059 22 T G . PASS . GT 0|0 0|1 +chr0 376421 23 G A . PASS . GT 1|1 1|0 +chr0 377337 24 T G . PASS . GT 1|1 1|0 +chr0 380806 25 A C . PASS . GT 0|0 0|1 +chr0 381107 26 T C . PASS . GT 1|1 1|0 +chr0 381734 27 A T . PASS . GT 0|0 0|1 +chr0 383326 28 C T . PASS . GT 0|0 0|1 +chr0 383967 29 A C . PASS . GT 0|0 0|1 +chr0 384867 30 C T . PASS . GT 1|0 1|0 +chr0 385091 31 G C . PASS . GT 0|. 0|1 +chr0 385493 32 G C . PASS . GT 1|1 1|0 +chr0 388716 33 G C . PASS . GT 0|. 0|1 +chr0 403375 34 T G . PASS . GT .|0 0|1 +chr0 403390 35 T C . PASS . GT 1|1 1|0 +chr0 406933 36 T G . PASS . GT 0|0 0|1 +chr0 408336 37 A G . PASS . GT 0|0 0|1 +chr0 433658 38 T A . PASS . GT 1|1 1|0 +chr0 435593 39 C T . PASS . GT 1|1 1|0 +chr0 451414 40 G C . PASS . GT 0|0 0|1 +chr0 463465 41 T C . PASS . GT 0|0 0|1 +chr0 469391 42 C A . PASS . GT 1|1 1|0 +chr0 522225 43 G A . PASS . GT 0|0 0|1 +chr0 536865 44 C G . PASS . GT 0|0 0|1 +chr0 538923 45 G A . PASS . GT 0|0 0|1 +chr0 574194 46 G C . PASS . GT 0|0 0|1 +chr0 614796 47 A C . PASS . GT 0|0 0|1 +chr0 625579 48 C A . PASS . GT 0|0 0|1 +chr0 632962 49 C A . PASS . GT 0|0 0|1 +chr0 668237 50 A C . PASS . GT 0|1 0|0 +chr0 678118 51 A G . PASS . GT 1|0 1|0 +chr0 686153 52 C A . PASS . GT 1|0 1|0 +chr0 692062 53 A C . PASS . GT 0|1 0|0 +chr0 694069 54 G A . PASS . GT 0|1 0|0 +chr0 695233 55 A T . PASS . GT 0|1 0|0 +chr0 713918 56 C G . PASS . GT 1|1 1|0 +chr0 728481 57 G C . PASS . GT 1|0 1|1 +chr0 774477 58 C G . PASS . GT .|0 .|1 +chr0 775874 59 A G . PASS . GT 1|0 1|0 +chr0 789758 60 T C . PASS . GT 1|0 1|0 +chr0 795794 61 T C . PASS . GT 0|. 0|1 +chr0 798796 62 C G . PASS . GT 0|1 0|0 +chr0 800316 63 C G . PASS . GT 1|0 1|0 +chr0 816965 64 G T . PASS . GT 0|1 0|0 +chr0 844868 65 G C . PASS . GT 1|0 1|0 +chr0 849659 66 A C . PASS . GT 1|0 1|0 +chr0 871268 67 G C . PASS . GT 1|0 1|. +chr0 894379 68 G T . PASS . GT 0|1 0|0 +chr0 896780 69 T A . PASS . GT 1|0 1|1 +chr0 906834 70 C A . PASS . GT 1|0 1|1 +chr0 908408 71 G C . PASS . GT 0|1 0|0 +chr0 920106 72 C A . PASS . GT 0|1 0|. +chr0 940903 73 C T . PASS . GT 0|0 0|1 +chr0 942923 74 T C . PASS . GT 1|0 1|0 +chr0 958518 75 T G . PASS . GT 0|1 0|1 +chr0 958935 76 T G . PASS . GT 0|1 0|1 +chr0 964524 77 T C . PASS . GT 1|0 1|0 +chr1 10234 0 T A . PASS . GT 1|0 1|0 +chr1 11285 1 T G . PASS . GT 1|0 1|1 +chr1 13545 2 A T . PASS . GT 0|0 0|1 +chr1 61928 3 T A . PASS . GT 0|0 .|1 +chr1 152898 4 A T . PASS . GT 1|1 1|0 +chr1 153962 5 T A . PASS . GT 1|. 1|0 +chr1 163734 6 G C . PASS . GT 1|0 1|0 +chr1 164620 7 C T . PASS . GT 1|0 1|. +chr1 167695 8 A T . PASS . GT 1|. 1|0 +chr1 181792 9 T G . PASS . GT .|0 1|. +chr1 189630 10 C A . PASS . GT 0|0 0|1 +chr1 197772 11 C T . PASS . GT 1|1 1|0 +chr1 214169 12 A G . PASS . GT 1|1 1|0 +chr1 254401 13 A C . PASS . GT 1|0 1|0 +chr1 258878 14 G A . PASS . GT 1|0 1|0 +chr1 274055 15 T A . PASS . GT 0|1 0|0 +chr1 287109 16 T A . PASS . GT 1|0 1|0 +chr1 288266 17 A T . PASS . GT 1|. 1|0 +chr1 296651 18 A T . PASS . GT 0|0 0|1 +chr1 312545 19 C T . PASS . GT 0|1 0|0 +chr1 318202 20 G T . PASS . GT 0|1 0|0 +chr1 324372 21 T C . PASS . GT 0|0 0|1 +chr1 324464 22 C A . PASS . GT 1|0 1|0 +chr1 362275 23 G T . PASS . GT 0|0 0|1 +chr1 364334 24 G C . PASS . GT 1|0 1|0 +chr1 376441 25 C A . PASS . GT 0|0 0|1 +chr1 379313 26 T A . PASS . GT 1|1 1|0 +chr1 395848 27 T A . PASS . GT 1|0 1|0 +chr1 397953 28 T A . PASS . GT 0|0 0|1 +chr1 400616 29 C A . PASS . GT 1|1 1|0 +chr1 406995 30 T C . PASS . GT 0|0 0|1 +chr1 418124 31 C T . PASS . GT 0|0 0|1 +chr1 428370 32 G A . PASS . GT 1|. 1|0 +chr1 431749 33 A G . PASS . GT 1|1 .|0 +chr1 445963 34 C A . PASS . GT .|1 1|0 +chr1 465548 35 A G . PASS . GT 0|0 0|1 +chr1 486833 36 T C . PASS . GT 1|1 1|0 +chr1 512685 37 G T . PASS . GT 1|0 1|1 +chr1 574865 38 G C . PASS . GT 1|0 1|0 +chr1 590950 39 T C . PASS . GT 1|0 1|0 +chr1 594406 40 G T . PASS . GT 1|0 1|. +chr1 604150 41 G T . PASS . GT 0|0 0|1 +chr1 607248 42 G C . PASS . GT 1|0 1|0 +chr1 620227 43 G A . PASS . GT 1|0 1|0 +chr1 627012 44 C T . PASS . GT 0|1 0|0 +chr1 634291 45 G C . PASS . GT 0|1 0|0 +chr1 688285 46 T C . PASS . GT 1|0 1|0 +chr1 693735 47 T G . PASS . GT 1|0 1|0 +chr1 697303 48 C G . PASS . GT 0|. 0|1 +chr1 716528 49 T A . PASS . GT 0|1 0|1 +chr1 723935 50 A C . PASS . GT 1|0 1|0 +chr1 728617 51 T A . PASS . GT 1|0 1|0 +chr1 739690 52 G A . PASS . GT .|1 0|1 +chr1 743730 53 C A . PASS . GT 0|1 0|1 +chr1 759096 54 C A . PASS . GT 0|1 0|1 +chr1 759625 55 G T . PASS . GT 0|1 0|1 +chr1 761333 56 G T . PASS . GT 1|0 1|0 +chr1 781210 57 C T . PASS . GT 0|1 0|1 +chr1 781670 58 A T . PASS . GT 1|0 1|0 +chr1 804019 59 A T . PASS . GT 0|1 0|1 +chr1 807209 60 C T . PASS . GT 1|0 1|0 +chr1 818133 61 A G . PASS . GT 1|0 1|0 +chr1 846475 62 C A . PASS . GT 0|1 0|1 +chr1 856290 63 T G . PASS . GT 1|0 1|0 +chr1 856799 64 A T . PASS . GT 1|0 1|0 +chr1 870411 65 C A . PASS . GT 1|0 1|0 +chr1 870890 66 A C . PASS . GT 1|0 1|0 +chr1 879882 67 C G . PASS . GT 1|0 1|0 +chr1 948022 68 C T . PASS . GT 1|0 1|0 +chr1 979659 69 G C . PASS . GT 0|1 0|1 +chr1 980048 70 T A . PASS . GT 0|1 0|1 +chr1 982703 71 G T . PASS . GT 0|0 0|1 +chr1 1059380 72 G T . PASS . GT 1|0 .|0 +chr1 1089920 73 C G . PASS . GT 1|0 1|0 +chr1 1121736 74 C T . PASS . GT 0|1 0|1 +chr1 1131816 75 G A . PASS . GT 0|1 0|1 +chr1 1142680 76 C G . PASS . GT 0|1 0|1 +chr1 1156441 77 T A . PASS . GT 0|1 0|1 +chr1 1161624 78 T G . PASS . GT 0|1 0|1 +chr1 1210608 79 A G . PASS . GT 1|0 1|0 +chr1 1217374 80 C T . PASS . GT 1|0 1|0 +chr1 1243918 81 A C . PASS . GT 1|0 1|0 +chr1 1254702 82 T A . PASS . GT 0|1 0|1 +chr1 1271453 83 C A . PASS . GT 1|0 1|. +chr1 1283865 84 A T . PASS . GT 0|0 0|1 +chr1 1349672 85 G C . PASS . GT .|0 0|1 +chr1 1351966 86 T G . PASS . GT 0|1 0|. +chr1 1365491 87 A G . PASS . GT 0|1 0|0 +chr1 1369456 88 A G . PASS . GT 1|0 1|0 +chr1 1382891 89 C T . PASS . GT 0|0 0|. +chr1 1392566 90 G C . PASS . GT 0|1 0|1 +chr1 1393971 91 C A . PASS . GT 1|0 1|0 +chr1 1396528 92 G T . PASS . GT 0|1 0|1 +chr1 1397524 93 C G . PASS . GT 0|0 0|1 +chr1 1404843 94 A G . PASS . GT 0|1 0|0 +chr1 1406072 95 G T . PASS . GT 0|1 0|0 +chr1 1411991 96 G T . PASS . GT 1|0 1|0 +chr1 1413100 97 T A . PASS . GT .|1 1|0 +chr1 1413287 98 G C . PASS . GT 1|1 1|0 +chr1 1422112 99 G A . PASS . GT 0|1 0|0 +chr1 1429561 100 C G . PASS . GT 0|0 0|1 +chr1 1437441 101 A C . PASS . GT 1|1 1|. +chr1 1438127 102 C T . PASS . GT 0|0 0|1 +chr1 1451387 103 C A . PASS . GT .|0 1|0 +chr1 1479337 104 T G . PASS . GT 0|0 0|1 +chr1 1479811 105 A T . PASS . GT 0|0 0|1 +chr1 1512851 106 T A . PASS . GT 1|1 1|0 +chr1 1513103 107 A C . PASS . GT 0|0 0|1 +chr1 1520032 108 G A . PASS . GT 0|. 0|1 +chr1 1526815 109 A C . PASS . GT 1|1 1|0 +chr1 1533555 110 A T . PASS . GT 1|1 1|0 +chr1 1549443 111 C A . PASS . GT 0|. 0|1 +chr1 1592652 112 C T . PASS . GT 0|0 0|1 +chr1 1613438 113 C A . PASS . GT 0|1 0|0 +chr1 1616898 114 A G . PASS . GT 1|0 1|0 +chr1 1634162 115 C T . PASS . GT 0|0 0|1 +chr1 1649738 116 C G . PASS . GT 0|1 0|1 +chr1 1657580 117 A C . PASS . GT 1|0 1|0 +chr1 1659151 118 T C . PASS . GT 0|1 0|1 +chr1 1692907 119 A T . PASS . GT 0|1 0|0 +chr1 1694788 120 T G . PASS . GT 0|1 0|1 +chr1 1695002 121 T G . PASS . GT 1|0 1|0 +chr1 1724846 122 C A . PASS . GT 0|0 0|1 +chr1 1732057 123 T C . PASS . GT 0|0 0|1 +chr1 1734398 124 A C . PASS . GT 0|0 0|1 +chr1 1764244 125 C A . PASS . GT 1|0 1|1 +chr1 1773243 126 C A . PASS . GT .|0 0|1 +chr1 1779431 127 G C . PASS . GT .|1 0|. +chr1 1785716 128 T G . PASS . GT 1|0 1|1 +chr1 1820040 129 G A . PASS . GT 0|1 0|1 +chr1 1826142 130 A G . PASS . GT 0|1 .|0 +chr1 1833537 131 A C . PASS . GT 1|0 1|0 +chr1 1853033 132 T A . PASS . GT 1|0 1|1 +chr1 1858253 133 A G . PASS . GT .|0 1|0 +chr1 1872155 134 T A . PASS . GT 1|0 1|0 +chr1 1879146 135 T C . PASS . GT 0|0 0|1 +chr1 1882622 136 G A . PASS . GT 1|0 0|0 +chr1 1884380 137 G C . PASS . GT 0|1 1|1 +chr1 1895311 138 T C . PASS . GT 1|1 0|1 +chr1 1895689 139 G C . PASS . GT 0|0 1|0 +chr1 1896298 140 A G . PASS . GT 0|1 0|1 +chr1 1899683 141 C A . PASS . GT 1|. 0|0 +chr1 1899985 142 C G . PASS . GT 0|0 0|1 +chr1 1937627 143 G C . PASS . GT 0|1 0|0 +chr1 1938359 144 A C . PASS . GT 0|0 1|0 +chr1 1939201 145 T C . PASS . GT 1|0 1|1 +chr1 1939945 146 T G . PASS . GT 0|1 0|0 +chr1 1942742 147 G C . PASS . GT 1|0 1|0 +chr1 1957814 148 A C . PASS . GT 1|0 1|0 +chr1 1958285 149 G C . PASS . GT 1|0 1|0 +chr1 1964630 150 T G . PASS . GT 0|0 1|0 +chr1 1976702 151 T G . PASS . GT 1|0 0|0 +chr1 1980455 152 A T . PASS . GT 0|0 0|1 +chr1 1994922 153 G C . PASS . GT .|1 0|0 +chr1 1998099 154 A G . PASS . GT 1|0 1|0 diff --git a/dev/testData/out_msprime_from_macs/msprime_manifest.csv b/dev/testData/out_msprime_from_macs/msprime_manifest.csv new file mode 100644 index 00000000..33003661 --- /dev/null +++ b/dev/testData/out_msprime_from_macs/msprime_manifest.csv @@ -0,0 +1,201 @@ +scenario_id,scenario,rep,chr,args,nref,seed_chr,model,sequence_length,rec_rate_bp,mut_rate_bp,num_trees,num_nodes,num_edges,num_mutations,max_root_time,tree_path +1,single_const,1,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,801000,smc_prime,100000,2.5e-09,2.5e-08,15,29,56,183,51515.624918270456,testData/out_msprime_from_macs/single_const_rep01_chr01.trees +1,single_const,2,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,802000,smc_prime,100000,2.5e-09,2.5e-08,10,24,39,182,38763.80929698479,testData/out_msprime_from_macs/single_const_rep02_chr01.trees +1,single_const,3,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,803000,smc_prime,100000,2.5e-09,2.5e-08,27,41,87,336,109851.59102262642,testData/out_msprime_from_macs/single_const_rep03_chr01.trees +1,single_const,4,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,804000,smc_prime,100000,2.5e-09,2.5e-08,19,33,60,302,71899.5063036042,testData/out_msprime_from_macs/single_const_rep04_chr01.trees +1,single_const,5,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,805000,smc_prime,100000,2.5e-09,2.5e-08,16,30,59,173,52296.832527444945,testData/out_msprime_from_macs/single_const_rep05_chr01.trees +1,single_const,6,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,806000,smc_prime,100000,2.5e-09,2.5e-08,22,36,72,385,107743.52694763753,testData/out_msprime_from_macs/single_const_rep06_chr01.trees +1,single_const,7,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,807000,smc_prime,100000,2.5e-09,2.5e-08,16,30,64,168,30982.913633311287,testData/out_msprime_from_macs/single_const_rep07_chr01.trees +1,single_const,8,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,808000,smc_prime,100000,2.5e-09,2.5e-08,15,29,53,185,42181.611232091986,testData/out_msprime_from_macs/single_const_rep08_chr01.trees +1,single_const,9,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,809000,smc_prime,100000,2.5e-09,2.5e-08,20,34,65,184,59486.900392048585,testData/out_msprime_from_macs/single_const_rep09_chr01.trees +1,single_const,10,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,810000,smc_prime,100000,2.5e-09,2.5e-08,27,41,100,368,133055.80730249957,testData/out_msprime_from_macs/single_const_rep10_chr01.trees +1,single_const,11,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,811000,smc_prime,100000,2.5e-09,2.5e-08,31,45,114,262,48101.23294676906,testData/out_msprime_from_macs/single_const_rep11_chr01.trees +1,single_const,12,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,812000,smc_prime,100000,2.5e-09,2.5e-08,17,31,62,308,63690.27186884565,testData/out_msprime_from_macs/single_const_rep12_chr01.trees +1,single_const,13,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,813000,smc_prime,100000,2.5e-09,2.5e-08,21,35,74,199,49134.08270938573,testData/out_msprime_from_macs/single_const_rep13_chr01.trees +1,single_const,14,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,814000,smc_prime,100000,2.5e-09,2.5e-08,19,33,62,247,145182.40082078552,testData/out_msprime_from_macs/single_const_rep14_chr01.trees +1,single_const,15,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,815000,smc_prime,100000,2.5e-09,2.5e-08,24,38,91,244,62951.162590399596,testData/out_msprime_from_macs/single_const_rep15_chr01.trees +1,single_const,16,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,816000,smc_prime,100000,2.5e-09,2.5e-08,20,34,71,169,61498.16018360143,testData/out_msprime_from_macs/single_const_rep16_chr01.trees +1,single_const,17,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,817000,smc_prime,100000,2.5e-09,2.5e-08,22,36,74,266,111984.27213178847,testData/out_msprime_from_macs/single_const_rep17_chr01.trees +1,single_const,18,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,818000,smc_prime,100000,2.5e-09,2.5e-08,18,32,62,212,62641.42329757322,testData/out_msprime_from_macs/single_const_rep18_chr01.trees +1,single_const,19,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,819000,smc_prime,100000,2.5e-09,2.5e-08,20,34,69,275,80908.66388577598,testData/out_msprime_from_macs/single_const_rep19_chr01.trees +1,single_const,20,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,820000,smc_prime,100000,2.5e-09,2.5e-08,18,32,67,226,48753.6405100759,testData/out_msprime_from_macs/single_const_rep20_chr01.trees +1,single_const,21,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,821000,smc_prime,100000,2.5e-09,2.5e-08,23,37,85,351,62544.20329534801,testData/out_msprime_from_macs/single_const_rep21_chr01.trees +1,single_const,22,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,822000,smc_prime,100000,2.5e-09,2.5e-08,33,47,115,414,113011.0036309333,testData/out_msprime_from_macs/single_const_rep22_chr01.trees +1,single_const,23,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,823000,smc_prime,100000,2.5e-09,2.5e-08,28,42,110,276,63308.11472786501,testData/out_msprime_from_macs/single_const_rep23_chr01.trees +1,single_const,24,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,824000,smc_prime,100000,2.5e-09,2.5e-08,33,47,116,290,72418.28878141462,testData/out_msprime_from_macs/single_const_rep24_chr01.trees +1,single_const,25,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,825000,smc_prime,100000,2.5e-09,2.5e-08,23,37,82,221,56335.882104651864,testData/out_msprime_from_macs/single_const_rep25_chr01.trees +1,single_const,26,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,826000,smc_prime,100000,2.5e-09,2.5e-08,21,35,73,241,51653.59431584614,testData/out_msprime_from_macs/single_const_rep26_chr01.trees +1,single_const,27,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,827000,smc_prime,100000,2.5e-09,2.5e-08,29,43,106,281,102642.5271660279,testData/out_msprime_from_macs/single_const_rep27_chr01.trees +1,single_const,28,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,828000,smc_prime,100000,2.5e-09,2.5e-08,19,33,75,168,34588.383891724756,testData/out_msprime_from_macs/single_const_rep28_chr01.trees +1,single_const,29,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,829000,smc_prime,100000,2.5e-09,2.5e-08,17,31,62,204,62059.40939102222,testData/out_msprime_from_macs/single_const_rep29_chr01.trees +1,single_const,30,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,830000,smc_prime,100000,2.5e-09,2.5e-08,27,41,97,346,61260.760688875846,testData/out_msprime_from_macs/single_const_rep30_chr01.trees +1,single_const,31,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,831000,smc_prime,100000,2.5e-09,2.5e-08,28,42,91,291,120961.95623420269,testData/out_msprime_from_macs/single_const_rep31_chr01.trees +1,single_const,32,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,832000,smc_prime,100000,2.5e-09,2.5e-08,25,39,80,245,101173.91313550806,testData/out_msprime_from_macs/single_const_rep32_chr01.trees +1,single_const,33,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,833000,smc_prime,100000,2.5e-09,2.5e-08,30,44,103,304,63214.719234547876,testData/out_msprime_from_macs/single_const_rep33_chr01.trees +1,single_const,34,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,834000,smc_prime,100000,2.5e-09,2.5e-08,24,38,90,168,59006.04499853586,testData/out_msprime_from_macs/single_const_rep34_chr01.trees +1,single_const,35,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,835000,smc_prime,100000,2.5e-09,2.5e-08,49,63,164,344,98439.678484823,testData/out_msprime_from_macs/single_const_rep35_chr01.trees +1,single_const,36,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,836000,smc_prime,100000,2.5e-09,2.5e-08,14,28,49,172,50947.17699231931,testData/out_msprime_from_macs/single_const_rep36_chr01.trees +1,single_const,37,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,837000,smc_prime,100000,2.5e-09,2.5e-08,22,36,75,233,107320.9949119463,testData/out_msprime_from_macs/single_const_rep37_chr01.trees +1,single_const,38,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,838000,smc_prime,100000,2.5e-09,2.5e-08,20,34,71,289,79909.61109567845,testData/out_msprime_from_macs/single_const_rep38_chr01.trees +1,single_const,39,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,839000,smc_prime,100000,2.5e-09,2.5e-08,26,40,75,375,215760.75977841174,testData/out_msprime_from_macs/single_const_rep39_chr01.trees +1,single_const,40,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,840000,smc_prime,100000,2.5e-09,2.5e-08,17,31,66,319,69801.66186033799,testData/out_msprime_from_macs/single_const_rep40_chr01.trees +1,single_const,41,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,841000,smc_prime,100000,2.5e-09,2.5e-08,17,31,58,248,220971.26340291178,testData/out_msprime_from_macs/single_const_rep41_chr01.trees +1,single_const,42,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,842000,smc_prime,100000,2.5e-09,2.5e-08,11,25,34,80,109586.0356718846,testData/out_msprime_from_macs/single_const_rep42_chr01.trees +1,single_const,43,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,843000,smc_prime,100000,2.5e-09,2.5e-08,45,59,155,324,80630.78342095218,testData/out_msprime_from_macs/single_const_rep43_chr01.trees +1,single_const,44,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,844000,smc_prime,100000,2.5e-09,2.5e-08,27,41,104,263,54966.31877490516,testData/out_msprime_from_macs/single_const_rep44_chr01.trees +1,single_const,45,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,845000,smc_prime,100000,2.5e-09,2.5e-08,24,38,86,301,110946.77752676011,testData/out_msprime_from_macs/single_const_rep45_chr01.trees +1,single_const,46,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,846000,smc_prime,100000,2.5e-09,2.5e-08,17,31,58,197,67986.62845344585,testData/out_msprime_from_macs/single_const_rep46_chr01.trees +1,single_const,47,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,847000,smc_prime,100000,2.5e-09,2.5e-08,20,34,68,116,36060.08235496283,testData/out_msprime_from_macs/single_const_rep47_chr01.trees +1,single_const,48,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,848000,smc_prime,100000,2.5e-09,2.5e-08,19,33,59,313,126691.67299354449,testData/out_msprime_from_macs/single_const_rep48_chr01.trees +1,single_const,49,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,849000,smc_prime,100000,2.5e-09,2.5e-08,16,30,52,166,56095.740271687566,testData/out_msprime_from_macs/single_const_rep49_chr01.trees +1,single_const,50,1,8 100000 -t 1e-3 -r 1e-4 -s ,10000.0,850000,smc_prime,100000,2.5e-09,2.5e-08,25,39,82,312,88200.64578802258,testData/out_msprime_from_macs/single_const_rep50_chr01.trees +2,single_eN,1,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,901000,smc_prime,100000,2.5e-09,2.5e-08,28,42,92,278,65349.221239219914,testData/out_msprime_from_macs/single_eN_rep01_chr01.trees +2,single_eN,2,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,902000,smc_prime,100000,2.5e-09,2.5e-08,14,28,47,291,60601.858488352605,testData/out_msprime_from_macs/single_eN_rep02_chr01.trees +2,single_eN,3,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,903000,smc_prime,100000,2.5e-09,2.5e-08,34,48,123,415,57700.03535382562,testData/out_msprime_from_macs/single_eN_rep03_chr01.trees +2,single_eN,4,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,904000,smc_prime,100000,2.5e-09,2.5e-08,32,46,110,440,76756.02982500306,testData/out_msprime_from_macs/single_eN_rep04_chr01.trees +2,single_eN,5,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,905000,smc_prime,100000,2.5e-09,2.5e-08,30,44,91,315,70233.68216998836,testData/out_msprime_from_macs/single_eN_rep05_chr01.trees +2,single_eN,6,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,906000,smc_prime,100000,2.5e-09,2.5e-08,26,40,84,300,77770.58646889063,testData/out_msprime_from_macs/single_eN_rep06_chr01.trees +2,single_eN,7,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,907000,smc_prime,100000,2.5e-09,2.5e-08,25,39,88,352,60711.685354389985,testData/out_msprime_from_macs/single_eN_rep07_chr01.trees +2,single_eN,8,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,908000,smc_prime,100000,2.5e-09,2.5e-08,20,34,70,287,60906.76361323841,testData/out_msprime_from_macs/single_eN_rep08_chr01.trees +2,single_eN,9,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,909000,smc_prime,100000,2.5e-09,2.5e-08,40,54,133,414,79944.65892375396,testData/out_msprime_from_macs/single_eN_rep09_chr01.trees +2,single_eN,10,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,910000,smc_prime,100000,2.5e-09,2.5e-08,31,45,106,394,70883.21756212738,testData/out_msprime_from_macs/single_eN_rep10_chr01.trees +2,single_eN,11,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,911000,smc_prime,100000,2.5e-09,2.5e-08,33,47,123,461,73185.65542500555,testData/out_msprime_from_macs/single_eN_rep11_chr01.trees +2,single_eN,12,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,912000,smc_prime,100000,2.5e-09,2.5e-08,25,39,84,301,54214.5164817196,testData/out_msprime_from_macs/single_eN_rep12_chr01.trees +2,single_eN,13,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,913000,smc_prime,100000,2.5e-09,2.5e-08,22,36,75,273,69316.99951743032,testData/out_msprime_from_macs/single_eN_rep13_chr01.trees +2,single_eN,14,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,914000,smc_prime,100000,2.5e-09,2.5e-08,36,50,129,371,73958.80454455342,testData/out_msprime_from_macs/single_eN_rep14_chr01.trees +2,single_eN,15,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,915000,smc_prime,100000,2.5e-09,2.5e-08,25,39,78,288,72251.77689228117,testData/out_msprime_from_macs/single_eN_rep15_chr01.trees +2,single_eN,16,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,916000,smc_prime,100000,2.5e-09,2.5e-08,21,35,69,298,53200.65206122284,testData/out_msprime_from_macs/single_eN_rep16_chr01.trees +2,single_eN,17,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,917000,smc_prime,100000,2.5e-09,2.5e-08,19,33,69,216,44701.715341613424,testData/out_msprime_from_macs/single_eN_rep17_chr01.trees +2,single_eN,18,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,918000,smc_prime,100000,2.5e-09,2.5e-08,30,44,97,303,58467.65305087444,testData/out_msprime_from_macs/single_eN_rep18_chr01.trees +2,single_eN,19,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,919000,smc_prime,100000,2.5e-09,2.5e-08,18,32,53,217,67179.14113887127,testData/out_msprime_from_macs/single_eN_rep19_chr01.trees +2,single_eN,20,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,920000,smc_prime,100000,2.5e-09,2.5e-08,26,40,92,428,67345.61920307747,testData/out_msprime_from_macs/single_eN_rep20_chr01.trees +2,single_eN,21,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,921000,smc_prime,100000,2.5e-09,2.5e-08,22,36,72,255,98197.94041900555,testData/out_msprime_from_macs/single_eN_rep21_chr01.trees +2,single_eN,22,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,922000,smc_prime,100000,2.5e-09,2.5e-08,34,48,120,322,73182.20215592455,testData/out_msprime_from_macs/single_eN_rep22_chr01.trees +2,single_eN,23,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,923000,smc_prime,100000,2.5e-09,2.5e-08,21,35,78,334,55335.493334815896,testData/out_msprime_from_macs/single_eN_rep23_chr01.trees +2,single_eN,24,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,924000,smc_prime,100000,2.5e-09,2.5e-08,26,40,93,360,83432.89937189074,testData/out_msprime_from_macs/single_eN_rep24_chr01.trees +2,single_eN,25,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,925000,smc_prime,100000,2.5e-09,2.5e-08,40,54,130,385,106811.08207251274,testData/out_msprime_from_macs/single_eN_rep25_chr01.trees +2,single_eN,26,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,926000,smc_prime,100000,2.5e-09,2.5e-08,18,32,62,293,72244.85713844906,testData/out_msprime_from_macs/single_eN_rep26_chr01.trees +2,single_eN,27,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,927000,smc_prime,100000,2.5e-09,2.5e-08,25,39,89,313,61504.11927676364,testData/out_msprime_from_macs/single_eN_rep27_chr01.trees +2,single_eN,28,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,928000,smc_prime,100000,2.5e-09,2.5e-08,16,30,51,276,67348.08434313306,testData/out_msprime_from_macs/single_eN_rep28_chr01.trees +2,single_eN,29,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,929000,smc_prime,100000,2.5e-09,2.5e-08,27,41,94,329,68020.2817782327,testData/out_msprime_from_macs/single_eN_rep29_chr01.trees +2,single_eN,30,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,930000,smc_prime,100000,2.5e-09,2.5e-08,24,38,90,371,73755.84780580996,testData/out_msprime_from_macs/single_eN_rep30_chr01.trees +2,single_eN,31,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,931000,smc_prime,100000,2.5e-09,2.5e-08,32,46,113,359,112980.87085682394,testData/out_msprime_from_macs/single_eN_rep31_chr01.trees +2,single_eN,32,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,932000,smc_prime,100000,2.5e-09,2.5e-08,20,34,59,208,52219.14757403417,testData/out_msprime_from_macs/single_eN_rep32_chr01.trees +2,single_eN,33,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,933000,smc_prime,100000,2.5e-09,2.5e-08,37,51,127,365,63248.632349512416,testData/out_msprime_from_macs/single_eN_rep33_chr01.trees +2,single_eN,34,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,934000,smc_prime,100000,2.5e-09,2.5e-08,19,33,67,304,53891.48572153046,testData/out_msprime_from_macs/single_eN_rep34_chr01.trees +2,single_eN,35,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,935000,smc_prime,100000,2.5e-09,2.5e-08,15,29,60,210,50358.69328985923,testData/out_msprime_from_macs/single_eN_rep35_chr01.trees +2,single_eN,36,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,936000,smc_prime,100000,2.5e-09,2.5e-08,24,38,85,240,54082.961824516686,testData/out_msprime_from_macs/single_eN_rep36_chr01.trees +2,single_eN,37,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,937000,smc_prime,100000,2.5e-09,2.5e-08,30,44,113,459,62921.43534671086,testData/out_msprime_from_macs/single_eN_rep37_chr01.trees +2,single_eN,38,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,938000,smc_prime,100000,2.5e-09,2.5e-08,17,31,59,330,61021.66401499905,testData/out_msprime_from_macs/single_eN_rep38_chr01.trees +2,single_eN,39,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,939000,smc_prime,100000,2.5e-09,2.5e-08,31,45,110,457,77492.89793784614,testData/out_msprime_from_macs/single_eN_rep39_chr01.trees +2,single_eN,40,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,940000,smc_prime,100000,2.5e-09,2.5e-08,15,29,52,260,62864.54151974913,testData/out_msprime_from_macs/single_eN_rep40_chr01.trees +2,single_eN,41,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,941000,smc_prime,100000,2.5e-09,2.5e-08,37,51,123,435,100651.98483044902,testData/out_msprime_from_macs/single_eN_rep41_chr01.trees +2,single_eN,42,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,942000,smc_prime,100000,2.5e-09,2.5e-08,18,32,58,271,73950.93821976396,testData/out_msprime_from_macs/single_eN_rep42_chr01.trees +2,single_eN,43,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,943000,smc_prime,100000,2.5e-09,2.5e-08,27,41,82,275,93497.79468971904,testData/out_msprime_from_macs/single_eN_rep43_chr01.trees +2,single_eN,44,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,944000,smc_prime,100000,2.5e-09,2.5e-08,28,42,107,442,74339.58448917311,testData/out_msprime_from_macs/single_eN_rep44_chr01.trees +2,single_eN,45,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,945000,smc_prime,100000,2.5e-09,2.5e-08,33,47,110,387,101236.0734923974,testData/out_msprime_from_macs/single_eN_rep45_chr01.trees +2,single_eN,46,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,946000,smc_prime,100000,2.5e-09,2.5e-08,18,32,67,330,57038.03720408608,testData/out_msprime_from_macs/single_eN_rep46_chr01.trees +2,single_eN,47,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,947000,smc_prime,100000,2.5e-09,2.5e-08,26,40,89,356,72114.30160262527,testData/out_msprime_from_macs/single_eN_rep47_chr01.trees +2,single_eN,48,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,948000,smc_prime,100000,2.5e-09,2.5e-08,27,41,104,389,100002.2178829616,testData/out_msprime_from_macs/single_eN_rep48_chr01.trees +2,single_eN,49,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,949000,smc_prime,100000,2.5e-09,2.5e-08,17,31,55,244,65854.7399945304,testData/out_msprime_from_macs/single_eN_rep49_chr01.trees +2,single_eN,50,1,8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ,10000.0,950000,smc_prime,100000,2.5e-09,2.5e-08,24,38,85,343,65002.540328711504,testData/out_msprime_from_macs/single_eN_rep50_chr01.trees +3,I2_migration,1,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1001000,smc_prime,100000,2.5e-09,2.5e-08,38,52,137,546,97564.58412883535,testData/out_msprime_from_macs/I2_migration_rep01_chr01.trees +3,I2_migration,2,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1002000,smc_prime,100000,2.5e-09,2.5e-08,30,44,90,382,117642.80370111366,testData/out_msprime_from_macs/I2_migration_rep02_chr01.trees +3,I2_migration,3,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1003000,smc_prime,100000,2.5e-09,2.5e-08,45,59,160,567,84207.66407721497,testData/out_msprime_from_macs/I2_migration_rep03_chr01.trees +3,I2_migration,4,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1004000,smc_prime,100000,2.5e-09,2.5e-08,33,47,109,417,109918.36926777275,testData/out_msprime_from_macs/I2_migration_rep04_chr01.trees +3,I2_migration,5,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1005000,smc_prime,100000,2.5e-09,2.5e-08,45,59,155,489,114973.54073907119,testData/out_msprime_from_macs/I2_migration_rep05_chr01.trees +3,I2_migration,6,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1006000,smc_prime,100000,2.5e-09,2.5e-08,36,50,129,483,114188.44189606888,testData/out_msprime_from_macs/I2_migration_rep06_chr01.trees +3,I2_migration,7,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1007000,smc_prime,100000,2.5e-09,2.5e-08,48,62,166,608,93753.24179771724,testData/out_msprime_from_macs/I2_migration_rep07_chr01.trees +3,I2_migration,8,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1008000,smc_prime,100000,2.5e-09,2.5e-08,34,48,102,508,116856.75958831569,testData/out_msprime_from_macs/I2_migration_rep08_chr01.trees +3,I2_migration,9,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1009000,smc_prime,100000,2.5e-09,2.5e-08,29,43,103,463,62770.346245957306,testData/out_msprime_from_macs/I2_migration_rep09_chr01.trees +3,I2_migration,10,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1010000,smc_prime,100000,2.5e-09,2.5e-08,38,52,124,518,135423.86365044612,testData/out_msprime_from_macs/I2_migration_rep10_chr01.trees +3,I2_migration,11,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1011000,smc_prime,100000,2.5e-09,2.5e-08,37,51,115,453,118090.57466322677,testData/out_msprime_from_macs/I2_migration_rep11_chr01.trees +3,I2_migration,12,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1012000,smc_prime,100000,2.5e-09,2.5e-08,38,52,127,628,209534.1610295494,testData/out_msprime_from_macs/I2_migration_rep12_chr01.trees +3,I2_migration,13,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1013000,smc_prime,100000,2.5e-09,2.5e-08,43,57,149,536,89912.36330586261,testData/out_msprime_from_macs/I2_migration_rep13_chr01.trees +3,I2_migration,14,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1014000,smc_prime,100000,2.5e-09,2.5e-08,42,56,141,483,128912.51711145912,testData/out_msprime_from_macs/I2_migration_rep14_chr01.trees +3,I2_migration,15,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1015000,smc_prime,100000,2.5e-09,2.5e-08,45,59,152,618,158871.44365126808,testData/out_msprime_from_macs/I2_migration_rep15_chr01.trees +3,I2_migration,16,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1016000,smc_prime,100000,2.5e-09,2.5e-08,36,50,114,544,159695.05489009136,testData/out_msprime_from_macs/I2_migration_rep16_chr01.trees +3,I2_migration,17,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1017000,smc_prime,100000,2.5e-09,2.5e-08,38,52,120,463,99170.41393187974,testData/out_msprime_from_macs/I2_migration_rep17_chr01.trees +3,I2_migration,18,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1018000,smc_prime,100000,2.5e-09,2.5e-08,27,41,96,499,106487.65319013289,testData/out_msprime_from_macs/I2_migration_rep18_chr01.trees +3,I2_migration,19,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1019000,smc_prime,100000,2.5e-09,2.5e-08,37,52,130,561,101057.78304616034,testData/out_msprime_from_macs/I2_migration_rep19_chr01.trees +3,I2_migration,20,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1020000,smc_prime,100000,2.5e-09,2.5e-08,30,44,106,446,107384.27427104083,testData/out_msprime_from_macs/I2_migration_rep20_chr01.trees +3,I2_migration,21,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1021000,smc_prime,100000,2.5e-09,2.5e-08,30,44,104,448,96818.1513162082,testData/out_msprime_from_macs/I2_migration_rep21_chr01.trees +3,I2_migration,22,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1022000,smc_prime,100000,2.5e-09,2.5e-08,38,52,130,465,95245.67309246887,testData/out_msprime_from_macs/I2_migration_rep22_chr01.trees +3,I2_migration,23,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1023000,smc_prime,100000,2.5e-09,2.5e-08,27,41,95,519,80206.69234565251,testData/out_msprime_from_macs/I2_migration_rep23_chr01.trees +3,I2_migration,24,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1024000,smc_prime,100000,2.5e-09,2.5e-08,55,69,176,532,160077.76387616264,testData/out_msprime_from_macs/I2_migration_rep24_chr01.trees +3,I2_migration,25,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1025000,smc_prime,100000,2.5e-09,2.5e-08,28,42,83,385,144681.399583353,testData/out_msprime_from_macs/I2_migration_rep25_chr01.trees +3,I2_migration,26,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1026000,smc_prime,100000,2.5e-09,2.5e-08,41,55,128,495,117771.10101605413,testData/out_msprime_from_macs/I2_migration_rep26_chr01.trees +3,I2_migration,27,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1027000,smc_prime,100000,2.5e-09,2.5e-08,26,40,81,489,110262.67331368584,testData/out_msprime_from_macs/I2_migration_rep27_chr01.trees +3,I2_migration,28,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1028000,smc_prime,100000,2.5e-09,2.5e-08,33,47,124,493,120967.20685852526,testData/out_msprime_from_macs/I2_migration_rep28_chr01.trees +3,I2_migration,29,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1029000,smc_prime,100000,2.5e-09,2.5e-08,32,46,101,420,139142.03401837248,testData/out_msprime_from_macs/I2_migration_rep29_chr01.trees +3,I2_migration,30,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1030000,smc_prime,100000,2.5e-09,2.5e-08,54,68,167,607,164135.22989891114,testData/out_msprime_from_macs/I2_migration_rep30_chr01.trees +3,I2_migration,31,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1031000,smc_prime,100000,2.5e-09,2.5e-08,34,48,109,594,145106.40932381916,testData/out_msprime_from_macs/I2_migration_rep31_chr01.trees +3,I2_migration,32,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1032000,smc_prime,100000,2.5e-09,2.5e-08,38,52,135,505,75733.69112892961,testData/out_msprime_from_macs/I2_migration_rep32_chr01.trees +3,I2_migration,33,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1033000,smc_prime,100000,2.5e-09,2.5e-08,35,49,124,497,109977.00581672597,testData/out_msprime_from_macs/I2_migration_rep33_chr01.trees +3,I2_migration,34,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1034000,smc_prime,100000,2.5e-09,2.5e-08,49,63,159,650,121041.38130669676,testData/out_msprime_from_macs/I2_migration_rep34_chr01.trees +3,I2_migration,35,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1035000,smc_prime,100000,2.5e-09,2.5e-08,28,42,100,482,61154.63265076551,testData/out_msprime_from_macs/I2_migration_rep35_chr01.trees +3,I2_migration,36,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1036000,smc_prime,100000,2.5e-09,2.5e-08,53,67,172,572,128486.13469860726,testData/out_msprime_from_macs/I2_migration_rep36_chr01.trees +3,I2_migration,37,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1037000,smc_prime,100000,2.5e-09,2.5e-08,48,62,159,533,95052.05016785166,testData/out_msprime_from_macs/I2_migration_rep37_chr01.trees +3,I2_migration,38,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1038000,smc_prime,100000,2.5e-09,2.5e-08,40,54,126,555,129105.13464317753,testData/out_msprime_from_macs/I2_migration_rep38_chr01.trees +3,I2_migration,39,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1039000,smc_prime,100000,2.5e-09,2.5e-08,36,50,116,694,108180.6860369713,testData/out_msprime_from_macs/I2_migration_rep39_chr01.trees +3,I2_migration,40,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1040000,smc_prime,100000,2.5e-09,2.5e-08,29,43,95,481,130476.93001143142,testData/out_msprime_from_macs/I2_migration_rep40_chr01.trees +3,I2_migration,41,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1041000,smc_prime,100000,2.5e-09,2.5e-08,26,40,90,480,78868.02124460539,testData/out_msprime_from_macs/I2_migration_rep41_chr01.trees +3,I2_migration,42,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1042000,smc_prime,100000,2.5e-09,2.5e-08,39,53,124,556,119361.57872816,testData/out_msprime_from_macs/I2_migration_rep42_chr01.trees +3,I2_migration,43,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1043000,smc_prime,100000,2.5e-09,2.5e-08,46,60,150,628,155208.89518427377,testData/out_msprime_from_macs/I2_migration_rep43_chr01.trees +3,I2_migration,44,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1044000,smc_prime,100000,2.5e-09,2.5e-08,35,49,124,494,97188.69526910788,testData/out_msprime_from_macs/I2_migration_rep44_chr01.trees +3,I2_migration,45,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1045000,smc_prime,100000,2.5e-09,2.5e-08,32,46,117,469,67242.4266414875,testData/out_msprime_from_macs/I2_migration_rep45_chr01.trees +3,I2_migration,46,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1046000,smc_prime,100000,2.5e-09,2.5e-08,15,29,50,463,70366.02587526909,testData/out_msprime_from_macs/I2_migration_rep46_chr01.trees +3,I2_migration,47,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1047000,smc_prime,100000,2.5e-09,2.5e-08,37,51,116,472,81929.4748655115,testData/out_msprime_from_macs/I2_migration_rep47_chr01.trees +3,I2_migration,48,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1048000,smc_prime,100000,2.5e-09,2.5e-08,28,42,92,475,115961.5565377741,testData/out_msprime_from_macs/I2_migration_rep48_chr01.trees +3,I2_migration,49,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1049000,smc_prime,100000,2.5e-09,2.5e-08,30,44,100,420,125649.90496392331,testData/out_msprime_from_macs/I2_migration_rep49_chr01.trees +3,I2_migration,50,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ,10000.0,1050000,smc_prime,100000,2.5e-09,2.5e-08,41,55,140,577,101972.0338190745,testData/out_msprime_from_macs/I2_migration_rep50_chr01.trees +4,I2_en_join,1,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1101000,smc_prime,100000,2.5e-09,2.5e-08,37,51,128,520,88064.37475288789,testData/out_msprime_from_macs/I2_en_join_rep01_chr01.trees +4,I2_en_join,2,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1102000,smc_prime,100000,2.5e-09,2.5e-08,29,43,95,538,102022.72632240821,testData/out_msprime_from_macs/I2_en_join_rep02_chr01.trees +4,I2_en_join,3,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1103000,smc_prime,100000,2.5e-09,2.5e-08,30,44,103,508,118759.6618453868,testData/out_msprime_from_macs/I2_en_join_rep03_chr01.trees +4,I2_en_join,4,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1104000,smc_prime,100000,2.5e-09,2.5e-08,29,43,93,479,110921.88324171577,testData/out_msprime_from_macs/I2_en_join_rep04_chr01.trees +4,I2_en_join,5,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1105000,smc_prime,100000,2.5e-09,2.5e-08,18,32,60,380,107826.72923659543,testData/out_msprime_from_macs/I2_en_join_rep05_chr01.trees +4,I2_en_join,6,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1106000,smc_prime,100000,2.5e-09,2.5e-08,28,42,101,434,62612.626182878535,testData/out_msprime_from_macs/I2_en_join_rep06_chr01.trees +4,I2_en_join,7,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1107000,smc_prime,100000,2.5e-09,2.5e-08,28,42,93,429,91517.83086066617,testData/out_msprime_from_macs/I2_en_join_rep07_chr01.trees +4,I2_en_join,8,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1108000,smc_prime,100000,2.5e-09,2.5e-08,37,51,125,508,110710.74581906163,testData/out_msprime_from_macs/I2_en_join_rep08_chr01.trees +4,I2_en_join,9,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1109000,smc_prime,100000,2.5e-09,2.5e-08,30,44,101,439,92681.35855864939,testData/out_msprime_from_macs/I2_en_join_rep09_chr01.trees +4,I2_en_join,10,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1110000,smc_prime,100000,2.5e-09,2.5e-08,37,51,123,551,114305.29809637179,testData/out_msprime_from_macs/I2_en_join_rep10_chr01.trees +4,I2_en_join,11,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1111000,smc_prime,100000,2.5e-09,2.5e-08,42,56,146,599,132781.0284582705,testData/out_msprime_from_macs/I2_en_join_rep11_chr01.trees +4,I2_en_join,12,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1112000,smc_prime,100000,2.5e-09,2.5e-08,21,35,73,518,123530.34848851709,testData/out_msprime_from_macs/I2_en_join_rep12_chr01.trees +4,I2_en_join,13,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1113000,smc_prime,100000,2.5e-09,2.5e-08,28,42,91,409,95590.32795791008,testData/out_msprime_from_macs/I2_en_join_rep13_chr01.trees +4,I2_en_join,14,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1114000,smc_prime,100000,2.5e-09,2.5e-08,35,49,116,477,88920.540199851,testData/out_msprime_from_macs/I2_en_join_rep14_chr01.trees +4,I2_en_join,15,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1115000,smc_prime,100000,2.5e-09,2.5e-08,38,52,123,470,134691.8823494508,testData/out_msprime_from_macs/I2_en_join_rep15_chr01.trees +4,I2_en_join,16,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1116000,smc_prime,100000,2.5e-09,2.5e-08,27,41,93,482,81440.42239981552,testData/out_msprime_from_macs/I2_en_join_rep16_chr01.trees +4,I2_en_join,17,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1117000,smc_prime,100000,2.5e-09,2.5e-08,34,48,118,413,89006.92352507866,testData/out_msprime_from_macs/I2_en_join_rep17_chr01.trees +4,I2_en_join,18,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1118000,smc_prime,100000,2.5e-09,2.5e-08,47,61,152,530,109201.08759579713,testData/out_msprime_from_macs/I2_en_join_rep18_chr01.trees +4,I2_en_join,19,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1119000,smc_prime,100000,2.5e-09,2.5e-08,27,41,89,413,102939.78991988773,testData/out_msprime_from_macs/I2_en_join_rep19_chr01.trees +4,I2_en_join,20,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1120000,smc_prime,100000,2.5e-09,2.5e-08,38,52,125,546,135238.74755217478,testData/out_msprime_from_macs/I2_en_join_rep20_chr01.trees +4,I2_en_join,21,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1121000,smc_prime,100000,2.5e-09,2.5e-08,35,49,121,651,81607.07191886393,testData/out_msprime_from_macs/I2_en_join_rep21_chr01.trees +4,I2_en_join,22,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1122000,smc_prime,100000,2.5e-09,2.5e-08,36,50,105,522,151949.8203850263,testData/out_msprime_from_macs/I2_en_join_rep22_chr01.trees +4,I2_en_join,23,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1123000,smc_prime,100000,2.5e-09,2.5e-08,34,48,118,452,89961.69857797603,testData/out_msprime_from_macs/I2_en_join_rep23_chr01.trees +4,I2_en_join,24,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1124000,smc_prime,100000,2.5e-09,2.5e-08,35,49,114,491,97904.68440797148,testData/out_msprime_from_macs/I2_en_join_rep24_chr01.trees +4,I2_en_join,25,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1125000,smc_prime,100000,2.5e-09,2.5e-08,23,37,80,405,115452.8229915257,testData/out_msprime_from_macs/I2_en_join_rep25_chr01.trees +4,I2_en_join,26,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1126000,smc_prime,100000,2.5e-09,2.5e-08,39,53,126,511,114677.69989790722,testData/out_msprime_from_macs/I2_en_join_rep26_chr01.trees +4,I2_en_join,27,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1127000,smc_prime,100000,2.5e-09,2.5e-08,29,43,95,466,95506.38537926153,testData/out_msprime_from_macs/I2_en_join_rep27_chr01.trees +4,I2_en_join,28,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1128000,smc_prime,100000,2.5e-09,2.5e-08,44,58,155,580,83579.41444430909,testData/out_msprime_from_macs/I2_en_join_rep28_chr01.trees +4,I2_en_join,29,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1129000,smc_prime,100000,2.5e-09,2.5e-08,39,53,129,423,95313.99758613606,testData/out_msprime_from_macs/I2_en_join_rep29_chr01.trees +4,I2_en_join,30,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1130000,smc_prime,100000,2.5e-09,2.5e-08,37,51,133,435,57249.201972139046,testData/out_msprime_from_macs/I2_en_join_rep30_chr01.trees +4,I2_en_join,31,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1131000,smc_prime,100000,2.5e-09,2.5e-08,29,43,92,457,122457.13829746937,testData/out_msprime_from_macs/I2_en_join_rep31_chr01.trees +4,I2_en_join,32,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1132000,smc_prime,100000,2.5e-09,2.5e-08,35,49,125,453,94070.54039875766,testData/out_msprime_from_macs/I2_en_join_rep32_chr01.trees +4,I2_en_join,33,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1133000,smc_prime,100000,2.5e-09,2.5e-08,38,52,122,565,102975.86477934282,testData/out_msprime_from_macs/I2_en_join_rep33_chr01.trees +4,I2_en_join,34,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1134000,smc_prime,100000,2.5e-09,2.5e-08,24,38,86,441,105387.28917250219,testData/out_msprime_from_macs/I2_en_join_rep34_chr01.trees +4,I2_en_join,35,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1135000,smc_prime,100000,2.5e-09,2.5e-08,21,35,69,403,154081.72616774266,testData/out_msprime_from_macs/I2_en_join_rep35_chr01.trees +4,I2_en_join,36,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1136000,smc_prime,100000,2.5e-09,2.5e-08,30,44,101,481,85368.92444472763,testData/out_msprime_from_macs/I2_en_join_rep36_chr01.trees +4,I2_en_join,37,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1137000,smc_prime,100000,2.5e-09,2.5e-08,40,54,134,600,133494.6392175415,testData/out_msprime_from_macs/I2_en_join_rep37_chr01.trees +4,I2_en_join,38,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1138000,smc_prime,100000,2.5e-09,2.5e-08,25,39,88,438,95210.50516400867,testData/out_msprime_from_macs/I2_en_join_rep38_chr01.trees +4,I2_en_join,39,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1139000,smc_prime,100000,2.5e-09,2.5e-08,41,55,142,467,121279.25515798831,testData/out_msprime_from_macs/I2_en_join_rep39_chr01.trees +4,I2_en_join,40,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1140000,smc_prime,100000,2.5e-09,2.5e-08,40,54,130,444,142588.6776950081,testData/out_msprime_from_macs/I2_en_join_rep40_chr01.trees +4,I2_en_join,41,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1141000,smc_prime,100000,2.5e-09,2.5e-08,32,46,111,436,101501.03501702432,testData/out_msprime_from_macs/I2_en_join_rep41_chr01.trees +4,I2_en_join,42,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1142000,smc_prime,100000,2.5e-09,2.5e-08,38,52,126,580,137147.77205237906,testData/out_msprime_from_macs/I2_en_join_rep42_chr01.trees +4,I2_en_join,43,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1143000,smc_prime,100000,2.5e-09,2.5e-08,24,38,86,484,70167.56944579098,testData/out_msprime_from_macs/I2_en_join_rep43_chr01.trees +4,I2_en_join,44,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1144000,smc_prime,100000,2.5e-09,2.5e-08,37,51,124,473,127339.60094870909,testData/out_msprime_from_macs/I2_en_join_rep44_chr01.trees +4,I2_en_join,45,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1145000,smc_prime,100000,2.5e-09,2.5e-08,35,49,109,519,157011.9311568176,testData/out_msprime_from_macs/I2_en_join_rep45_chr01.trees +4,I2_en_join,46,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1146000,smc_prime,100000,2.5e-09,2.5e-08,25,39,84,459,110942.62839244043,testData/out_msprime_from_macs/I2_en_join_rep46_chr01.trees +4,I2_en_join,47,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1147000,smc_prime,100000,2.5e-09,2.5e-08,35,49,122,556,100145.88432616864,testData/out_msprime_from_macs/I2_en_join_rep47_chr01.trees +4,I2_en_join,48,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1148000,smc_prime,100000,2.5e-09,2.5e-08,21,35,64,309,85136.93693449725,testData/out_msprime_from_macs/I2_en_join_rep48_chr01.trees +4,I2_en_join,49,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1149000,smc_prime,100000,2.5e-09,2.5e-08,29,43,104,409,75896.71347412044,testData/out_msprime_from_macs/I2_en_join_rep49_chr01.trees +4,I2_en_join,50,1,8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ,10000.0,1150000,smc_prime,100000,2.5e-09,2.5e-08,35,49,112,504,112863.5251947745,testData/out_msprime_from_macs/I2_en_join_rep50_chr01.trees diff --git a/dev/testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_manifest.csv b/dev/testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_manifest.csv new file mode 100644 index 00000000..71e740c4 --- /dev/null +++ b/dev/testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_manifest.csv @@ -0,0 +1,201 @@ +"scenario_id","scenario","rep","chr","args","seed_chr","mut_seed_chr","dTheta","dTheta_post","usePhysicalPositions","Nref","macs_num_mutations","macsts_num_mutations","tree_path" +1,"single_const",1,1,"8 100000 -t 1e-3 -r 1e-4 -s ",801000,801000,100,0.0025,TRUE,10000,292,274,"testData/out_phase1_useMacsMut_FALSE/single_const_rep01_chr01.trees" +1,"single_const",2,1,"8 100000 -t 1e-3 -r 1e-4 -s ",802000,802000,100,0.0025,TRUE,10000,266,259,"testData/out_phase1_useMacsMut_FALSE/single_const_rep02_chr01.trees" +1,"single_const",3,1,"8 100000 -t 1e-3 -r 1e-4 -s ",803000,803000,100,0.0025,TRUE,10000,193,251,"testData/out_phase1_useMacsMut_FALSE/single_const_rep03_chr01.trees" +1,"single_const",4,1,"8 100000 -t 1e-3 -r 1e-4 -s ",804000,804000,100,0.0025,TRUE,10000,298,253,"testData/out_phase1_useMacsMut_FALSE/single_const_rep04_chr01.trees" +1,"single_const",5,1,"8 100000 -t 1e-3 -r 1e-4 -s ",805000,805000,100,0.0025,TRUE,10000,330,194,"testData/out_phase1_useMacsMut_FALSE/single_const_rep05_chr01.trees" +1,"single_const",6,1,"8 100000 -t 1e-3 -r 1e-4 -s ",806000,806000,100,0.0025,TRUE,10000,278,236,"testData/out_phase1_useMacsMut_FALSE/single_const_rep06_chr01.trees" +1,"single_const",7,1,"8 100000 -t 1e-3 -r 1e-4 -s ",807000,807000,100,0.0025,TRUE,10000,291,235,"testData/out_phase1_useMacsMut_FALSE/single_const_rep07_chr01.trees" +1,"single_const",8,1,"8 100000 -t 1e-3 -r 1e-4 -s ",808000,808000,100,0.0025,TRUE,10000,193,189,"testData/out_phase1_useMacsMut_FALSE/single_const_rep08_chr01.trees" +1,"single_const",9,1,"8 100000 -t 1e-3 -r 1e-4 -s ",809000,809000,100,0.0025,TRUE,10000,111,207,"testData/out_phase1_useMacsMut_FALSE/single_const_rep09_chr01.trees" +1,"single_const",10,1,"8 100000 -t 1e-3 -r 1e-4 -s ",810000,810000,100,0.0025,TRUE,10000,337,330,"testData/out_phase1_useMacsMut_FALSE/single_const_rep10_chr01.trees" +1,"single_const",11,1,"8 100000 -t 1e-3 -r 1e-4 -s ",811000,811000,100,0.0025,TRUE,10000,335,311,"testData/out_phase1_useMacsMut_FALSE/single_const_rep11_chr01.trees" +1,"single_const",12,1,"8 100000 -t 1e-3 -r 1e-4 -s ",812000,812000,100,0.0025,TRUE,10000,306,267,"testData/out_phase1_useMacsMut_FALSE/single_const_rep12_chr01.trees" +1,"single_const",13,1,"8 100000 -t 1e-3 -r 1e-4 -s ",813000,813000,100,0.0025,TRUE,10000,417,244,"testData/out_phase1_useMacsMut_FALSE/single_const_rep13_chr01.trees" +1,"single_const",14,1,"8 100000 -t 1e-3 -r 1e-4 -s ",814000,814000,100,0.0025,TRUE,10000,434,355,"testData/out_phase1_useMacsMut_FALSE/single_const_rep14_chr01.trees" +1,"single_const",15,1,"8 100000 -t 1e-3 -r 1e-4 -s ",815000,815000,100,0.0025,TRUE,10000,233,265,"testData/out_phase1_useMacsMut_FALSE/single_const_rep15_chr01.trees" +1,"single_const",16,1,"8 100000 -t 1e-3 -r 1e-4 -s ",816000,816000,100,0.0025,TRUE,10000,285,209,"testData/out_phase1_useMacsMut_FALSE/single_const_rep16_chr01.trees" +1,"single_const",17,1,"8 100000 -t 1e-3 -r 1e-4 -s ",817000,817000,100,0.0025,TRUE,10000,205,224,"testData/out_phase1_useMacsMut_FALSE/single_const_rep17_chr01.trees" +1,"single_const",18,1,"8 100000 -t 1e-3 -r 1e-4 -s ",818000,818000,100,0.0025,TRUE,10000,215,269,"testData/out_phase1_useMacsMut_FALSE/single_const_rep18_chr01.trees" +1,"single_const",19,1,"8 100000 -t 1e-3 -r 1e-4 -s ",819000,819000,100,0.0025,TRUE,10000,227,348,"testData/out_phase1_useMacsMut_FALSE/single_const_rep19_chr01.trees" +1,"single_const",20,1,"8 100000 -t 1e-3 -r 1e-4 -s ",820000,820000,100,0.0025,TRUE,10000,129,242,"testData/out_phase1_useMacsMut_FALSE/single_const_rep20_chr01.trees" +1,"single_const",21,1,"8 100000 -t 1e-3 -r 1e-4 -s ",821000,821000,100,0.0025,TRUE,10000,142,198,"testData/out_phase1_useMacsMut_FALSE/single_const_rep21_chr01.trees" +1,"single_const",22,1,"8 100000 -t 1e-3 -r 1e-4 -s ",822000,822000,100,0.0025,TRUE,10000,227,270,"testData/out_phase1_useMacsMut_FALSE/single_const_rep22_chr01.trees" +1,"single_const",23,1,"8 100000 -t 1e-3 -r 1e-4 -s ",823000,823000,100,0.0025,TRUE,10000,143,181,"testData/out_phase1_useMacsMut_FALSE/single_const_rep23_chr01.trees" +1,"single_const",24,1,"8 100000 -t 1e-3 -r 1e-4 -s ",824000,824000,100,0.0025,TRUE,10000,293,312,"testData/out_phase1_useMacsMut_FALSE/single_const_rep24_chr01.trees" +1,"single_const",25,1,"8 100000 -t 1e-3 -r 1e-4 -s ",825000,825000,100,0.0025,TRUE,10000,332,234,"testData/out_phase1_useMacsMut_FALSE/single_const_rep25_chr01.trees" +1,"single_const",26,1,"8 100000 -t 1e-3 -r 1e-4 -s ",826000,826000,100,0.0025,TRUE,10000,153,239,"testData/out_phase1_useMacsMut_FALSE/single_const_rep26_chr01.trees" +1,"single_const",27,1,"8 100000 -t 1e-3 -r 1e-4 -s ",827000,827000,100,0.0025,TRUE,10000,151,279,"testData/out_phase1_useMacsMut_FALSE/single_const_rep27_chr01.trees" +1,"single_const",28,1,"8 100000 -t 1e-3 -r 1e-4 -s ",828000,828000,100,0.0025,TRUE,10000,321,174,"testData/out_phase1_useMacsMut_FALSE/single_const_rep28_chr01.trees" +1,"single_const",29,1,"8 100000 -t 1e-3 -r 1e-4 -s ",829000,829000,100,0.0025,TRUE,10000,195,409,"testData/out_phase1_useMacsMut_FALSE/single_const_rep29_chr01.trees" +1,"single_const",30,1,"8 100000 -t 1e-3 -r 1e-4 -s ",830000,830000,100,0.0025,TRUE,10000,150,222,"testData/out_phase1_useMacsMut_FALSE/single_const_rep30_chr01.trees" +1,"single_const",31,1,"8 100000 -t 1e-3 -r 1e-4 -s ",831000,831000,100,0.0025,TRUE,10000,401,214,"testData/out_phase1_useMacsMut_FALSE/single_const_rep31_chr01.trees" +1,"single_const",32,1,"8 100000 -t 1e-3 -r 1e-4 -s ",832000,832000,100,0.0025,TRUE,10000,357,342,"testData/out_phase1_useMacsMut_FALSE/single_const_rep32_chr01.trees" +1,"single_const",33,1,"8 100000 -t 1e-3 -r 1e-4 -s ",833000,833000,100,0.0025,TRUE,10000,230,208,"testData/out_phase1_useMacsMut_FALSE/single_const_rep33_chr01.trees" +1,"single_const",34,1,"8 100000 -t 1e-3 -r 1e-4 -s ",834000,834000,100,0.0025,TRUE,10000,139,216,"testData/out_phase1_useMacsMut_FALSE/single_const_rep34_chr01.trees" +1,"single_const",35,1,"8 100000 -t 1e-3 -r 1e-4 -s ",835000,835000,100,0.0025,TRUE,10000,128,198,"testData/out_phase1_useMacsMut_FALSE/single_const_rep35_chr01.trees" +1,"single_const",36,1,"8 100000 -t 1e-3 -r 1e-4 -s ",836000,836000,100,0.0025,TRUE,10000,298,271,"testData/out_phase1_useMacsMut_FALSE/single_const_rep36_chr01.trees" +1,"single_const",37,1,"8 100000 -t 1e-3 -r 1e-4 -s ",837000,837000,100,0.0025,TRUE,10000,242,199,"testData/out_phase1_useMacsMut_FALSE/single_const_rep37_chr01.trees" +1,"single_const",38,1,"8 100000 -t 1e-3 -r 1e-4 -s ",838000,838000,100,0.0025,TRUE,10000,177,350,"testData/out_phase1_useMacsMut_FALSE/single_const_rep38_chr01.trees" +1,"single_const",39,1,"8 100000 -t 1e-3 -r 1e-4 -s ",839000,839000,100,0.0025,TRUE,10000,213,265,"testData/out_phase1_useMacsMut_FALSE/single_const_rep39_chr01.trees" +1,"single_const",40,1,"8 100000 -t 1e-3 -r 1e-4 -s ",840000,840000,100,0.0025,TRUE,10000,163,272,"testData/out_phase1_useMacsMut_FALSE/single_const_rep40_chr01.trees" +1,"single_const",41,1,"8 100000 -t 1e-3 -r 1e-4 -s ",841000,841000,100,0.0025,TRUE,10000,271,171,"testData/out_phase1_useMacsMut_FALSE/single_const_rep41_chr01.trees" +1,"single_const",42,1,"8 100000 -t 1e-3 -r 1e-4 -s ",842000,842000,100,0.0025,TRUE,10000,303,213,"testData/out_phase1_useMacsMut_FALSE/single_const_rep42_chr01.trees" +1,"single_const",43,1,"8 100000 -t 1e-3 -r 1e-4 -s ",843000,843000,100,0.0025,TRUE,10000,254,131,"testData/out_phase1_useMacsMut_FALSE/single_const_rep43_chr01.trees" +1,"single_const",44,1,"8 100000 -t 1e-3 -r 1e-4 -s ",844000,844000,100,0.0025,TRUE,10000,176,305,"testData/out_phase1_useMacsMut_FALSE/single_const_rep44_chr01.trees" +1,"single_const",45,1,"8 100000 -t 1e-3 -r 1e-4 -s ",845000,845000,100,0.0025,TRUE,10000,247,262,"testData/out_phase1_useMacsMut_FALSE/single_const_rep45_chr01.trees" +1,"single_const",46,1,"8 100000 -t 1e-3 -r 1e-4 -s ",846000,846000,100,0.0025,TRUE,10000,351,385,"testData/out_phase1_useMacsMut_FALSE/single_const_rep46_chr01.trees" +1,"single_const",47,1,"8 100000 -t 1e-3 -r 1e-4 -s ",847000,847000,100,0.0025,TRUE,10000,298,212,"testData/out_phase1_useMacsMut_FALSE/single_const_rep47_chr01.trees" +1,"single_const",48,1,"8 100000 -t 1e-3 -r 1e-4 -s ",848000,848000,100,0.0025,TRUE,10000,248,272,"testData/out_phase1_useMacsMut_FALSE/single_const_rep48_chr01.trees" +1,"single_const",49,1,"8 100000 -t 1e-3 -r 1e-4 -s ",849000,849000,100,0.0025,TRUE,10000,308,266,"testData/out_phase1_useMacsMut_FALSE/single_const_rep49_chr01.trees" +1,"single_const",50,1,"8 100000 -t 1e-3 -r 1e-4 -s ",850000,850000,100,0.0025,TRUE,10000,317,253,"testData/out_phase1_useMacsMut_FALSE/single_const_rep50_chr01.trees" +2,"single_eN",1,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",901000,901000,100,0.0025,TRUE,10000,160,203,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep01_chr01.trees" +2,"single_eN",2,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",902000,902000,100,0.0025,TRUE,10000,320,379,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep02_chr01.trees" +2,"single_eN",3,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",903000,903000,100,0.0025,TRUE,10000,414,329,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep03_chr01.trees" +2,"single_eN",4,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",904000,904000,100,0.0025,TRUE,10000,340,397,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep04_chr01.trees" +2,"single_eN",5,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",905000,905000,100,0.0025,TRUE,10000,314,208,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep05_chr01.trees" +2,"single_eN",6,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",906000,906000,100,0.0025,TRUE,10000,334,400,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep06_chr01.trees" +2,"single_eN",7,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",907000,907000,100,0.0025,TRUE,10000,182,337,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep07_chr01.trees" +2,"single_eN",8,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",908000,908000,100,0.0025,TRUE,10000,284,259,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep08_chr01.trees" +2,"single_eN",9,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",909000,909000,100,0.0025,TRUE,10000,300,340,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep09_chr01.trees" +2,"single_eN",10,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",910000,910000,100,0.0025,TRUE,10000,354,324,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep10_chr01.trees" +2,"single_eN",11,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",911000,911000,100,0.0025,TRUE,10000,324,264,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep11_chr01.trees" +2,"single_eN",12,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",912000,912000,100,0.0025,TRUE,10000,564,396,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep12_chr01.trees" +2,"single_eN",13,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",913000,913000,100,0.0025,TRUE,10000,193,266,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep13_chr01.trees" +2,"single_eN",14,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",914000,914000,100,0.0025,TRUE,10000,62,122,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep14_chr01.trees" +2,"single_eN",15,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",915000,915000,100,0.0025,TRUE,10000,372,277,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep15_chr01.trees" +2,"single_eN",16,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",916000,916000,100,0.0025,TRUE,10000,260,250,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep16_chr01.trees" +2,"single_eN",17,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",917000,917000,100,0.0025,TRUE,10000,283,286,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep17_chr01.trees" +2,"single_eN",18,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",918000,918000,100,0.0025,TRUE,10000,241,161,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep18_chr01.trees" +2,"single_eN",19,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",919000,919000,100,0.0025,TRUE,10000,309,383,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep19_chr01.trees" +2,"single_eN",20,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",920000,920000,100,0.0025,TRUE,10000,359,327,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep20_chr01.trees" +2,"single_eN",21,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",921000,921000,100,0.0025,TRUE,10000,292,274,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep21_chr01.trees" +2,"single_eN",22,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",922000,922000,100,0.0025,TRUE,10000,274,388,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep22_chr01.trees" +2,"single_eN",23,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",923000,923000,100,0.0025,TRUE,10000,99,168,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep23_chr01.trees" +2,"single_eN",24,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",924000,924000,100,0.0025,TRUE,10000,296,384,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep24_chr01.trees" +2,"single_eN",25,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",925000,925000,100,0.0025,TRUE,10000,390,431,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep25_chr01.trees" +2,"single_eN",26,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",926000,926000,100,0.0025,TRUE,10000,462,469,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep26_chr01.trees" +2,"single_eN",27,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",927000,927000,100,0.0025,TRUE,10000,219,394,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep27_chr01.trees" +2,"single_eN",28,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",928000,928000,100,0.0025,TRUE,10000,418,285,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep28_chr01.trees" +2,"single_eN",29,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",929000,929000,100,0.0025,TRUE,10000,281,251,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep29_chr01.trees" +2,"single_eN",30,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",930000,930000,100,0.0025,TRUE,10000,286,301,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep30_chr01.trees" +2,"single_eN",31,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",931000,931000,100,0.0025,TRUE,10000,280,237,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep31_chr01.trees" +2,"single_eN",32,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",932000,932000,100,0.0025,TRUE,10000,436,284,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep32_chr01.trees" +2,"single_eN",33,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",933000,933000,100,0.0025,TRUE,10000,379,379,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep33_chr01.trees" +2,"single_eN",34,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",934000,934000,100,0.0025,TRUE,10000,177,123,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep34_chr01.trees" +2,"single_eN",35,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",935000,935000,100,0.0025,TRUE,10000,266,220,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep35_chr01.trees" +2,"single_eN",36,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",936000,936000,100,0.0025,TRUE,10000,278,389,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep36_chr01.trees" +2,"single_eN",37,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",937000,937000,100,0.0025,TRUE,10000,304,313,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep37_chr01.trees" +2,"single_eN",38,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",938000,938000,100,0.0025,TRUE,10000,422,319,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep38_chr01.trees" +2,"single_eN",39,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",939000,939000,100,0.0025,TRUE,10000,425,285,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep39_chr01.trees" +2,"single_eN",40,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",940000,940000,100,0.0025,TRUE,10000,443,275,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep40_chr01.trees" +2,"single_eN",41,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",941000,941000,100,0.0025,TRUE,10000,362,448,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep41_chr01.trees" +2,"single_eN",42,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",942000,942000,100,0.0025,TRUE,10000,342,129,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep42_chr01.trees" +2,"single_eN",43,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",943000,943000,100,0.0025,TRUE,10000,319,329,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep43_chr01.trees" +2,"single_eN",44,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",944000,944000,100,0.0025,TRUE,10000,368,254,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep44_chr01.trees" +2,"single_eN",45,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",945000,945000,100,0.0025,TRUE,10000,355,418,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep45_chr01.trees" +2,"single_eN",46,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",946000,946000,100,0.0025,TRUE,10000,356,306,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep46_chr01.trees" +2,"single_eN",47,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",947000,947000,100,0.0025,TRUE,10000,357,375,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep47_chr01.trees" +2,"single_eN",48,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",948000,948000,100,0.0025,TRUE,10000,327,342,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep48_chr01.trees" +2,"single_eN",49,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",949000,949000,100,0.0025,TRUE,10000,438,361,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep49_chr01.trees" +2,"single_eN",50,1,"8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s ",950000,950000,100,0.0025,TRUE,10000,361,448,"testData/out_phase1_useMacsMut_FALSE/single_eN_rep50_chr01.trees" +3,"I2_migration",1,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1001000,1001000,100,0.0025,TRUE,10000,582,627,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep01_chr01.trees" +3,"I2_migration",2,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1002000,1002000,100,0.0025,TRUE,10000,539,505,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep02_chr01.trees" +3,"I2_migration",3,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1003000,1003000,100,0.0025,TRUE,10000,528,605,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep03_chr01.trees" +3,"I2_migration",4,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1004000,1004000,100,0.0025,TRUE,10000,491,536,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep04_chr01.trees" +3,"I2_migration",5,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1005000,1005000,100,0.0025,TRUE,10000,549,458,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep05_chr01.trees" +3,"I2_migration",6,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1006000,1006000,100,0.0025,TRUE,10000,627,467,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep06_chr01.trees" +3,"I2_migration",7,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1007000,1007000,100,0.0025,TRUE,10000,524,517,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep07_chr01.trees" +3,"I2_migration",8,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1008000,1008000,100,0.0025,TRUE,10000,498,643,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep08_chr01.trees" +3,"I2_migration",9,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1009000,1009000,100,0.0025,TRUE,10000,596,551,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep09_chr01.trees" +3,"I2_migration",10,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1010000,1010000,100,0.0025,TRUE,10000,492,428,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep10_chr01.trees" +3,"I2_migration",11,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1011000,1011000,100,0.0025,TRUE,10000,566,499,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep11_chr01.trees" +3,"I2_migration",12,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1012000,1012000,100,0.0025,TRUE,10000,541,494,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep12_chr01.trees" +3,"I2_migration",13,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1013000,1013000,100,0.0025,TRUE,10000,441,471,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep13_chr01.trees" +3,"I2_migration",14,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1014000,1014000,100,0.0025,TRUE,10000,473,532,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep14_chr01.trees" +3,"I2_migration",15,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1015000,1015000,100,0.0025,TRUE,10000,607,493,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep15_chr01.trees" +3,"I2_migration",16,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1016000,1016000,100,0.0025,TRUE,10000,504,504,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep16_chr01.trees" +3,"I2_migration",17,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1017000,1017000,100,0.0025,TRUE,10000,532,540,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep17_chr01.trees" +3,"I2_migration",18,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1018000,1018000,100,0.0025,TRUE,10000,622,522,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep18_chr01.trees" +3,"I2_migration",19,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1019000,1019000,100,0.0025,TRUE,10000,364,439,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep19_chr01.trees" +3,"I2_migration",20,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1020000,1020000,100,0.0025,TRUE,10000,458,471,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep20_chr01.trees" +3,"I2_migration",21,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1021000,1021000,100,0.0025,TRUE,10000,459,489,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep21_chr01.trees" +3,"I2_migration",22,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1022000,1022000,100,0.0025,TRUE,10000,471,434,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep22_chr01.trees" +3,"I2_migration",23,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1023000,1023000,100,0.0025,TRUE,10000,488,464,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep23_chr01.trees" +3,"I2_migration",24,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1024000,1024000,100,0.0025,TRUE,10000,500,476,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep24_chr01.trees" +3,"I2_migration",25,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1025000,1025000,100,0.0025,TRUE,10000,523,500,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep25_chr01.trees" +3,"I2_migration",26,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1026000,1026000,100,0.0025,TRUE,10000,581,533,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep26_chr01.trees" +3,"I2_migration",27,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1027000,1027000,100,0.0025,TRUE,10000,637,521,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep27_chr01.trees" +3,"I2_migration",28,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1028000,1028000,100,0.0025,TRUE,10000,500,538,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep28_chr01.trees" +3,"I2_migration",29,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1029000,1029000,100,0.0025,TRUE,10000,517,734,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep29_chr01.trees" +3,"I2_migration",30,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1030000,1030000,100,0.0025,TRUE,10000,533,471,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep30_chr01.trees" +3,"I2_migration",31,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1031000,1031000,100,0.0025,TRUE,10000,525,565,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep31_chr01.trees" +3,"I2_migration",32,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1032000,1032000,100,0.0025,TRUE,10000,478,524,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep32_chr01.trees" +3,"I2_migration",33,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1033000,1033000,100,0.0025,TRUE,10000,654,422,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep33_chr01.trees" +3,"I2_migration",34,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1034000,1034000,100,0.0025,TRUE,10000,405,505,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep34_chr01.trees" +3,"I2_migration",35,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1035000,1035000,100,0.0025,TRUE,10000,522,489,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep35_chr01.trees" +3,"I2_migration",36,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1036000,1036000,100,0.0025,TRUE,10000,500,551,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep36_chr01.trees" +3,"I2_migration",37,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1037000,1037000,100,0.0025,TRUE,10000,551,571,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep37_chr01.trees" +3,"I2_migration",38,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1038000,1038000,100,0.0025,TRUE,10000,548,442,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep38_chr01.trees" +3,"I2_migration",39,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1039000,1039000,100,0.0025,TRUE,10000,490,476,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep39_chr01.trees" +3,"I2_migration",40,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1040000,1040000,100,0.0025,TRUE,10000,607,464,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep40_chr01.trees" +3,"I2_migration",41,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1041000,1041000,100,0.0025,TRUE,10000,568,647,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep41_chr01.trees" +3,"I2_migration",42,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1042000,1042000,100,0.0025,TRUE,10000,441,529,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep42_chr01.trees" +3,"I2_migration",43,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1043000,1043000,100,0.0025,TRUE,10000,533,591,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep43_chr01.trees" +3,"I2_migration",44,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1044000,1044000,100,0.0025,TRUE,10000,503,443,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep44_chr01.trees" +3,"I2_migration",45,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1045000,1045000,100,0.0025,TRUE,10000,554,557,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep45_chr01.trees" +3,"I2_migration",46,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1046000,1046000,100,0.0025,TRUE,10000,551,562,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep46_chr01.trees" +3,"I2_migration",47,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1047000,1047000,100,0.0025,TRUE,10000,412,493,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep47_chr01.trees" +3,"I2_migration",48,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1048000,1048000,100,0.0025,TRUE,10000,449,391,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep48_chr01.trees" +3,"I2_migration",49,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1049000,1049000,100,0.0025,TRUE,10000,444,442,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep49_chr01.trees" +3,"I2_migration",50,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s ",1050000,1050000,100,0.0025,TRUE,10000,486,527,"testData/out_phase1_useMacsMut_FALSE/I2_migration_rep50_chr01.trees" +4,"I2_en_join",1,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1101000,1101000,100,0.0025,TRUE,10000,440,422,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep01_chr01.trees" +4,"I2_en_join",2,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1102000,1102000,100,0.0025,TRUE,10000,584,451,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep02_chr01.trees" +4,"I2_en_join",3,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1103000,1103000,100,0.0025,TRUE,10000,485,646,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep03_chr01.trees" +4,"I2_en_join",4,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1104000,1104000,100,0.0025,TRUE,10000,595,523,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep04_chr01.trees" +4,"I2_en_join",5,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1105000,1105000,100,0.0025,TRUE,10000,385,418,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep05_chr01.trees" +4,"I2_en_join",6,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1106000,1106000,100,0.0025,TRUE,10000,425,386,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep06_chr01.trees" +4,"I2_en_join",7,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1107000,1107000,100,0.0025,TRUE,10000,459,470,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep07_chr01.trees" +4,"I2_en_join",8,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1108000,1108000,100,0.0025,TRUE,10000,513,524,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep08_chr01.trees" +4,"I2_en_join",9,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1109000,1109000,100,0.0025,TRUE,10000,619,541,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep09_chr01.trees" +4,"I2_en_join",10,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1110000,1110000,100,0.0025,TRUE,10000,514,442,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep10_chr01.trees" +4,"I2_en_join",11,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1111000,1111000,100,0.0025,TRUE,10000,367,538,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep11_chr01.trees" +4,"I2_en_join",12,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1112000,1112000,100,0.0025,TRUE,10000,558,495,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep12_chr01.trees" +4,"I2_en_join",13,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1113000,1113000,100,0.0025,TRUE,10000,288,502,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep13_chr01.trees" +4,"I2_en_join",14,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1114000,1114000,100,0.0025,TRUE,10000,511,484,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep14_chr01.trees" +4,"I2_en_join",15,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1115000,1115000,100,0.0025,TRUE,10000,676,515,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep15_chr01.trees" +4,"I2_en_join",16,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1116000,1116000,100,0.0025,TRUE,10000,386,317,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep16_chr01.trees" +4,"I2_en_join",17,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1117000,1117000,100,0.0025,TRUE,10000,508,540,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep17_chr01.trees" +4,"I2_en_join",18,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1118000,1118000,100,0.0025,TRUE,10000,383,451,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep18_chr01.trees" +4,"I2_en_join",19,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1119000,1119000,100,0.0025,TRUE,10000,602,527,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep19_chr01.trees" +4,"I2_en_join",20,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1120000,1120000,100,0.0025,TRUE,10000,431,508,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep20_chr01.trees" +4,"I2_en_join",21,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1121000,1121000,100,0.0025,TRUE,10000,450,418,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep21_chr01.trees" +4,"I2_en_join",22,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1122000,1122000,100,0.0025,TRUE,10000,545,498,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep22_chr01.trees" +4,"I2_en_join",23,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1123000,1123000,100,0.0025,TRUE,10000,512,546,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep23_chr01.trees" +4,"I2_en_join",24,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1124000,1124000,100,0.0025,TRUE,10000,528,494,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep24_chr01.trees" +4,"I2_en_join",25,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1125000,1125000,100,0.0025,TRUE,10000,462,585,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep25_chr01.trees" +4,"I2_en_join",26,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1126000,1126000,100,0.0025,TRUE,10000,491,378,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep26_chr01.trees" +4,"I2_en_join",27,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1127000,1127000,100,0.0025,TRUE,10000,623,571,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep27_chr01.trees" +4,"I2_en_join",28,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1128000,1128000,100,0.0025,TRUE,10000,608,422,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep28_chr01.trees" +4,"I2_en_join",29,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1129000,1129000,100,0.0025,TRUE,10000,461,371,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep29_chr01.trees" +4,"I2_en_join",30,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1130000,1130000,100,0.0025,TRUE,10000,451,358,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep30_chr01.trees" +4,"I2_en_join",31,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1131000,1131000,100,0.0025,TRUE,10000,560,435,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep31_chr01.trees" +4,"I2_en_join",32,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1132000,1132000,100,0.0025,TRUE,10000,406,435,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep32_chr01.trees" +4,"I2_en_join",33,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1133000,1133000,100,0.0025,TRUE,10000,511,525,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep33_chr01.trees" +4,"I2_en_join",34,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1134000,1134000,100,0.0025,TRUE,10000,522,520,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep34_chr01.trees" +4,"I2_en_join",35,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1135000,1135000,100,0.0025,TRUE,10000,489,463,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep35_chr01.trees" +4,"I2_en_join",36,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1136000,1136000,100,0.0025,TRUE,10000,401,587,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep36_chr01.trees" +4,"I2_en_join",37,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1137000,1137000,100,0.0025,TRUE,10000,534,508,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep37_chr01.trees" +4,"I2_en_join",38,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1138000,1138000,100,0.0025,TRUE,10000,521,484,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep38_chr01.trees" +4,"I2_en_join",39,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1139000,1139000,100,0.0025,TRUE,10000,508,488,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep39_chr01.trees" +4,"I2_en_join",40,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1140000,1140000,100,0.0025,TRUE,10000,411,425,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep40_chr01.trees" +4,"I2_en_join",41,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1141000,1141000,100,0.0025,TRUE,10000,474,465,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep41_chr01.trees" +4,"I2_en_join",42,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1142000,1142000,100,0.0025,TRUE,10000,521,589,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep42_chr01.trees" +4,"I2_en_join",43,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1143000,1143000,100,0.0025,TRUE,10000,456,646,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep43_chr01.trees" +4,"I2_en_join",44,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1144000,1144000,100,0.0025,TRUE,10000,584,490,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep44_chr01.trees" +4,"I2_en_join",45,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1145000,1145000,100,0.0025,TRUE,10000,550,359,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep45_chr01.trees" +4,"I2_en_join",46,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1146000,1146000,100,0.0025,TRUE,10000,465,389,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep46_chr01.trees" +4,"I2_en_join",47,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1147000,1147000,100,0.0025,TRUE,10000,480,552,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep47_chr01.trees" +4,"I2_en_join",48,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1148000,1148000,100,0.0025,TRUE,10000,505,451,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep48_chr01.trees" +4,"I2_en_join",49,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1149000,1149000,100,0.0025,TRUE,10000,607,423,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep49_chr01.trees" +4,"I2_en_join",50,1,"8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ",1150000,1150000,100,0.0025,TRUE,10000,455,433,"testData/out_phase1_useMacsMut_FALSE/I2_en_join_rep50_chr01.trees" diff --git a/dev/testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_run_status.csv b/dev/testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_run_status.csv new file mode 100644 index 00000000..7f71bb2d --- /dev/null +++ b/dev/testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_run_status.csv @@ -0,0 +1,201 @@ +"scenario_id","scenario","rep","success","error" +1,"single_const",1,TRUE,"" +1,"single_const",2,TRUE,"" +1,"single_const",3,TRUE,"" +1,"single_const",4,TRUE,"" +1,"single_const",5,TRUE,"" +1,"single_const",6,TRUE,"" +1,"single_const",7,TRUE,"" +1,"single_const",8,TRUE,"" +1,"single_const",9,TRUE,"" +1,"single_const",10,TRUE,"" +1,"single_const",11,TRUE,"" +1,"single_const",12,TRUE,"" +1,"single_const",13,TRUE,"" +1,"single_const",14,TRUE,"" +1,"single_const",15,TRUE,"" +1,"single_const",16,TRUE,"" +1,"single_const",17,TRUE,"" +1,"single_const",18,TRUE,"" +1,"single_const",19,TRUE,"" +1,"single_const",20,TRUE,"" +1,"single_const",21,TRUE,"" +1,"single_const",22,TRUE,"" +1,"single_const",23,TRUE,"" +1,"single_const",24,TRUE,"" +1,"single_const",25,TRUE,"" +1,"single_const",26,TRUE,"" +1,"single_const",27,TRUE,"" +1,"single_const",28,TRUE,"" +1,"single_const",29,TRUE,"" +1,"single_const",30,TRUE,"" +1,"single_const",31,TRUE,"" +1,"single_const",32,TRUE,"" +1,"single_const",33,TRUE,"" +1,"single_const",34,TRUE,"" +1,"single_const",35,TRUE,"" +1,"single_const",36,TRUE,"" +1,"single_const",37,TRUE,"" +1,"single_const",38,TRUE,"" +1,"single_const",39,TRUE,"" +1,"single_const",40,TRUE,"" +1,"single_const",41,TRUE,"" +1,"single_const",42,TRUE,"" +1,"single_const",43,TRUE,"" +1,"single_const",44,TRUE,"" +1,"single_const",45,TRUE,"" +1,"single_const",46,TRUE,"" +1,"single_const",47,TRUE,"" +1,"single_const",48,TRUE,"" +1,"single_const",49,TRUE,"" +1,"single_const",50,TRUE,"" +2,"single_eN",1,TRUE,"" +2,"single_eN",2,TRUE,"" +2,"single_eN",3,TRUE,"" +2,"single_eN",4,TRUE,"" +2,"single_eN",5,TRUE,"" +2,"single_eN",6,TRUE,"" +2,"single_eN",7,TRUE,"" +2,"single_eN",8,TRUE,"" +2,"single_eN",9,TRUE,"" +2,"single_eN",10,TRUE,"" +2,"single_eN",11,TRUE,"" +2,"single_eN",12,TRUE,"" +2,"single_eN",13,TRUE,"" +2,"single_eN",14,TRUE,"" +2,"single_eN",15,TRUE,"" +2,"single_eN",16,TRUE,"" +2,"single_eN",17,TRUE,"" +2,"single_eN",18,TRUE,"" +2,"single_eN",19,TRUE,"" +2,"single_eN",20,TRUE,"" +2,"single_eN",21,TRUE,"" +2,"single_eN",22,TRUE,"" +2,"single_eN",23,TRUE,"" +2,"single_eN",24,TRUE,"" +2,"single_eN",25,TRUE,"" +2,"single_eN",26,TRUE,"" +2,"single_eN",27,TRUE,"" +2,"single_eN",28,TRUE,"" +2,"single_eN",29,TRUE,"" +2,"single_eN",30,TRUE,"" +2,"single_eN",31,TRUE,"" +2,"single_eN",32,TRUE,"" +2,"single_eN",33,TRUE,"" +2,"single_eN",34,TRUE,"" +2,"single_eN",35,TRUE,"" +2,"single_eN",36,TRUE,"" +2,"single_eN",37,TRUE,"" +2,"single_eN",38,TRUE,"" +2,"single_eN",39,TRUE,"" +2,"single_eN",40,TRUE,"" +2,"single_eN",41,TRUE,"" +2,"single_eN",42,TRUE,"" +2,"single_eN",43,TRUE,"" +2,"single_eN",44,TRUE,"" +2,"single_eN",45,TRUE,"" +2,"single_eN",46,TRUE,"" +2,"single_eN",47,TRUE,"" +2,"single_eN",48,TRUE,"" +2,"single_eN",49,TRUE,"" +2,"single_eN",50,TRUE,"" +3,"I2_migration",1,TRUE,"" +3,"I2_migration",2,TRUE,"" +3,"I2_migration",3,TRUE,"" +3,"I2_migration",4,TRUE,"" +3,"I2_migration",5,TRUE,"" +3,"I2_migration",6,TRUE,"" +3,"I2_migration",7,TRUE,"" +3,"I2_migration",8,TRUE,"" +3,"I2_migration",9,TRUE,"" +3,"I2_migration",10,TRUE,"" +3,"I2_migration",11,TRUE,"" +3,"I2_migration",12,TRUE,"" +3,"I2_migration",13,TRUE,"" +3,"I2_migration",14,TRUE,"" +3,"I2_migration",15,TRUE,"" +3,"I2_migration",16,TRUE,"" +3,"I2_migration",17,TRUE,"" +3,"I2_migration",18,TRUE,"" +3,"I2_migration",19,TRUE,"" +3,"I2_migration",20,TRUE,"" +3,"I2_migration",21,TRUE,"" +3,"I2_migration",22,TRUE,"" +3,"I2_migration",23,TRUE,"" +3,"I2_migration",24,TRUE,"" +3,"I2_migration",25,TRUE,"" +3,"I2_migration",26,TRUE,"" +3,"I2_migration",27,TRUE,"" +3,"I2_migration",28,TRUE,"" +3,"I2_migration",29,TRUE,"" +3,"I2_migration",30,TRUE,"" +3,"I2_migration",31,TRUE,"" +3,"I2_migration",32,TRUE,"" +3,"I2_migration",33,TRUE,"" +3,"I2_migration",34,TRUE,"" +3,"I2_migration",35,TRUE,"" +3,"I2_migration",36,TRUE,"" +3,"I2_migration",37,TRUE,"" +3,"I2_migration",38,TRUE,"" +3,"I2_migration",39,TRUE,"" +3,"I2_migration",40,TRUE,"" +3,"I2_migration",41,TRUE,"" +3,"I2_migration",42,TRUE,"" +3,"I2_migration",43,TRUE,"" +3,"I2_migration",44,TRUE,"" +3,"I2_migration",45,TRUE,"" +3,"I2_migration",46,TRUE,"" +3,"I2_migration",47,TRUE,"" +3,"I2_migration",48,TRUE,"" +3,"I2_migration",49,TRUE,"" +3,"I2_migration",50,TRUE,"" +4,"I2_en_join",1,TRUE,"" +4,"I2_en_join",2,TRUE,"" +4,"I2_en_join",3,TRUE,"" +4,"I2_en_join",4,TRUE,"" +4,"I2_en_join",5,TRUE,"" +4,"I2_en_join",6,TRUE,"" +4,"I2_en_join",7,TRUE,"" +4,"I2_en_join",8,TRUE,"" +4,"I2_en_join",9,TRUE,"" +4,"I2_en_join",10,TRUE,"" +4,"I2_en_join",11,TRUE,"" +4,"I2_en_join",12,TRUE,"" +4,"I2_en_join",13,TRUE,"" +4,"I2_en_join",14,TRUE,"" +4,"I2_en_join",15,TRUE,"" +4,"I2_en_join",16,TRUE,"" +4,"I2_en_join",17,TRUE,"" +4,"I2_en_join",18,TRUE,"" +4,"I2_en_join",19,TRUE,"" +4,"I2_en_join",20,TRUE,"" +4,"I2_en_join",21,TRUE,"" +4,"I2_en_join",22,TRUE,"" +4,"I2_en_join",23,TRUE,"" +4,"I2_en_join",24,TRUE,"" +4,"I2_en_join",25,TRUE,"" +4,"I2_en_join",26,TRUE,"" +4,"I2_en_join",27,TRUE,"" +4,"I2_en_join",28,TRUE,"" +4,"I2_en_join",29,TRUE,"" +4,"I2_en_join",30,TRUE,"" +4,"I2_en_join",31,TRUE,"" +4,"I2_en_join",32,TRUE,"" +4,"I2_en_join",33,TRUE,"" +4,"I2_en_join",34,TRUE,"" +4,"I2_en_join",35,TRUE,"" +4,"I2_en_join",36,TRUE,"" +4,"I2_en_join",37,TRUE,"" +4,"I2_en_join",38,TRUE,"" +4,"I2_en_join",39,TRUE,"" +4,"I2_en_join",40,TRUE,"" +4,"I2_en_join",41,TRUE,"" +4,"I2_en_join",42,TRUE,"" +4,"I2_en_join",43,TRUE,"" +4,"I2_en_join",44,TRUE,"" +4,"I2_en_join",45,TRUE,"" +4,"I2_en_join",46,TRUE,"" +4,"I2_en_join",47,TRUE,"" +4,"I2_en_join",48,TRUE,"" +4,"I2_en_join",49,TRUE,"" +4,"I2_en_join",50,TRUE,"" diff --git a/dev/testMaCSTS1.Rmd b/dev/testMaCSTS1.Rmd new file mode 100644 index 00000000..da8808e1 --- /dev/null +++ b/dev/testMaCSTS1.Rmd @@ -0,0 +1,385 @@ +--- +title: "test MaCSTS 1" +output: html_document +date: "2026-06-03" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +## General Notes + +- `MaCSTS()` now returns ts tables per chromosome: records ancestry from MaCS local trees (nodes/edges/intervals), and with `useMacsMut = TRUE` it also records MaCS-generated sites/mutations during simulation. +- TS ancestry/mutation work is split into staged helpers: `simAnc()`, `simMut()`, and `finalizeInbredTs()` (optional, when `inbred=TRUE`). +- `MaCSTS()`is designed to be a part of the high-level `runMacsTS()` wrapper, which will handle: + + - 1.TS generation (simAnc, and optionally simMut depending on mode); + - 2.TS-to-founder conversion (logic in `R/makeFoundersFromTs.R`: site sampling/filtering, genMap construction); + - 3.return a MapPop object like runMacs. + +- Current TS chromosome count uses `nChr` (not `maxSites`, `maxSites` will only be in high level wrapper runMacsTS). +- Per-chromosome simulation runs in parallel when OpenMP is available (`nThreads`). + +## Goal Of This Notebook + +First validate `useMacsMut = TRUE`, because it should be directly comparable to legacy `MaCS` under the same args and seeds. + +Note: when `useMacsMut = FALSE`, even ancestry (trees without mutation) can differ from MaCS because of RNG state changes! Specifically, it’s one shared RNG state/stream; MaCS (and MaCSTS with useMacsMut=TRUE) consume draws for both ancestry and mutation; MaCSTS with useMacsMut=FALSE skips mutation draws, so change later RNG state. + +## Helpers to Compare MaCSTS with MaCS + +Helper overview: + +- extract_macs_chr(): get site positions + haplotypes from legacy MaCS output. +- extract_ts_chr(): get site positions + haplotypes from TS tables via variant iterator. +- compare_chr(): run strict and order-robust chromosome-level equivalence checks. +- run_case(): run MaCS and MaCSTS(useMacsMut=TRUE) with matched args/seeds and compare. + +```{r} +devtools::load_all() +library(RcppTskit) + +# Convert raw 00/01 display values to integer 0/1 matrix. +to_int01 <- function(x) { + matrix(as.integer(x), nrow = nrow(x), ncol = ncol(x), dimnames = dimnames(x)) +} + +# Read one chromosome from MaCS output (genMap + unpacked haplotypes). +extract_macs_chr <- function(macs_out, chr = 1L, nThreads = 1L) { + pos <- as.numeric(macs_out$genMap[[chr]]) + n_sites <- length(pos) + if (n_sites == 0L) { + return(list(pos = numeric(0), hap = matrix(integer(0), nrow = 0, ncol = 0))) + } + chr_geno <- macs_out$geno[chr] + hap_raw <- AlphaSimR:::getHaplo( + geno = chr_geno, + lociPerChr = as.integer(n_sites), + lociLoc = as.integer(seq_len(n_sites)), + nThreads = as.integer(nThreads) + ) + list(pos = pos, hap = to_int01(hap_raw)) +} + +# Read one chromosome from TS tables (positions + variant genotypes). +extract_ts_chr <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + ts <- tc$tree_sequence() + n_samples <- as.integer(ts$num_samples()) + + it <- ts$variants() + pos <- numeric(0) + cols <- list() + repeat { + v <- it$next_variant() + if (is.null(v)) break + pos <- c(pos, as.numeric(v$position)) + cols[[length(cols) + 1L]] <- as.integer(v$genotypes) + } + + hap <- if (length(cols) == 0L) { + matrix(integer(0), nrow = n_samples, ncol = 0L) + } else { + do.call(cbind, cols) + } + + list( + pos = pos, + hap = hap, + num_sites = as.integer(ts$num_sites()), + num_mutations = as.integer(ts$num_mutations()) + ) +} + +# Sort position/genotype columns by position for strict positional matching. +sort_by_pos <- function(x) { + if (length(x$pos) == 0L) return(x) + o <- order(x$pos) + list(pos = x$pos[o], hap = x$hap[, o, drop = FALSE]) +} + +# Build position+haplotype keys for multiset comparison. +site_hap_keys <- function(pos, hap) { + if (length(pos) == 0L) return(character(0)) + p <- format(signif(pos, 15), scientific = FALSE, trim = TRUE) + vapply( + seq_len(ncol(hap)), + function(j) paste0(p[j], "|", paste(hap[, j], collapse = "")), + character(1) + ) +} + +# Compare one chromosome: +# 1) strict check after sorting by position, +# 2) multiset check to tolerate column-order differences. +compare_chr <- function(macs_chr, ts_chr) { + A <- sort_by_pos(macs_chr) + B <- sort_by_pos(ts_chr) + + same_nsites <- ncol(A$hap) == ncol(B$hap) + same_positions_strict <- isTRUE(all.equal(A$pos, B$pos, tolerance = 0)) + same_hap_strict <- identical(A$hap, B$hap) + + # Order-robust check for duplicate-position edge cases + keysA <- site_hap_keys(macs_chr$pos, macs_chr$hap) + keysB <- site_hap_keys(ts_chr$pos, ts_chr$hap) + same_site_hap_multiset <- identical(sort(keysA), sort(keysB)) + + data.frame( + same_nsites = same_nsites, + same_positions_strict = same_positions_strict, + same_hap_strict = same_hap_strict, + same_site_hap_multiset = same_site_hap_multiset, + ts_num_sites = ts_chr$num_sites, + ts_num_mutations = ts_chr$num_mutations + ) +} + +# Run a full matched-seed comparison for nChr chromosomes. +run_case <- function(args, nChr, inbred, ploidy, seed, nThreads = 1L) { + seed_vec <- rep(as.integer(seed), as.integer(nChr)) + + macs <- AlphaSimR:::MaCS( + args = args, + maxSites = rep(0L, as.integer(nChr)), + inbred = inbred, + ploidy = as.integer(ploidy), + nThreads = as.integer(nThreads), + seed = seed_vec + ) + + ts_out <- AlphaSimR:::MaCSTS( + args = args, + nChr = as.integer(nChr), + inbred = inbred, + ploidy = as.integer(ploidy), + nThreads = as.integer(nThreads), + seed = seed_vec, + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ) + + out <- lapply(seq_len(as.integer(nChr)), function(chr) { + m <- extract_macs_chr(macs, chr = chr, nThreads = nThreads) + t <- extract_ts_chr(ts_out$tables[[chr]]) + cbind(chr = chr, compare_chr(m, t)) + }) + do.call(rbind, out) +} +``` + +## General Case +In the first case, I will use some more detail results to show what are the objects being compared here: +```{r} +args <- "4 10000 -t 1e-3 -r 1e-2 -s " +seed <- as.integer(42) +inbred <- FALSE +ploidy <- 2L +nChr <- 1L + +macs <- AlphaSimR:::MaCS( + args = args, + maxSites = rep(0L, as.integer(nChr)), + inbred = inbred, + ploidy = ploidy, + seed = seed, + nThreads = 1L + ) + + ts_out <- AlphaSimR:::MaCSTS( + args = args, + nChr = nChr, + inbred = inbred, + ploidy = ploidy, + seed = seed, + usePhysicalPositions = FALSE, + useMacsMut = TRUE, + nThreads = 1L + ) + +chr = 1L +m <- extract_macs_chr(macs, chr = chr) +t <- extract_ts_chr(ts_out$tables[[chr]]) +``` + +Both genotypes and positions matched between MaCS and MaCSTS with `useMacsMut = TRUE`: + +``` +> print(m) +$pos + [1] 0.1589878 0.1677192 0.1945866 0.2692034 0.2851194 0.2942718 + [7] 0.3008355 0.3116991 0.3385464 0.3423128 0.3543942 0.4430878 +[13] 0.4690506 0.4930433 0.5781099 0.6904748 0.7921847 0.8604606 + +$hap + [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] +[1,] 1 0 0 0 0 0 1 0 1 0 0 0 +[2,] 1 0 1 1 1 1 0 1 0 0 0 0 +[3,] 0 1 1 0 0 0 1 0 1 1 1 1 +[4,] 0 1 1 0 0 0 1 0 0 0 0 0 + [,13] [,14] [,15] [,16] [,17] [,18] +[1,] 0 0 0 0 1 0 +[2,] 0 0 1 0 1 0 +[3,] 0 1 1 0 0 0 +[4,] 1 0 0 1 0 1 +``` +``` +> print(t) +$pos + [1] 0.1589878 0.1677192 0.1945866 0.2692034 0.2851194 0.2942718 + [7] 0.3008355 0.3116991 0.3385464 0.3423128 0.3543942 0.4430878 +[13] 0.4690506 0.4930433 0.5781099 0.6904748 0.7921847 0.8604606 + +$hap + [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] +[1,] 1 0 0 0 0 0 1 0 1 0 0 0 +[2,] 1 0 1 1 1 1 0 1 0 0 0 0 +[3,] 0 1 1 0 0 0 1 0 1 1 1 1 +[4,] 0 1 1 0 0 0 1 0 0 0 0 0 + [,13] [,14] [,15] [,16] [,17] [,18] +[1,] 0 0 0 0 1 0 +[2,] 0 0 1 0 1 0 +[3,] 0 1 1 0 0 0 +[4,] 1 0 0 1 0 1 + +$num_sites +[1] 18 + +$num_mutations +[1] 18 +``` + +Or we can run: +```{r} +z <- run_case( + args = args, + nChr = 1L, + inbred = inbred, + ploidy = ploidy, + seed = seed + ) +``` +`same_hap_strict = TRUE` plus `same_positions_strict = TRUE` means direct compatibility matched exactly: +``` +> print(z) + chr same_nsites same_positions_strict same_hap_strict +1 1 TRUE TRUE TRUE + same_site_hap_multiset ts_num_sites ts_num_mutations +1 TRUE 18 18 +``` + +## More cases +Now I will run a scenario sweep with 5 different scenarios, and all of them show the same result that MaCSTS with `useMacsMut = TRUE` can reproduce the same sites and haplotypes as MaCS. + +### Scenario1: ploidy = 1L +```{r} +args <- "4 10000 -t 1e-3 -r 1e-2 -s " +seed <- as.integer(42) +inbred <- FALSE +ploidy <- 1L +nChr <- 1L +z1 <- run_case( + args = args, + nChr = 1L, + inbred = inbred, + ploidy = ploidy, + seed = seed + ) +print(z1) +``` + +### Scenario2: inbred = TRUE +```{r} +args <- "4 10000 -t 1e-3 -r 1e-2 -s " +seed <- as.integer(42) +inbred <- TRUE +ploidy <- 2L +nChr <- 1L +z2 <- run_case( + args = args, + nChr = 1L, + inbred = inbred, + ploidy = ploidy, + seed = seed + ) +print(z2) +``` + +### Scenario3: demography +```{r} +# eN 0.2 2.0: at time 0.2, size jumps to 2x baseline. +# eN 1.0 0.5: at time 1.0, size jumps to 0.5x baseline. +args <- "4 10000 -t 1e-3 -r 1e-2 -eN 0.2 2.0 -eN 1.0 0.5 -s " +seed <- as.integer(42) +inbred <- FALSE +ploidy <- 2L +nChr <- 1L +z3 <- run_case( + args = args, + nChr = 1L, + inbred = inbred, + ploidy = ploidy, + seed = seed + ) +print(z3) +``` + + +### Scenario4: 2 populations after a split +```{r} +# -I: 8 sampled chromosomes from 2 pops total, with 4 from pop 1 and 4 from pop 2 +# -ej: at time 1.0, pop 2 merges into pop 1 (backward), which corresponds to a split from pop 1 to pop 2 forward in time. +args <- "8 10000 -t 1e-3 -r 1e-2 -I 2 4 4 -ej 1.0 2 1 -s " +seed <- as.integer(42) +inbred <- FALSE +ploidy <- 2L +nChr <- 1L + +ts_out4 <- AlphaSimR:::MaCSTS( + args = args, + nChr = nChr, + inbred = inbred, + ploidy = ploidy, + seed = seed, + usePhysicalPositions = FALSE, + useMacsMut = TRUE, + nThreads = 1L +) + +# read population info from node table for the 4th node (which should be in pop 2 after the split) +tc4 <- RcppTskit::TableCollection$new(xptr = ts_out4$tables[[1]]) +tc4$node_table_get_row(4)['population'] +tc4$node_table_get_row(3)['population'] + +z4 <- run_case( + args = args, + nChr = 1L, + inbred = inbred, + ploidy = ploidy, + seed = seed + ) +print(z4) +``` + +### Scenario5: 2 populations with a migration +```{r} +# -I: 8 sampled chromosomes from 2 pops total, with 4 from pop 1 and 4 from pop 2 +# at backward time t = 0.5, set the global migration-rate parameter to 5e-3 for all populations +args <- "8 10000 -t 1e-3 -r 1e-2 -I 2 4 4 -eM 0.5 5e-3 -s " +seed <- as.integer(42) +inbred <- FALSE +ploidy <- 2L +nChr <- 1L + +z5 <- run_case( + args = args, + nChr = 1L, + inbred = inbred, + ploidy = ploidy, + seed = seed + ) +print(z5) +``` + + diff --git a/dev/testMaCSTS1.html b/dev/testMaCSTS1.html new file mode 100644 index 00000000..66b74902 --- /dev/null +++ b/dev/testMaCSTS1.html @@ -0,0 +1,816 @@ + + + + + + + + + + + + + + +test MaCSTS 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
+

General Notes

+
    +
  • MaCSTS() now returns ts tables per chromosome: +records ancestry from MaCS local trees (nodes/edges/intervals), and with +useMacsMut = TRUE it also records MaCS-generated +sites/mutations during simulation.

  • +
  • TS ancestry/mutation work is split into staged helpers: +simAnc(), simMut(), and +finalizeInbredTs() (optional, when +inbred=TRUE).

  • +
  • MaCSTS()is designed to be a part of the high-level +runMacsTS() wrapper, which will handle:

    +
      +
    • 1.TS generation (simAnc, and optionally simMut depending on +mode);
    • +
    • 2.TS-to-founder conversion (logic in +R/makeFoundersFromTs.R: site sampling/filtering, genMap +construction);
    • +
    • 3.return a MapPop object like runMacs.
    • +
  • +
  • Current TS chromosome count uses nChr (not +maxSites, maxSites will only be in high level +wrapper runMacsTS).

  • +
  • Per-chromosome simulation runs in parallel when OpenMP is +available (nThreads).

  • +
+
+
+

Goal Of This Notebook

+

First validate useMacsMut = TRUE, because it should be +directly comparable to legacy MaCS under the same args and +seeds.

+

Note: when useMacsMut = FALSE, even ancestry (trees +without mutation) can differ from MaCS because of RNG state changes! +Specifically, it’s one shared RNG state/stream; MaCS (and MaCSTS with +useMacsMut=TRUE) consume draws for both ancestry and mutation; MaCSTS +with useMacsMut=FALSE skips mutation draws, so change later RNG +state.

+
+
+

Helpers to Compare MaCSTS with MaCS

+

Helper overview:

+
    +
  • extract_macs_chr(): get site positions + haplotypes from legacy MaCS +output.
  • +
  • extract_ts_chr(): get site positions + haplotypes from TS tables via +variant iterator.
  • +
  • compare_chr(): run strict and order-robust chromosome-level +equivalence checks.
  • +
  • run_case(): run MaCS and MaCSTS(useMacsMut=TRUE) with matched +args/seeds and compare.
  • +
+
devtools::load_all()
+
## ℹ Loading AlphaSimR
+
library(RcppTskit)
+
+# Convert raw 00/01 display values to integer 0/1 matrix.
+to_int01 <- function(x) {
+  matrix(as.integer(x), nrow = nrow(x), ncol = ncol(x), dimnames = dimnames(x))
+}
+
+# Read one chromosome from MaCS output (genMap + unpacked haplotypes).
+extract_macs_chr <- function(macs_out, chr = 1L, nThreads = 1L) {
+  pos <- as.numeric(macs_out$genMap[[chr]])
+  n_sites <- length(pos)
+  if (n_sites == 0L) {
+    return(list(pos = numeric(0), hap = matrix(integer(0), nrow = 0, ncol = 0)))
+  }
+  chr_geno <- macs_out$geno[chr]
+  hap_raw <- AlphaSimR:::getHaplo(
+    geno = chr_geno,
+    lociPerChr = as.integer(n_sites),
+    lociLoc = as.integer(seq_len(n_sites)),
+    nThreads = as.integer(nThreads)
+  )
+  list(pos = pos, hap = to_int01(hap_raw))
+}
+
+# Read one chromosome from TS tables (positions + variant genotypes).
+extract_ts_chr <- function(tc_xptr) {
+  tc <- RcppTskit::TableCollection$new(xptr = tc_xptr)
+  ts <- tc$tree_sequence()
+  n_samples <- as.integer(ts$num_samples())
+
+  it <- ts$variants()
+  pos <- numeric(0)
+  cols <- list()
+  repeat {
+    v <- it$next_variant()
+    if (is.null(v)) break
+    pos <- c(pos, as.numeric(v$position))
+    cols[[length(cols) + 1L]] <- as.integer(v$genotypes)
+  }
+
+  hap <- if (length(cols) == 0L) {
+    matrix(integer(0), nrow = n_samples, ncol = 0L)
+  } else {
+    do.call(cbind, cols)
+  }
+
+  list(
+    pos = pos,
+    hap = hap,
+    num_sites = as.integer(ts$num_sites()),
+    num_mutations = as.integer(ts$num_mutations())
+  )
+}
+
+# Sort position/genotype columns by position for strict positional matching.
+sort_by_pos <- function(x) {
+  if (length(x$pos) == 0L) return(x)
+  o <- order(x$pos)
+  list(pos = x$pos[o], hap = x$hap[, o, drop = FALSE])
+}
+
+# Build position+haplotype keys for multiset comparison.
+site_hap_keys <- function(pos, hap) {
+  if (length(pos) == 0L) return(character(0))
+  p <- format(signif(pos, 15), scientific = FALSE, trim = TRUE)
+  vapply(
+    seq_len(ncol(hap)),
+    function(j) paste0(p[j], "|", paste(hap[, j], collapse = "")),
+    character(1)
+  )
+}
+
+# Compare one chromosome:
+# 1) strict check after sorting by position,
+# 2) multiset check to tolerate column-order differences.
+compare_chr <- function(macs_chr, ts_chr) {
+  A <- sort_by_pos(macs_chr)
+  B <- sort_by_pos(ts_chr)
+
+  same_nsites <- ncol(A$hap) == ncol(B$hap)
+  same_positions_strict <- isTRUE(all.equal(A$pos, B$pos, tolerance = 0))
+  same_hap_strict <- identical(A$hap, B$hap)
+
+  # Order-robust check for duplicate-position edge cases
+  keysA <- site_hap_keys(macs_chr$pos, macs_chr$hap)
+  keysB <- site_hap_keys(ts_chr$pos, ts_chr$hap)
+  same_site_hap_multiset <- identical(sort(keysA), sort(keysB))
+
+  data.frame(
+    same_nsites = same_nsites,
+    same_positions_strict = same_positions_strict,
+    same_hap_strict = same_hap_strict,
+    same_site_hap_multiset = same_site_hap_multiset,
+    ts_num_sites = ts_chr$num_sites,
+    ts_num_mutations = ts_chr$num_mutations
+  )
+}
+
+# Run a full matched-seed comparison for nChr chromosomes.
+run_case <- function(args, nChr, inbred, ploidy, seed, nThreads = 1L) {
+  seed_vec <- rep(as.integer(seed), as.integer(nChr))
+
+  macs <- AlphaSimR:::MaCS(
+    args = args,
+    maxSites = rep(0L, as.integer(nChr)),
+    inbred = inbred,
+    ploidy = as.integer(ploidy),
+    nThreads = as.integer(nThreads),
+    seed = seed_vec
+  )
+
+  ts_out <- AlphaSimR:::MaCSTS(
+    args = args,
+    nChr = as.integer(nChr),
+    inbred = inbred,
+    ploidy = as.integer(ploidy),
+    nThreads = as.integer(nThreads),
+    seed = seed_vec,
+    usePhysicalPositions = FALSE,
+    useMacsMut = TRUE
+  )
+
+  out <- lapply(seq_len(as.integer(nChr)), function(chr) {
+    m <- extract_macs_chr(macs, chr = chr, nThreads = nThreads)
+    t <- extract_ts_chr(ts_out$tables[[chr]])
+    cbind(chr = chr, compare_chr(m, t))
+  })
+  do.call(rbind, out)
+}
+
+
+

General Case

+

In the first case, I will use some more detail results to show what +are the objects being compared here:

+
args <- "4 10000 -t 1e-3 -r 1e-2 -s "
+seed <- as.integer(42)
+inbred <- FALSE
+ploidy <- 2L
+nChr <- 1L
+
+macs <- AlphaSimR:::MaCS(
+    args = args,
+    maxSites = rep(0L, as.integer(nChr)),
+    inbred = inbred,
+    ploidy = ploidy,
+    seed = seed,
+    nThreads = 1L
+  )
+
+  ts_out <- AlphaSimR:::MaCSTS(
+    args = args,
+    nChr = nChr,
+    inbred = inbred,
+    ploidy = ploidy,
+    seed = seed,
+    usePhysicalPositions = FALSE,
+    useMacsMut = TRUE,
+    nThreads = 1L
+  )
+
+chr = 1L  
+m <- extract_macs_chr(macs, chr = chr)
+t <- extract_ts_chr(ts_out$tables[[chr]])
+

Both genotypes and positions matched between MaCS and MaCSTS with +useMacsMut = TRUE:

+
> print(m)
+$pos
+ [1] 0.1589878 0.1677192 0.1945866 0.2692034 0.2851194 0.2942718
+ [7] 0.3008355 0.3116991 0.3385464 0.3423128 0.3543942 0.4430878
+[13] 0.4690506 0.4930433 0.5781099 0.6904748 0.7921847 0.8604606
+
+$hap
+     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+[1,]    1    0    0    0    0    0    1    0    1     0     0     0
+[2,]    1    0    1    1    1    1    0    1    0     0     0     0
+[3,]    0    1    1    0    0    0    1    0    1     1     1     1
+[4,]    0    1    1    0    0    0    1    0    0     0     0     0
+     [,13] [,14] [,15] [,16] [,17] [,18]
+[1,]     0     0     0     0     1     0
+[2,]     0     0     1     0     1     0
+[3,]     0     1     1     0     0     0
+[4,]     1     0     0     1     0     1
+
> print(t)
+$pos
+ [1] 0.1589878 0.1677192 0.1945866 0.2692034 0.2851194 0.2942718
+ [7] 0.3008355 0.3116991 0.3385464 0.3423128 0.3543942 0.4430878
+[13] 0.4690506 0.4930433 0.5781099 0.6904748 0.7921847 0.8604606
+
+$hap
+     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+[1,]    1    0    0    0    0    0    1    0    1     0     0     0
+[2,]    1    0    1    1    1    1    0    1    0     0     0     0
+[3,]    0    1    1    0    0    0    1    0    1     1     1     1
+[4,]    0    1    1    0    0    0    1    0    0     0     0     0
+     [,13] [,14] [,15] [,16] [,17] [,18]
+[1,]     0     0     0     0     1     0
+[2,]     0     0     1     0     1     0
+[3,]     0     1     1     0     0     0
+[4,]     1     0     0     1     0     1
+
+$num_sites
+[1] 18
+
+$num_mutations
+[1] 18
+

Or we can run:

+
z <- run_case(
+      args = args,
+      nChr = 1L,
+      inbred = inbred,
+      ploidy = ploidy,
+      seed = seed
+    )
+

same_hap_strict = TRUE plus +same_positions_strict = TRUE means direct compatibility +matched exactly:

+
> print(z)
+  chr same_nsites same_positions_strict same_hap_strict
+1   1        TRUE                  TRUE            TRUE
+  same_site_hap_multiset ts_num_sites ts_num_mutations
+1                   TRUE           18               18
+
+
+

More cases

+

Now I will run a scenario sweep with 5 different scenarios, and all +of them show the same result that MaCSTS with +useMacsMut = TRUE can reproduce the same sites and +haplotypes as MaCS.

+
+

Scenario1: ploidy = 1L

+
args <- "4 10000 -t 1e-3 -r 1e-2 -s "
+seed <- as.integer(42)
+inbred <- FALSE
+ploidy <- 1L
+nChr <- 1L
+z1 <- run_case(
+      args = args,
+      nChr = 1L,
+      inbred = inbred,
+      ploidy = ploidy,
+      seed = seed
+    )
+print(z1)
+
##   chr same_nsites same_positions_strict same_hap_strict same_site_hap_multiset
+## 1   1        TRUE                  TRUE            TRUE                   TRUE
+##   ts_num_sites ts_num_mutations
+## 1           18               18
+
+
+

Scenario2: inbred = TRUE

+
args <- "4 10000 -t 1e-3 -r 1e-2 -s "
+seed <- as.integer(42)
+inbred <- TRUE
+ploidy <- 2L
+nChr <- 1L
+z2 <- run_case(
+      args = args,
+      nChr = 1L,
+      inbred = inbred,
+      ploidy = ploidy,
+      seed = seed
+    )
+print(z2)
+
##   chr same_nsites same_positions_strict same_hap_strict same_site_hap_multiset
+## 1   1        TRUE                  TRUE            TRUE                   TRUE
+##   ts_num_sites ts_num_mutations
+## 1           18               18
+
+
+

Scenario3: demography

+
# eN 0.2 2.0: at time 0.2, size jumps to 2x baseline.
+# eN 1.0 0.5: at time 1.0, size jumps to 0.5x baseline.
+args <- "4 10000 -t 1e-3 -r 1e-2 -eN 0.2 2.0 -eN 1.0 0.5 -s "
+seed <- as.integer(42)
+inbred <- FALSE
+ploidy <- 2L
+nChr <- 1L
+z3 <- run_case(
+      args = args,
+      nChr = 1L,
+      inbred = inbred,
+      ploidy = ploidy,
+      seed = seed
+    )
+print(z3)
+
##   chr same_nsites same_positions_strict same_hap_strict same_site_hap_multiset
+## 1   1        TRUE                  TRUE            TRUE                   TRUE
+##   ts_num_sites ts_num_mutations
+## 1           23               23
+
+
+

Scenario4: 2 populations after a split

+
# -I: 8 sampled chromosomes from 2 pops total, with 4 from pop 1 and 4 from pop 2
+# -ej: at time 1.0, pop 2 merges into pop 1 (backward), which corresponds to a split from pop 1 to pop 2 forward in time.
+args <- "8 10000 -t 1e-3 -r 1e-2 -I 2 4 4 -ej 1.0 2 1 -s "
+seed <- as.integer(42)
+inbred <- FALSE
+ploidy <- 2L
+nChr <- 1L
+
+ts_out4 <- AlphaSimR:::MaCSTS(
+  args = args,
+  nChr = nChr,
+  inbred = inbred,
+  ploidy = ploidy,
+  seed = seed,
+  usePhysicalPositions = FALSE,
+  useMacsMut = TRUE,
+  nThreads = 1L
+)
+
+# read population info from node table for the 4th node (which should be in pop 2 after the split)
+tc4 <- RcppTskit::TableCollection$new(xptr = ts_out4$tables[[1]])
+tc4$node_table_get_row(4)['population']
+
## $population
+## [1] 1
+
tc4$node_table_get_row(3)['population']
+
## $population
+## [1] 0
+
z4 <- run_case(
+      args = args,
+      nChr = 1L,
+      inbred = inbred,
+      ploidy = ploidy,
+      seed = seed
+    )
+print(z4)
+
##   chr same_nsites same_positions_strict same_hap_strict same_site_hap_multiset
+## 1   1        TRUE                  TRUE            TRUE                   TRUE
+##   ts_num_sites ts_num_mutations
+## 1           63               63
+
+
+

Scenario5: 2 populations with a migration

+
# -I: 8 sampled chromosomes from 2 pops total, with 4 from pop 1 and 4 from pop 2
+# at backward time t = 0.5, set the global migration-rate parameter to 5e-3 for all populations
+args <- "8 10000 -t 1e-3 -r 1e-2 -I 2 4 4 -eM 0.5 5e-3 -s "
+seed <- as.integer(42)
+inbred <- FALSE
+ploidy <- 2L
+nChr <- 1L
+
+z5 <- run_case(
+      args = args,
+      nChr = 1L,
+      inbred = inbred,
+      ploidy = ploidy,
+      seed = seed
+    )
+print(z5)
+
##   chr same_nsites same_positions_strict same_hap_strict same_site_hap_multiset
+## 1   1        TRUE                  TRUE            TRUE                   TRUE
+##   ts_num_sites ts_num_mutations
+## 1         2162             2162
+
+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/dev/testMaCSTS2.Rmd b/dev/testMaCSTS2.Rmd new file mode 100644 index 00000000..a3b39e71 --- /dev/null +++ b/dev/testMaCSTS2.Rmd @@ -0,0 +1,330 @@ +--- +title: "test MaCSTS 2" +output: html_document +params: + nRep: 50 + nChr: 1 + inbred: false + ploidy: 2 + nThreads: 1 + usePhysicalPositions: true + Nref: 10000 + baseSeed: 700000 + outDir: "testData/out_phase1_useMacsMut_FALSE" + writeTrees: true + applyPostMut: true + mutSeedOffset: 0 +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) +``` + +## General Notes +As mentioned in `test MaCSTS 1`, when `useMacsMut = FALSE`, even ancestry (trees without mutation) from MaCSTS can differ from MaCS because of RNG state changes. So here, we can only focus on the comparison on distributions (e.g. tree height, numbers of mutations, nodes and edges). This notebook runs MaCSTS with `useMacsMut = FALSE` to generate ancestry-only tree sequences across multiple scenarios and replicates, then applies post-TS mutation separately. + +## Goal Of This Notebook + +This notebook runs `MaCSTS(..., useMacsMut = FALSE)` across multiple scenarios, +with multiple replicates per scenario. The mutation distributions and other statistics against legacy MaCS outputs will be compared, the CSV files record the seeds, paths and parameters for all runs; the .trees files will be output, enabling downstream analysis in Python/tskit to compare the distributions about trees and mutations, against msprime simulations. + +Output: + +1. `.trees` files per replicate/chromosome +2. a minimal manifest (`CSV`) listing scenario/rep/chromosome/seed/path + +When `applyPostMut = TRUE`, it also applies post-TS mutation using +`tsMutateTableCollection()` with mutation rate `dTheta = seqLen * (-t)` from args. + +## Configuration + +```{r} +library(AlphaSimR) +library(RcppTskit) + +# Safe param getter so chunks also run interactively (without rmarkdown::render). +get_param <- function(name, default) { + if (exists("params", inherits = TRUE) && + is.list(params) && + !is.null(params[[name]])) { + return(params[[name]]) + } + default +} + +nRep <- as.integer(get_param("nRep", 50L)) +nChr <- as.integer(get_param("nChr", 1L)) +inbred <- isTRUE(get_param("inbred", FALSE)) +ploidy <- as.integer(get_param("ploidy", 2L)) +nThreads <- as.integer(get_param("nThreads", 1L)) +usePhysicalPositions <- isTRUE(get_param("usePhysicalPositions", TRUE)) +Nref <- as.numeric(get_param("Nref", 10000)) +baseSeed <- as.integer(get_param("baseSeed", 700000L)) +outDir <- as.character(get_param("outDir", "out_phase1_useMacsMut_FALSE")) +writeTrees <- isTRUE(get_param("writeTrees", TRUE)) +applyPostMut <- isTRUE(get_param("applyPostMut", TRUE)) +mutSeedOffset <- as.integer(get_param("mutSeedOffset", 0L)) + +if (nRep <= 0L) stop("nRep must be positive.") +if (nChr <= 0L) stop("nChr must be positive.") +if (ploidy <= 0L) stop("ploidy must be positive.") + +dir.create(outDir, recursive = TRUE, showWarnings = FALSE) +``` + +## Scenario Set + +```{r} +# Keep scenarios connected in multi-pop cases (migration and/or join), +# so runs always finish. +scenarios <- list( + list( + id = 1L, + name = "single_const", + args = "8 100000 -t 1e-3 -r 1e-4 -s " + ), + list( + id = 2L, + name = "single_eN", + args = "8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s " + ), + list( + id = 3L, + name = "I2_migration", + args = "8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s " + ), + # -I 2 4 4 1e-2: two populations, 4+4 sampled, with initial migration. + #-en 0.2 2 0.5: pop 2 becomes smaller at time 0.2. + #-ej 1.0 2 1: at time 1.0, pop 2 joins pop 1 backward (equivalent to a forward split). + list( + id = 4L, + name = "I2_en_join", + args = "8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s " + ) +) + +scenario_df <- do.call( + rbind, + lapply(scenarios, function(s) data.frame(id = s$id, name = s$name, args = s$args)) +) +scenario_df +``` + +## Helpers + +```{r} +make_seed_vec <- function(scenario_id, rep_id, nChr, baseSeed) { + # Deterministic integer seed vector, one seed per chromosome. + as.integer(baseSeed + scenario_id * 100000L + rep_id * 1000L + seq_len(nChr) - 1L) +} + +parse_dTheta <- function(args) { + tok <- strsplit(as.character(args), "[,[:space:]]+", perl = TRUE)[[1L]] + tok <- tok[nzchar(tok)] + if (length(tok) < 2L) stop("args must include sample size and sequence length.") + seqLen <- as.numeric(tok[2L]) + if (!is.finite(seqLen) || seqLen <= 0) stop("Invalid sequence length in args.") + i_t <- match("-t", tok) + if (is.na(i_t) || i_t >= length(tok)) return(0) + tval <- as.numeric(tok[i_t + 1L]) + if (!is.finite(tval) || tval < 0) stop("Invalid -t value in args.") + seqLen * tval +} + +run_one <- function(sc, rep_id) { + seed_vec <- make_seed_vec(sc$id, rep_id, nChr, baseSeed) + dTheta <- parse_dTheta(sc$args) + mut_seed_vec <- as.integer(seed_vec + mutSeedOffset) + + out <- AlphaSimR:::MaCSTS( + args = sc$args, + nChr = nChr, + inbred = inbred, + ploidy = ploidy, + nThreads = nThreads, + seed = seed_vec, + usePhysicalPositions = usePhysicalPositions, + useMacsMut = FALSE, + Nref = Nref + ) + timeScale <- as.numeric(out$timeScale) + if (!is.finite(timeScale) || timeScale <= 0) { + stop("Invalid timeScale returned by MaCSTS.") + } + # MaCS dTheta is in coalescent-time units. + # If MaCSTS times were rescaled (e.g., to generations), adjust theta accordingly. + dTheta_post <- dTheta / timeScale + # Legacy MaCS run with identical args/seeds for mutation-count reference. + macs <- AlphaSimR:::MaCS( + args = sc$args, + maxSites = rep(0L, nChr), + inbred = inbred, + ploidy = ploidy, + nThreads = nThreads, + seed = seed_vec + ) + + rows <- vector("list", nChr) + for (chr in seq_len(nChr)) { + tc_xptr <- out$tables[[chr]] + if (applyPostMut && dTheta_post > 0) { + AlphaSimR:::tsMutateTableCollection(tc_xptr, dTheta_post, as.numeric(mut_seed_vec[chr])) + } + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + ts <- tc$tree_sequence() + tc_summary <- AlphaSimR:::rtsk_table_collection_summary2(tc_xptr) + + tree_path <- NA_character_ + if (writeTrees) { + tree_path <- file.path( + outDir, + sprintf("%s_rep%02d_chr%02d.trees", sc$name, rep_id, chr) + ) + ts$write(tree_path) + } + + rows[[chr]] <- data.frame( + scenario_id = sc$id, + scenario = sc$name, + rep = rep_id, + chr = chr, + args = sc$args, + seed_chr = seed_vec[chr], + mut_seed_chr = mut_seed_vec[chr], + dTheta = dTheta, + dTheta_post = dTheta_post, + usePhysicalPositions = usePhysicalPositions, + Nref = Nref, + macs_num_mutations = as.numeric(length(macs$genMap[[chr]])), + macsts_num_mutations = as.numeric(tc_summary$num_mutations), + tree_path = tree_path, + stringsAsFactors = FALSE + ) + } + + do.call(rbind, rows) +} +``` + +## Run Replicates + +```{r} +manifest_rows <- vector("list", length(scenarios) * nRep) +status_rows <- vector("list", length(scenarios) * nRep) +k <- 0L + +for (sc in scenarios) { + for (rep_id in seq_len(nRep)) { + k <- k + 1L + run_label <- sprintf("%s rep%02d", sc$name, rep_id) + cat("Running:", run_label, "\n") + + err_msg <- NA_character_ + one <- tryCatch( + run_one(sc, rep_id), + error = function(e) { + err_msg <<- conditionMessage(e) + NULL + } + ) + + manifest_rows[[k]] <- one + status_rows[[k]] <- data.frame( + scenario_id = sc$id, + scenario = sc$name, + rep = rep_id, + success = !is.null(one), + error = ifelse(is.na(err_msg), "", err_msg), + stringsAsFactors = FALSE + ) + } +} + +manifest_df <- do.call(rbind, Filter(Negate(is.null), manifest_rows)) +if (is.null(manifest_df)) manifest_df <- data.frame() +run_status_df <- do.call(rbind, status_rows) + +run_status_df +``` + +## Mutation Count Check (MaCS vs MaCSTS ancestry-only) + +Per-replicate mutation counts are not expected to be identical because legacy MaCS mutates during local-tree simulation, while post-TS mutates on the recorded edge tables with its own RNG stream. However, the mutation count distributions should be similar, and the mean difference should be small relative to the mean mutation count. The `mut_stats` table summarizes these comparisons per scenario. + +```{r} +if (nrow(manifest_df) == 0L) { + stop("No successful runs. Check run_status_df$error.") +} + +mut_stats <- do.call( + rbind, + lapply(split(manifest_df, manifest_df$scenario), function(d) { + delta <- d$macs_num_mutations - d$macsts_num_mutations + + sd_macs <- sd(d$macs_num_mutations, na.rm = TRUE) + sd_macsts <- sd(d$macsts_num_mutations, na.rm = TRUE) + sd_delta <- sd(delta, na.rm = TRUE) + + data.frame( + scenario = d$scenario[1], + n = nrow(d), + macs_mut_mean = mean(d$macs_num_mutations, na.rm = TRUE), + macs_mut_sd = sd_macs, + macsts_mut_mean = mean(d$macsts_num_mutations, na.rm = TRUE), + macsts_mut_sd = sd_macsts, + mut_diff_mean = mean(delta, na.rm = TRUE), + mut_diff_sd = sd_delta, + rel_diff = mean(delta, na.rm = TRUE) / + mean(d$macs_num_mutations, na.rm = TRUE), + stringsAsFactors = FALSE + ) + }) +) +mut_stats +``` + +```{r} +library(dplyr) +library(tidyr) +library(ggplot2) +plot_df <- mut_stats %>% + select(scenario, macs_mut_mean, macs_mut_sd, macsts_mut_mean, macsts_mut_sd) %>% + pivot_longer( + cols = -scenario, + names_to = c("method", ".value"), + names_pattern = "(macs|macsts)_mut_(mean|sd)" + ) %>% + mutate(method = recode(method, macs = "MaCS", macsts = "MaCSTS")) + +ggplot(plot_df, aes(x = scenario, y = mean, fill = method)) + + geom_col(position = position_dodge(width = 0.8), width = 0.7) + + geom_errorbar( + aes(ymin = mean - sd, ymax = mean + sd), + position = position_dodge(width = 0.8), + width = 0.2 + ) + + labs(x = "Scenario", y = "Mean # mutations", fill = "Method") + + theme_bw() +``` + + +## Save Outputs + +```{r} +manifest_csv_path <- file.path(outDir, "phase1_macsTS_useMacsMut_FALSE_manifest.csv") +status_csv_path <- file.path(outDir, "phase1_macsTS_useMacsMut_FALSE_run_status.csv") + +write.csv(manifest_df, manifest_csv_path, row.names = FALSE) +write.csv(run_status_df, status_csv_path, row.names = FALSE) + +cat("Saved manifest CSV:", manifest_csv_path, "\n") +cat("Saved run status CSV:", status_csv_path, "\n") +if (writeTrees) { + cat("Saved .trees files under:", outDir, "\n") +} +``` + +## Next Step + +Convert the parameters and use them to run simulations with msprime. +Then we can compare the distributions on number of trees, edges, nodes, mutations and tree heights. diff --git a/dev/testMaCSTS2.html b/dev/testMaCSTS2.html new file mode 100644 index 00000000..10adb755 --- /dev/null +++ b/dev/testMaCSTS2.html @@ -0,0 +1,1140 @@ + + + + + + + + + + + + + +test MaCSTS 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
+

General Notes

+

As mentioned in test MaCSTS 1, when +useMacsMut = FALSE, even ancestry (trees without mutation) +from MaCSTS can differ from MaCS because of RNG state changes. So here, +we can only focus on the comparison on distributions (e.g. tree height, +numbers of mutations, nodes and edges). This notebook runs MaCSTS with +useMacsMut = FALSE to generate ancestry-only tree sequences +across multiple scenarios and replicates, then applies post-TS mutation +separately.

+
+
+

Goal Of This Notebook

+

This notebook runs MaCSTS(..., useMacsMut = FALSE) +across multiple scenarios, with multiple replicates per scenario. The +mutation distributions and other statistics against legacy MaCS outputs +will be compared, the CSV files record the seeds, paths and parameters +for all runs; the .trees files will be output, enabling downstream +analysis in Python/tskit to compare the distributions about trees and +mutations, against msprime simulations.

+

Output:

+
    +
  1. .trees files per replicate/chromosome
  2. +
  3. a minimal manifest (CSV) listing +scenario/rep/chromosome/seed/path
  4. +
+

When applyPostMut = TRUE, it also applies post-TS +mutation using tsMutateTableCollection() with mutation rate +dTheta = seqLen * (-t) from args.

+
+
+

Configuration

+
library(AlphaSimR)
+library(RcppTskit)
+
+# Safe param getter so chunks also run interactively (without rmarkdown::render).
+get_param <- function(name, default) {
+  if (exists("params", inherits = TRUE) &&
+      is.list(params) &&
+      !is.null(params[[name]])) {
+    return(params[[name]])
+  }
+  default
+}
+
+nRep <- as.integer(get_param("nRep", 50L))
+nChr <- as.integer(get_param("nChr", 1L))
+inbred <- isTRUE(get_param("inbred", FALSE))
+ploidy <- as.integer(get_param("ploidy", 2L))
+nThreads <- as.integer(get_param("nThreads", 1L))
+usePhysicalPositions <- isTRUE(get_param("usePhysicalPositions", TRUE))
+Nref <- as.numeric(get_param("Nref", 10000))
+baseSeed <- as.integer(get_param("baseSeed", 700000L))
+outDir <- as.character(get_param("outDir", "out_phase1_useMacsMut_FALSE"))
+writeTrees <- isTRUE(get_param("writeTrees", TRUE))
+applyPostMut <- isTRUE(get_param("applyPostMut", TRUE))
+mutSeedOffset <- as.integer(get_param("mutSeedOffset", 0L))
+
+if (nRep <= 0L) stop("nRep must be positive.")
+if (nChr <= 0L) stop("nChr must be positive.")
+if (ploidy <= 0L) stop("ploidy must be positive.")
+
+dir.create(outDir, recursive = TRUE, showWarnings = FALSE)
+
+
+

Scenario Set

+
# Keep scenarios connected in multi-pop cases (migration and/or join),
+# so runs always finish.
+scenarios <- list(
+  list(
+    id = 1L,
+    name = "single_const",
+    args = "8 100000 -t 1e-3 -r 1e-4 -s "
+  ),
+  list(
+    id = 2L,
+    name = "single_eN",
+    args = "8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s "
+  ),
+  list(
+    id = 3L,
+    name = "I2_migration",
+    args = "8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s "
+  ),
+  # -I 2 4 4 1e-2: two populations, 4+4 sampled, with initial migration.
+  #-en 0.2 2 0.5: pop 2 becomes smaller at time 0.2.
+  #-ej 1.0 2 1: at time 1.0, pop 2 joins pop 1 backward (equivalent to a forward split).
+  list(
+    id = 4L,
+    name = "I2_en_join",
+    args = "8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s "
+  )
+)
+
+scenario_df <- do.call(
+  rbind,
+  lapply(scenarios, function(s) data.frame(id = s$id, name = s$name, args = s$args))
+)
+scenario_df
+
##   id         name
+## 1  1 single_const
+## 2  2    single_eN
+## 3  3 I2_migration
+## 4  4   I2_en_join
+##                                                                   args
+## 1                                         8 100000 -t 1e-3 -r 1e-4 -s 
+## 2                 8 100000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 1.0 0.5 -s 
+## 3  8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -ej 1.0 2 1 -s 
+## 4 8 100000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s
+
+
+

Helpers

+
make_seed_vec <- function(scenario_id, rep_id, nChr, baseSeed) {
+  # Deterministic integer seed vector, one seed per chromosome.
+  as.integer(baseSeed + scenario_id * 100000L + rep_id * 1000L + seq_len(nChr) - 1L)
+}
+
+parse_dTheta <- function(args) {
+  tok <- strsplit(as.character(args), "[,[:space:]]+", perl = TRUE)[[1L]]
+  tok <- tok[nzchar(tok)]
+  if (length(tok) < 2L) stop("args must include sample size and sequence length.")
+  seqLen <- as.numeric(tok[2L])
+  if (!is.finite(seqLen) || seqLen <= 0) stop("Invalid sequence length in args.")
+  i_t <- match("-t", tok)
+  if (is.na(i_t) || i_t >= length(tok)) return(0)
+  tval <- as.numeric(tok[i_t + 1L])
+  if (!is.finite(tval) || tval < 0) stop("Invalid -t value in args.")
+  seqLen * tval
+}
+
+run_one <- function(sc, rep_id) {
+  seed_vec <- make_seed_vec(sc$id, rep_id, nChr, baseSeed)
+  dTheta <- parse_dTheta(sc$args)
+  mut_seed_vec <- as.integer(seed_vec + mutSeedOffset)
+
+  out <- AlphaSimR:::MaCSTS(
+    args = sc$args,
+    nChr = nChr,
+    inbred = inbred,
+    ploidy = ploidy,
+    nThreads = nThreads,
+    seed = seed_vec,
+    usePhysicalPositions = usePhysicalPositions,
+    useMacsMut = FALSE,
+    Nref = Nref
+  )
+  timeScale <- as.numeric(out$timeScale)
+  if (!is.finite(timeScale) || timeScale <= 0) {
+    stop("Invalid timeScale returned by MaCSTS.")
+  }
+  # MaCS dTheta is in coalescent-time units.
+  # If MaCSTS times were rescaled (e.g., to generations), adjust theta accordingly.
+  dTheta_post <- dTheta / timeScale
+  # Legacy MaCS run with identical args/seeds for mutation-count reference.
+  macs <- AlphaSimR:::MaCS(
+    args = sc$args,
+    maxSites = rep(0L, nChr),
+    inbred = inbred,
+    ploidy = ploidy,
+    nThreads = nThreads,
+    seed = seed_vec
+  )
+
+  rows <- vector("list", nChr)
+  for (chr in seq_len(nChr)) {
+    tc_xptr <- out$tables[[chr]]
+    if (applyPostMut && dTheta_post > 0) {
+      AlphaSimR:::tsMutateTableCollection(tc_xptr, dTheta_post, as.numeric(mut_seed_vec[chr]))
+    }
+    tc <- RcppTskit::TableCollection$new(xptr = tc_xptr)
+    ts <- tc$tree_sequence()
+    tc_summary <- AlphaSimR:::rtsk_table_collection_summary2(tc_xptr)
+
+    tree_path <- NA_character_
+    if (writeTrees) {
+      tree_path <- file.path(
+        outDir,
+        sprintf("%s_rep%02d_chr%02d.trees", sc$name, rep_id, chr)
+      )
+      ts$write(tree_path)
+    }
+
+    rows[[chr]] <- data.frame(
+      scenario_id = sc$id,
+      scenario = sc$name,
+      rep = rep_id,
+      chr = chr,
+      args = sc$args,
+      seed_chr = seed_vec[chr],
+      mut_seed_chr = mut_seed_vec[chr],
+      dTheta = dTheta,
+      dTheta_post = dTheta_post,
+      usePhysicalPositions = usePhysicalPositions,
+      Nref = Nref,
+      macs_num_mutations = as.numeric(length(macs$genMap[[chr]])),
+      macsts_num_mutations = as.numeric(tc_summary$num_mutations),
+      tree_path = tree_path,
+      stringsAsFactors = FALSE
+    )
+  }
+
+  do.call(rbind, rows)
+}
+
+
+

Run Replicates

+
manifest_rows <- vector("list", length(scenarios) * nRep)
+status_rows <- vector("list", length(scenarios) * nRep)
+k <- 0L
+
+for (sc in scenarios) {
+  for (rep_id in seq_len(nRep)) {
+    k <- k + 1L
+    run_label <- sprintf("%s rep%02d", sc$name, rep_id)
+    cat("Running:", run_label, "\n")
+
+    err_msg <- NA_character_
+    one <- tryCatch(
+      run_one(sc, rep_id),
+      error = function(e) {
+        err_msg <<- conditionMessage(e)
+        NULL
+      }
+    )
+
+    manifest_rows[[k]] <- one
+    status_rows[[k]] <- data.frame(
+      scenario_id = sc$id,
+      scenario = sc$name,
+      rep = rep_id,
+      success = !is.null(one),
+      error = ifelse(is.na(err_msg), "", err_msg),
+      stringsAsFactors = FALSE
+    )
+  }
+}
+
## Running: single_const rep01 
+## Running: single_const rep02 
+## Running: single_const rep03 
+## Running: single_const rep04 
+## Running: single_const rep05 
+## Running: single_const rep06 
+## Running: single_const rep07 
+## Running: single_const rep08 
+## Running: single_const rep09 
+## Running: single_const rep10 
+## Running: single_const rep11 
+## Running: single_const rep12 
+## Running: single_const rep13 
+## Running: single_const rep14 
+## Running: single_const rep15 
+## Running: single_const rep16 
+## Running: single_const rep17 
+## Running: single_const rep18 
+## Running: single_const rep19 
+## Running: single_const rep20 
+## Running: single_const rep21 
+## Running: single_const rep22 
+## Running: single_const rep23 
+## Running: single_const rep24 
+## Running: single_const rep25 
+## Running: single_const rep26 
+## Running: single_const rep27 
+## Running: single_const rep28 
+## Running: single_const rep29 
+## Running: single_const rep30 
+## Running: single_const rep31 
+## Running: single_const rep32 
+## Running: single_const rep33 
+## Running: single_const rep34 
+## Running: single_const rep35 
+## Running: single_const rep36 
+## Running: single_const rep37 
+## Running: single_const rep38 
+## Running: single_const rep39 
+## Running: single_const rep40 
+## Running: single_const rep41 
+## Running: single_const rep42 
+## Running: single_const rep43 
+## Running: single_const rep44 
+## Running: single_const rep45 
+## Running: single_const rep46 
+## Running: single_const rep47 
+## Running: single_const rep48 
+## Running: single_const rep49 
+## Running: single_const rep50 
+## Running: single_eN rep01 
+## Running: single_eN rep02 
+## Running: single_eN rep03 
+## Running: single_eN rep04 
+## Running: single_eN rep05 
+## Running: single_eN rep06 
+## Running: single_eN rep07 
+## Running: single_eN rep08 
+## Running: single_eN rep09 
+## Running: single_eN rep10 
+## Running: single_eN rep11 
+## Running: single_eN rep12 
+## Running: single_eN rep13 
+## Running: single_eN rep14 
+## Running: single_eN rep15 
+## Running: single_eN rep16 
+## Running: single_eN rep17 
+## Running: single_eN rep18 
+## Running: single_eN rep19 
+## Running: single_eN rep20 
+## Running: single_eN rep21 
+## Running: single_eN rep22 
+## Running: single_eN rep23 
+## Running: single_eN rep24 
+## Running: single_eN rep25 
+## Running: single_eN rep26 
+## Running: single_eN rep27 
+## Running: single_eN rep28 
+## Running: single_eN rep29 
+## Running: single_eN rep30 
+## Running: single_eN rep31 
+## Running: single_eN rep32 
+## Running: single_eN rep33 
+## Running: single_eN rep34 
+## Running: single_eN rep35 
+## Running: single_eN rep36 
+## Running: single_eN rep37 
+## Running: single_eN rep38 
+## Running: single_eN rep39 
+## Running: single_eN rep40 
+## Running: single_eN rep41 
+## Running: single_eN rep42 
+## Running: single_eN rep43 
+## Running: single_eN rep44 
+## Running: single_eN rep45 
+## Running: single_eN rep46 
+## Running: single_eN rep47 
+## Running: single_eN rep48 
+## Running: single_eN rep49 
+## Running: single_eN rep50 
+## Running: I2_migration rep01 
+## Running: I2_migration rep02 
+## Running: I2_migration rep03 
+## Running: I2_migration rep04 
+## Running: I2_migration rep05 
+## Running: I2_migration rep06 
+## Running: I2_migration rep07 
+## Running: I2_migration rep08 
+## Running: I2_migration rep09 
+## Running: I2_migration rep10 
+## Running: I2_migration rep11 
+## Running: I2_migration rep12 
+## Running: I2_migration rep13 
+## Running: I2_migration rep14 
+## Running: I2_migration rep15 
+## Running: I2_migration rep16 
+## Running: I2_migration rep17 
+## Running: I2_migration rep18 
+## Running: I2_migration rep19 
+## Running: I2_migration rep20 
+## Running: I2_migration rep21 
+## Running: I2_migration rep22 
+## Running: I2_migration rep23 
+## Running: I2_migration rep24 
+## Running: I2_migration rep25 
+## Running: I2_migration rep26 
+## Running: I2_migration rep27 
+## Running: I2_migration rep28 
+## Running: I2_migration rep29 
+## Running: I2_migration rep30 
+## Running: I2_migration rep31 
+## Running: I2_migration rep32 
+## Running: I2_migration rep33 
+## Running: I2_migration rep34 
+## Running: I2_migration rep35 
+## Running: I2_migration rep36 
+## Running: I2_migration rep37 
+## Running: I2_migration rep38 
+## Running: I2_migration rep39 
+## Running: I2_migration rep40 
+## Running: I2_migration rep41 
+## Running: I2_migration rep42 
+## Running: I2_migration rep43 
+## Running: I2_migration rep44 
+## Running: I2_migration rep45 
+## Running: I2_migration rep46 
+## Running: I2_migration rep47 
+## Running: I2_migration rep48 
+## Running: I2_migration rep49 
+## Running: I2_migration rep50 
+## Running: I2_en_join rep01 
+## Running: I2_en_join rep02 
+## Running: I2_en_join rep03 
+## Running: I2_en_join rep04 
+## Running: I2_en_join rep05 
+## Running: I2_en_join rep06 
+## Running: I2_en_join rep07 
+## Running: I2_en_join rep08 
+## Running: I2_en_join rep09 
+## Running: I2_en_join rep10 
+## Running: I2_en_join rep11 
+## Running: I2_en_join rep12 
+## Running: I2_en_join rep13 
+## Running: I2_en_join rep14 
+## Running: I2_en_join rep15 
+## Running: I2_en_join rep16 
+## Running: I2_en_join rep17 
+## Running: I2_en_join rep18 
+## Running: I2_en_join rep19 
+## Running: I2_en_join rep20 
+## Running: I2_en_join rep21 
+## Running: I2_en_join rep22 
+## Running: I2_en_join rep23 
+## Running: I2_en_join rep24 
+## Running: I2_en_join rep25 
+## Running: I2_en_join rep26 
+## Running: I2_en_join rep27 
+## Running: I2_en_join rep28 
+## Running: I2_en_join rep29 
+## Running: I2_en_join rep30 
+## Running: I2_en_join rep31 
+## Running: I2_en_join rep32 
+## Running: I2_en_join rep33 
+## Running: I2_en_join rep34 
+## Running: I2_en_join rep35 
+## Running: I2_en_join rep36 
+## Running: I2_en_join rep37 
+## Running: I2_en_join rep38 
+## Running: I2_en_join rep39 
+## Running: I2_en_join rep40 
+## Running: I2_en_join rep41 
+## Running: I2_en_join rep42 
+## Running: I2_en_join rep43 
+## Running: I2_en_join rep44 
+## Running: I2_en_join rep45 
+## Running: I2_en_join rep46 
+## Running: I2_en_join rep47 
+## Running: I2_en_join rep48 
+## Running: I2_en_join rep49 
+## Running: I2_en_join rep50
+
manifest_df <- do.call(rbind, Filter(Negate(is.null), manifest_rows))
+if (is.null(manifest_df)) manifest_df <- data.frame()
+run_status_df <- do.call(rbind, status_rows)
+
+run_status_df
+
##     scenario_id     scenario rep success error
+## 1             1 single_const   1    TRUE      
+## 2             1 single_const   2    TRUE      
+## 3             1 single_const   3    TRUE      
+## 4             1 single_const   4    TRUE      
+## 5             1 single_const   5    TRUE      
+## 6             1 single_const   6    TRUE      
+## 7             1 single_const   7    TRUE      
+## 8             1 single_const   8    TRUE      
+## 9             1 single_const   9    TRUE      
+## 10            1 single_const  10    TRUE      
+## 11            1 single_const  11    TRUE      
+## 12            1 single_const  12    TRUE      
+## 13            1 single_const  13    TRUE      
+## 14            1 single_const  14    TRUE      
+## 15            1 single_const  15    TRUE      
+## 16            1 single_const  16    TRUE      
+## 17            1 single_const  17    TRUE      
+## 18            1 single_const  18    TRUE      
+## 19            1 single_const  19    TRUE      
+## 20            1 single_const  20    TRUE      
+## 21            1 single_const  21    TRUE      
+## 22            1 single_const  22    TRUE      
+## 23            1 single_const  23    TRUE      
+## 24            1 single_const  24    TRUE      
+## 25            1 single_const  25    TRUE      
+## 26            1 single_const  26    TRUE      
+## 27            1 single_const  27    TRUE      
+## 28            1 single_const  28    TRUE      
+## 29            1 single_const  29    TRUE      
+## 30            1 single_const  30    TRUE      
+## 31            1 single_const  31    TRUE      
+## 32            1 single_const  32    TRUE      
+## 33            1 single_const  33    TRUE      
+## 34            1 single_const  34    TRUE      
+## 35            1 single_const  35    TRUE      
+## 36            1 single_const  36    TRUE      
+## 37            1 single_const  37    TRUE      
+## 38            1 single_const  38    TRUE      
+## 39            1 single_const  39    TRUE      
+## 40            1 single_const  40    TRUE      
+## 41            1 single_const  41    TRUE      
+## 42            1 single_const  42    TRUE      
+## 43            1 single_const  43    TRUE      
+## 44            1 single_const  44    TRUE      
+## 45            1 single_const  45    TRUE      
+## 46            1 single_const  46    TRUE      
+## 47            1 single_const  47    TRUE      
+## 48            1 single_const  48    TRUE      
+## 49            1 single_const  49    TRUE      
+## 50            1 single_const  50    TRUE      
+## 51            2    single_eN   1    TRUE      
+## 52            2    single_eN   2    TRUE      
+## 53            2    single_eN   3    TRUE      
+## 54            2    single_eN   4    TRUE      
+## 55            2    single_eN   5    TRUE      
+## 56            2    single_eN   6    TRUE      
+## 57            2    single_eN   7    TRUE      
+## 58            2    single_eN   8    TRUE      
+## 59            2    single_eN   9    TRUE      
+## 60            2    single_eN  10    TRUE      
+## 61            2    single_eN  11    TRUE      
+## 62            2    single_eN  12    TRUE      
+## 63            2    single_eN  13    TRUE      
+## 64            2    single_eN  14    TRUE      
+## 65            2    single_eN  15    TRUE      
+## 66            2    single_eN  16    TRUE      
+## 67            2    single_eN  17    TRUE      
+## 68            2    single_eN  18    TRUE      
+## 69            2    single_eN  19    TRUE      
+## 70            2    single_eN  20    TRUE      
+## 71            2    single_eN  21    TRUE      
+## 72            2    single_eN  22    TRUE      
+## 73            2    single_eN  23    TRUE      
+## 74            2    single_eN  24    TRUE      
+## 75            2    single_eN  25    TRUE      
+## 76            2    single_eN  26    TRUE      
+## 77            2    single_eN  27    TRUE      
+## 78            2    single_eN  28    TRUE      
+## 79            2    single_eN  29    TRUE      
+## 80            2    single_eN  30    TRUE      
+## 81            2    single_eN  31    TRUE      
+## 82            2    single_eN  32    TRUE      
+## 83            2    single_eN  33    TRUE      
+## 84            2    single_eN  34    TRUE      
+## 85            2    single_eN  35    TRUE      
+## 86            2    single_eN  36    TRUE      
+## 87            2    single_eN  37    TRUE      
+## 88            2    single_eN  38    TRUE      
+## 89            2    single_eN  39    TRUE      
+## 90            2    single_eN  40    TRUE      
+## 91            2    single_eN  41    TRUE      
+## 92            2    single_eN  42    TRUE      
+## 93            2    single_eN  43    TRUE      
+## 94            2    single_eN  44    TRUE      
+## 95            2    single_eN  45    TRUE      
+## 96            2    single_eN  46    TRUE      
+## 97            2    single_eN  47    TRUE      
+## 98            2    single_eN  48    TRUE      
+## 99            2    single_eN  49    TRUE      
+## 100           2    single_eN  50    TRUE      
+## 101           3 I2_migration   1    TRUE      
+## 102           3 I2_migration   2    TRUE      
+## 103           3 I2_migration   3    TRUE      
+## 104           3 I2_migration   4    TRUE      
+## 105           3 I2_migration   5    TRUE      
+## 106           3 I2_migration   6    TRUE      
+## 107           3 I2_migration   7    TRUE      
+## 108           3 I2_migration   8    TRUE      
+## 109           3 I2_migration   9    TRUE      
+## 110           3 I2_migration  10    TRUE      
+## 111           3 I2_migration  11    TRUE      
+## 112           3 I2_migration  12    TRUE      
+## 113           3 I2_migration  13    TRUE      
+## 114           3 I2_migration  14    TRUE      
+## 115           3 I2_migration  15    TRUE      
+## 116           3 I2_migration  16    TRUE      
+## 117           3 I2_migration  17    TRUE      
+## 118           3 I2_migration  18    TRUE      
+## 119           3 I2_migration  19    TRUE      
+## 120           3 I2_migration  20    TRUE      
+## 121           3 I2_migration  21    TRUE      
+## 122           3 I2_migration  22    TRUE      
+## 123           3 I2_migration  23    TRUE      
+## 124           3 I2_migration  24    TRUE      
+## 125           3 I2_migration  25    TRUE      
+## 126           3 I2_migration  26    TRUE      
+## 127           3 I2_migration  27    TRUE      
+## 128           3 I2_migration  28    TRUE      
+## 129           3 I2_migration  29    TRUE      
+## 130           3 I2_migration  30    TRUE      
+## 131           3 I2_migration  31    TRUE      
+## 132           3 I2_migration  32    TRUE      
+## 133           3 I2_migration  33    TRUE      
+## 134           3 I2_migration  34    TRUE      
+## 135           3 I2_migration  35    TRUE      
+## 136           3 I2_migration  36    TRUE      
+## 137           3 I2_migration  37    TRUE      
+## 138           3 I2_migration  38    TRUE      
+## 139           3 I2_migration  39    TRUE      
+## 140           3 I2_migration  40    TRUE      
+## 141           3 I2_migration  41    TRUE      
+## 142           3 I2_migration  42    TRUE      
+## 143           3 I2_migration  43    TRUE      
+## 144           3 I2_migration  44    TRUE      
+## 145           3 I2_migration  45    TRUE      
+## 146           3 I2_migration  46    TRUE      
+## 147           3 I2_migration  47    TRUE      
+## 148           3 I2_migration  48    TRUE      
+## 149           3 I2_migration  49    TRUE      
+## 150           3 I2_migration  50    TRUE      
+## 151           4   I2_en_join   1    TRUE      
+## 152           4   I2_en_join   2    TRUE      
+## 153           4   I2_en_join   3    TRUE      
+## 154           4   I2_en_join   4    TRUE      
+## 155           4   I2_en_join   5    TRUE      
+## 156           4   I2_en_join   6    TRUE      
+## 157           4   I2_en_join   7    TRUE      
+## 158           4   I2_en_join   8    TRUE      
+## 159           4   I2_en_join   9    TRUE      
+## 160           4   I2_en_join  10    TRUE      
+## 161           4   I2_en_join  11    TRUE      
+## 162           4   I2_en_join  12    TRUE      
+## 163           4   I2_en_join  13    TRUE      
+## 164           4   I2_en_join  14    TRUE      
+## 165           4   I2_en_join  15    TRUE      
+## 166           4   I2_en_join  16    TRUE      
+## 167           4   I2_en_join  17    TRUE      
+## 168           4   I2_en_join  18    TRUE      
+## 169           4   I2_en_join  19    TRUE      
+## 170           4   I2_en_join  20    TRUE      
+## 171           4   I2_en_join  21    TRUE      
+## 172           4   I2_en_join  22    TRUE      
+## 173           4   I2_en_join  23    TRUE      
+## 174           4   I2_en_join  24    TRUE      
+## 175           4   I2_en_join  25    TRUE      
+## 176           4   I2_en_join  26    TRUE      
+## 177           4   I2_en_join  27    TRUE      
+## 178           4   I2_en_join  28    TRUE      
+## 179           4   I2_en_join  29    TRUE      
+## 180           4   I2_en_join  30    TRUE      
+## 181           4   I2_en_join  31    TRUE      
+## 182           4   I2_en_join  32    TRUE      
+## 183           4   I2_en_join  33    TRUE      
+## 184           4   I2_en_join  34    TRUE      
+## 185           4   I2_en_join  35    TRUE      
+## 186           4   I2_en_join  36    TRUE      
+## 187           4   I2_en_join  37    TRUE      
+## 188           4   I2_en_join  38    TRUE      
+## 189           4   I2_en_join  39    TRUE      
+## 190           4   I2_en_join  40    TRUE      
+## 191           4   I2_en_join  41    TRUE      
+## 192           4   I2_en_join  42    TRUE      
+## 193           4   I2_en_join  43    TRUE      
+## 194           4   I2_en_join  44    TRUE      
+## 195           4   I2_en_join  45    TRUE      
+## 196           4   I2_en_join  46    TRUE      
+## 197           4   I2_en_join  47    TRUE      
+## 198           4   I2_en_join  48    TRUE      
+## 199           4   I2_en_join  49    TRUE      
+## 200           4   I2_en_join  50    TRUE
+
+
+

Mutation Count Check (MaCS vs MaCSTS ancestry-only)

+

Per-replicate mutation counts are not expected to be identical +because legacy MaCS mutates during local-tree simulation, while post-TS +mutates on the recorded edge tables with its own RNG stream. However, +the mutation count distributions should be similar, and the mean +difference should be small relative to the mean mutation count. The +mut_stats table summarizes these comparisons per +scenario.

+
if (nrow(manifest_df) == 0L) {
+  stop("No successful runs. Check run_status_df$error.")
+}
+
+mut_stats <- do.call(
+  rbind,
+  lapply(split(manifest_df, manifest_df$scenario), function(d) {
+    delta <- d$macs_num_mutations - d$macsts_num_mutations
+
+    sd_macs   <- sd(d$macs_num_mutations, na.rm = TRUE)
+    sd_macsts <- sd(d$macsts_num_mutations, na.rm = TRUE)
+    sd_delta  <- sd(delta, na.rm = TRUE)
+
+    data.frame(
+      scenario        = d$scenario[1],
+      n               = nrow(d),
+      macs_mut_mean   = mean(d$macs_num_mutations, na.rm = TRUE),
+      macs_mut_sd     = sd_macs,
+      macsts_mut_mean = mean(d$macsts_num_mutations, na.rm = TRUE),
+      macsts_mut_sd   = sd_macsts,
+      mut_diff_mean   = mean(delta, na.rm = TRUE),
+      mut_diff_sd     = sd_delta,
+      rel_diff        = mean(delta, na.rm = TRUE) /
+                          mean(d$macs_num_mutations, na.rm = TRUE),
+      stringsAsFactors = FALSE
+    )
+  })
+)
+mut_stats
+
##                  scenario  n macs_mut_mean macs_mut_sd macsts_mut_mean
+## I2_en_join     I2_en_join 50        496.40    77.10237          480.16
+## I2_migration I2_migration 50        519.28    61.59149          513.06
+## single_const single_const 50        252.06    80.24183          253.70
+## single_eN       single_eN 50        319.62    92.49355          309.74
+##              macsts_mut_sd mut_diff_mean mut_diff_sd     rel_diff
+## I2_en_join        72.67972         16.24    96.26485  0.032715552
+## I2_migration      64.81698          6.22    80.62214  0.011978124
+## single_const      57.57914         -1.64    88.69847 -0.006506387
+## single_eN         86.54592          9.88    88.13756  0.030911708
+
library(dplyr)
+library(tidyr)
+library(ggplot2)
+plot_df <- mut_stats %>%
+    select(scenario, macs_mut_mean, macs_mut_sd, macsts_mut_mean, macsts_mut_sd) %>%
+    pivot_longer(
+        cols = -scenario,
+        names_to = c("method", ".value"),
+        names_pattern = "(macs|macsts)_mut_(mean|sd)"
+    ) %>%
+    mutate(method = recode(method, macs = "MaCS", macsts = "MaCSTS"))
+
+ggplot(plot_df, aes(x = scenario, y = mean, fill = method)) +
+    geom_col(position = position_dodge(width = 0.8), width = 0.7) +
+    geom_errorbar(
+        aes(ymin = mean - sd, ymax = mean + sd),
+        position = position_dodge(width = 0.8),
+        width = 0.2
+    ) +
+    labs(x = "Scenario", y = "Mean # mutations", fill = "Method") +
+    theme_bw()
+

+
+
+

Save Outputs

+
manifest_csv_path <- file.path(outDir, "phase1_macsTS_useMacsMut_FALSE_manifest.csv")
+status_csv_path <- file.path(outDir, "phase1_macsTS_useMacsMut_FALSE_run_status.csv")
+
+write.csv(manifest_df, manifest_csv_path, row.names = FALSE)
+write.csv(run_status_df, status_csv_path, row.names = FALSE)
+
+cat("Saved manifest CSV:", manifest_csv_path, "\n")
+
## Saved manifest CSV: testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_manifest.csv
+
cat("Saved run status CSV:", status_csv_path, "\n")
+
## Saved run status CSV: testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_run_status.csv
+
if (writeTrees) {
+  cat("Saved .trees files under:", outDir, "\n")
+}
+
## Saved .trees files under: testData/out_phase1_useMacsMut_FALSE
+
+
+

Next Step

+

Convert the parameters and use them to run simulations with msprime. +Then we can compare the distributions on number of trees, edges, nodes, +mutations and tree heights.

+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/dev/testMaCSTS3.Rmd b/dev/testMaCSTS3.Rmd new file mode 100644 index 00000000..0db1ada4 --- /dev/null +++ b/dev/testMaCSTS3.Rmd @@ -0,0 +1,157 @@ +--- +title: "test MaCSTS 3" +output: html_document +date: "2026-06-08" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) +``` + +## General Notes + +This notebook follows `testMaCSTS2.Rmd` outputs and then: + +1. runs `msprime_from_macs_scenarios.py` to generate msprime `.trees` and manifest; +2. runs `msprime_macs_scenarios_compare.py` to build a combined long table; +3. compares distributions across methods (`macs`, `macsTS`, `msprime`). + +These tests are important because `MaCSTS` and the msprime bridge both rely on +multiple unit conversions (tests on more scenarios are welcome!): + +- sequence length; +- time unit conversion (coalescent-scaled time vs generations); +- mutation and recombination rate conversions; +- migration parameter conversions (global vs pairwise); +- sample-count mapping when ploidy changes. + +The goal here is not exact replicate-by-replicate identity with msprime, but to +check that scenario-level distributions (mutations, trees, edges, nodes, and +root times) are consistent after these conversions. + +Current order in MaCSTS when `useMacsMut = FALSE`: + +1. During `buildTs()`, local trees are generated along the chromosome and each + interval is recorded to TS edge/node tables (`recordTreeInterval`). +2. No MaCS mutation placement happens in this step (`addMutationsTs` is skipped). +3. At the end of `buildTs()`, ancestry is simplified (`TsRecorder::simplify`). +4. On `release()`, times are rescaled (if `Nref` was provided), then tables are + sorted and indexed. +5. Post-TS mutation (if requested) is applied later by `simMut()` / + `tsMutateTableCollection()` on the already simplified/rescaled ancestry. +6. Inbred leaf expansion is optional and can be deferred to + `finalizeInbredTs()` (this is what `simAnc(..., expandInbredSamples = FALSE)` + does in the staged workflow). + +```{r paths} +find_dev_dir <- function() { + if (file.exists("msprime_from_macs_scenarios.py")) return(normalizePath(".", winslash = "/")) + if (file.exists("dev/msprime_from_macs_scenarios.py")) return(normalizePath("dev", winslash = "/")) + stop("Cannot find dev directory containing msprime_from_macs_scenarios.py") +} + +dev_dir <- find_dev_dir() +py_sim_script <- file.path(dev_dir, "msprime_from_macs_scenarios.py") +py_cmp_script <- file.path(dev_dir, "msprime_macs_scenarios_compare.py") + +macsts_manifest <- file.path(dev_dir, "testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_manifest.csv") +msprime_manifest <- file.path(dev_dir, "testData/out_msprime_from_macs/msprime_manifest.csv") +comparison_long_csv <- file.path(dev_dir, "testData/method_comparison_long.csv") + +stopifnot(file.exists(py_sim_script)) +stopifnot(file.exists(py_cmp_script)) +stopifnot(file.exists(macsts_manifest)) +``` + +## Run Python Scripts + +```{r run-python} +run_python_script <- function(dev_dir, script_name, args = character()) { + # Use your own path here! + py <- '/usr/bin/python3' + + old <- getwd() + on.exit(setwd(old), add = TRUE) + setwd(dev_dir) + status <- system2(py, args = c(script_name, args)) + if (!identical(status, 0L)) stop("Failed to run ", script_name, " (exit status ", status, ")") +} + +# 1) Generate msprime replicates + manifest. +# Conversion details implemented in msprime_from_macs_scenarios.py: +# - seq length: token 2nd in MaCS args is passed to msprime sequence_length. +# - time: MaCS scaled times are converted to generations by t_gen = t * 4 * Nref. +# - recombination: rec_rate_bp = r / (4 * Nref). +# - mutation: mut_rate_bp = theta / (4 * Nref), then applied via sim_mutations(). +# - migration: +# global M -> pairwise m_ij = M / ((k-1) * 4 * Nref) for k populations; +# pair Mij -> m_ij = Mij / (4 * Nref). +# - samples/ploidy: +# script currently runs msprime with ploidy=2, so MaCS haploid sample counts +# per population are halved (must be even) before passing to `samples=`. +run_python_script( + dev_dir = dev_dir, + script_name = basename(py_sim_script), + args = c( + "--nrep", "50", + "--nchr", "1", + "--nref", "10000", + "--base-seed", "700000", + "--model", "smc_prime", + "--out-dir", "testData/out_msprime_from_macs" + ) +) + +# 2) Build cross-method comparison summary + long table. +# msprime_macs_scenarios_compare.py reads: +# - MaCSTS manifest (from testMaCSTS2), +# - msprime manifest (from step 1), +# and writes a long-format table used below for distribution plots. +run_python_script( + dev_dir = dev_dir, + script_name = basename(py_cmp_script) +) +``` + +## Distribution Comparison Plots + +```{r read-table} +stopifnot(file.exists(comparison_long_csv)) +cmp <- read.csv(comparison_long_csv, stringsAsFactors = FALSE) + + +num_cols <- c("num_mut", "num_trees", "num_edges", "num_nodes", "max_root_time") +for (nm in num_cols) { + cmp[[nm]] <- suppressWarnings(as.numeric(cmp[[nm]])) +} + +library(dplyr) +library(tidyr) +library(ggplot2) + +metrics <- c("num_mut", "num_trees", "num_edges", "num_nodes", "max_root_time") + +long_df <- cmp %>% + pivot_longer(cols = all_of(metrics), names_to = "metric", values_to = "value") %>% + filter(!is.na(value)) + +# Mean + SD bars by scenario/method for each metric +summary_df <- long_df %>% + group_by(Scenarios, Methods, metric) %>% + summarise(mean = mean(value), sd = sd(value), .groups = "drop") + +ggplot(summary_df, aes(x = Scenarios, y = mean, fill = Methods)) + + geom_col(position = position_dodge(width = 0.8), width = 0.7) + + geom_errorbar( + aes(ymin = mean - sd, ymax = mean + sd), + position = position_dodge(width = 0.8), + width = 0.2 + ) + + facet_wrap(~ metric, scales = "free_y") + + labs(x = "Scenario", y = "Mean +/- SD", fill = "Method") + + theme_bw()+ + theme( + axis.text.x = element_text(angle = 45, hjust = 1, size = 8) + ) + +``` diff --git a/dev/testMaCSTS3.html b/dev/testMaCSTS3.html new file mode 100644 index 00000000..4bfd7949 --- /dev/null +++ b/dev/testMaCSTS3.html @@ -0,0 +1,557 @@ + + + + + + + + + + + + + + +test MaCSTS 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
+

General Notes

+

This notebook follows testMaCSTS2.Rmd outputs and +then:

+
    +
  1. runs msprime_from_macs_scenarios.py to generate msprime +.trees and manifest;
  2. +
  3. runs msprime_macs_scenarios_compare.py to build a +combined long table;
  4. +
  5. compares distributions across methods (macs, +macsTS, msprime).
  6. +
+

These tests are important because MaCSTS and the msprime +bridge both rely on multiple unit conversions (tests on more scenarios +are welcome!):

+
    +
  • sequence length;
  • +
  • time unit conversion (coalescent-scaled time vs generations);
  • +
  • mutation and recombination rate conversions;
  • +
  • migration parameter conversions (global vs pairwise);
  • +
  • sample-count mapping when ploidy changes.
  • +
+

The goal here is not exact replicate-by-replicate identity with +msprime, but to check that scenario-level distributions (mutations, +trees, edges, nodes, and root times) are consistent after these +conversions.

+

Current order in MaCSTS when useMacsMut = FALSE:

+
    +
  1. During buildTs(), local trees are generated along the +chromosome and each interval is recorded to TS edge/node tables +(recordTreeInterval).
  2. +
  3. No MaCS mutation placement happens in this step +(addMutationsTs is skipped).
  4. +
  5. At the end of buildTs(), ancestry is simplified +(TsRecorder::simplify).
  6. +
  7. On release(), times are rescaled (if Nref +was provided), then tables are sorted and indexed.
  8. +
  9. Post-TS mutation (if requested) is applied later by +simMut() / tsMutateTableCollection() on the +already simplified/rescaled ancestry.
  10. +
  11. Inbred leaf expansion is optional and can be deferred to +finalizeInbredTs() (this is what +simAnc(..., expandInbredSamples = FALSE) does in the staged +workflow).
  12. +
+
find_dev_dir <- function() {
+  if (file.exists("msprime_from_macs_scenarios.py")) return(normalizePath(".", winslash = "/"))
+  if (file.exists("dev/msprime_from_macs_scenarios.py")) return(normalizePath("dev", winslash = "/"))
+  stop("Cannot find dev directory containing msprime_from_macs_scenarios.py")
+}
+
+dev_dir <- find_dev_dir()
+py_sim_script <- file.path(dev_dir, "msprime_from_macs_scenarios.py")
+py_cmp_script <- file.path(dev_dir, "msprime_macs_scenarios_compare.py")
+
+macsts_manifest <- file.path(dev_dir, "testData/out_phase1_useMacsMut_FALSE/phase1_macsTS_useMacsMut_FALSE_manifest.csv")
+msprime_manifest <- file.path(dev_dir, "testData/out_msprime_from_macs/msprime_manifest.csv")
+comparison_long_csv <- file.path(dev_dir, "testData/method_comparison_long.csv")
+
+stopifnot(file.exists(py_sim_script))
+stopifnot(file.exists(py_cmp_script))
+stopifnot(file.exists(macsts_manifest))
+
+
+

Run Python Scripts

+
run_python_script <- function(dev_dir, script_name, args = character()) {
+  # Use your own path here!
+  py <- '/usr/bin/python3'
+
+  old <- getwd()
+  on.exit(setwd(old), add = TRUE)
+  setwd(dev_dir)
+  status <- system2(py, args = c(script_name, args))
+  if (!identical(status, 0L)) stop("Failed to run ", script_name, " (exit status ", status, ")")
+}
+
+# 1) Generate msprime replicates + manifest.
+# Conversion details implemented in msprime_from_macs_scenarios.py:
+# - seq length: token 2nd in MaCS args is passed to msprime sequence_length.
+# - time: MaCS scaled times are converted to generations by t_gen = t * 4 * Nref.
+# - recombination: rec_rate_bp = r / (4 * Nref).
+# - mutation: mut_rate_bp = theta / (4 * Nref), then applied via sim_mutations().
+# - migration:
+#     global M  -> pairwise m_ij = M / ((k-1) * 4 * Nref) for k populations;
+#     pair Mij  -> m_ij = Mij / (4 * Nref).
+# - samples/ploidy:
+#     script currently runs msprime with ploidy=2, so MaCS haploid sample counts
+#     per population are halved (must be even) before passing to `samples=`.
+run_python_script(
+  dev_dir = dev_dir,
+  script_name = basename(py_sim_script),
+  args = c(
+    "--nrep", "50",
+    "--nchr", "1",
+    "--nref", "10000",
+    "--base-seed", "700000",
+    "--model", "smc_prime",
+    "--out-dir", "testData/out_msprime_from_macs"
+  )
+)
+
+# 2) Build cross-method comparison summary + long table.
+# msprime_macs_scenarios_compare.py reads:
+# - MaCSTS manifest (from testMaCSTS2),
+# - msprime manifest (from step 1),
+# and writes a long-format table used below for distribution plots.
+run_python_script(
+  dev_dir = dev_dir,
+  script_name = basename(py_cmp_script)
+)
+
+
+

Distribution Comparison Plots

+
stopifnot(file.exists(comparison_long_csv))
+cmp <- read.csv(comparison_long_csv, stringsAsFactors = FALSE)
+
+
+num_cols <- c("num_mut", "num_trees", "num_edges", "num_nodes", "max_root_time")
+for (nm in num_cols) {
+  cmp[[nm]] <- suppressWarnings(as.numeric(cmp[[nm]]))
+}
+
+library(dplyr)
+library(tidyr)
+library(ggplot2)
+
+metrics <- c("num_mut", "num_trees", "num_edges", "num_nodes", "max_root_time")
+
+long_df <- cmp %>%
+  pivot_longer(cols = all_of(metrics), names_to = "metric", values_to = "value") %>%
+  filter(!is.na(value))
+
+# Mean + SD bars by scenario/method for each metric
+summary_df <- long_df %>%
+  group_by(Scenarios, Methods, metric) %>%
+  summarise(mean = mean(value), sd = sd(value), .groups = "drop")
+
+ggplot(summary_df, aes(x = Scenarios, y = mean, fill = Methods)) +
+  geom_col(position = position_dodge(width = 0.8), width = 0.7) +
+  geom_errorbar(
+    aes(ymin = mean - sd, ymax = mean + sd),
+    position = position_dodge(width = 0.8),
+    width = 0.2
+  ) +
+  facet_wrap(~ metric, scales = "free_y") +
+  labs(x = "Scenario", y = "Mean +/- SD", fill = "Method") +
+  theme_bw()+
+  theme(
+    axis.text.x = element_text(angle = 45, hjust = 1, size = 8)
+  )
+

+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/dev/testMaCSTS4.Rmd b/dev/testMaCSTS4.Rmd new file mode 100644 index 00000000..4e491aff --- /dev/null +++ b/dev/testMaCSTS4.Rmd @@ -0,0 +1,367 @@ +--- +title: "test MaCSTS 4: wrapper/staged workflow overview" +output: html_document +date: "2026-06-10" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) +``` + +## General Notes + +This notebook summarizes the current TS workflow design and parameter effects, +based on `testMaCSTS1.Rmd`, `testMaCSTS2.Rmd`, and `testMaCSTS3.Rmd`. + +It starts from the two supported ways to run: + +1. high-level wrapper: `runMacsTS(...)` +2. staged low-level path (for developers and advanced users): `simAnc(...) -> simMut(...) -> finalizeInbredTs(...) -> asMapPop(...)` + +## 1) Two Ways To Run + +### A. High-level wrapper (`runMacsTS`) + +`runMacsTS` is the default user-facing entry point. It is designed to feel like +`runMacs/runMacs2` but with TS-aware internals and mode control. + +- Builds MaCS command from species/manual inputs +- Runs ancestry and mutation according to `mutationMode` +- Converts to `MapPop` (including optional `segSites` sampling) +- Optionally returns TS tables/metadata + +### B. Staged workflow (`simAnc` + `simMut` + ...) + +This path is for development/debugging and explicit control over each stage. + +- `simAnc`: ancestry-only TS from MaCS engine (`useMacsMut=FALSE`) +- `simMut`: post-TS mutation placement on edge table (if `mutationMode="postTs"`) +- `finalizeInbredTs`: optional inbred leaf expansion in TS (if `inbred=TRUE` and `ploidy>1`) +- `asMapPop`: convert TS to `MapPop` (sampling/filtering + map construction) + +## 2) Function Relationship + +```{r relationship-diagram, results='asis'} +cat(" +runMacsTS() + ├─ command builder (species/manual) + ├─ mutationMode = 'macs' -> MaCSTS(..., useMacsMut=TRUE, expandInbredSamples=FALSE) + ├─ mutationMode = 'postTs'-> simAnc(...) -> simMut(...) + ├─ mutationMode = 'none' -> simAnc(...) only (TS-only unless user mutates later) + ├─ optional finalizeInbredTs(...) + └─ asMapPop(...) -> MapPop + +Lower layers: + simAnc() -> MaCSTS(... useMacsMut=FALSE ...) + simMut() -> tsMutateTableCollection(...) per chromosome + finalizeInbredTs() -> tsFinalizeInbredTableCollection(...) per chromosome + MaCSTS() -> C++ simulator + TS recorder +") +``` + +## 3) Core Parameters And Their Effects + +```{r param-table} +param_effects <- data.frame( + parameter = c( + "mutationMode", + "useMacsMut (MaCSTS)", + "usePhysicalPositions", + "Nref", + "segSites", + "inbred + ploidy", + "expandInbredTs", + "seed", + "mutSeed", + "nThreads" + ), + where_used = c( + "runMacsTS", + "MaCSTS", + "MaCSTS/asMapPop", + "MaCSTS (timeScale)", + "asMapPop", + "MaCSTS/asMapPop/finalizeInbredTs", + "runMacsTS/finalizeInbredTs", + "simAnc/MaCSTS ancestry RNG", + "simMut post-TS RNG", + "MaCS chromosomes + asMapPop worker" + ), + main_effect = c( + "Selects mutation path: macs vs postTs vs none", + "Adds MaCS-style mutation during ancestry if TRUE", + "TS coordinates in bp (TRUE) or [0,1] (FALSE)", + "Rescales node/mutation times; sets time_units to generations", + "Caps number of retained variants per chromosome in conversion", + "Controls sample interpretation and output haplotype structure", + "If TRUE with inbred/ploidy>1, duplicates TS sample leaves", + "Determines ancestry reproducibility", + "Determines post-TS mutation reproducibility", + "Parallelism level when available" + ), + stringsAsFactors = FALSE +) +knitr::kable(param_effects) +``` + +## Helpers to Compare Two Ways To Run + +```{r comparison-helpers} +tc_counts <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + data.frame( + num_nodes = as.integer(tc$num_nodes()), + num_edges = as.integer(tc$num_edges()), + num_sites = as.integer(tc$num_sites()), + num_mutations = as.integer(tc$num_mutations()) + ) +} + +collect_ts_counts <- function(tables, method) { + do.call(rbind, lapply(seq_along(tables), function(chr) { + cbind(chr = chr, method = method, tc_counts(tables[[chr]])) + })) +} + +compare_wrapper_vs_staged <- function(out, staged) { + if (!requireNamespace("RcppTskit", quietly = TRUE)) { + stop("RcppTskit is required for TS checks.") + } + if (is.null(out$pop) || is.null(out$tables)) { + stop("out must contain both $pop and $tables") + } + if (is.null(staged$pop) || is.null(staged$tables)) { + stop("staged must contain both $pop and $tables") + } + + ts_counts_wrap <- collect_ts_counts(out$tables, method = "wrapper") + ts_counts_stage <- collect_ts_counts(staged$tables, method = "staged") + ts_counts <- rbind(ts_counts_wrap, ts_counts_stage) + + nChr <- length(out$pop@geno) + same_geno <- vapply(seq_len(nChr), function(chr) { + identical(out$pop@geno[[chr]], staged$pop@geno[[chr]]) + }, logical(1)) + same_genMap <- vapply(seq_len(nChr), function(chr) { + isTRUE(all.equal(out$pop@genMap[[chr]], staged$pop@genMap[[chr]], tolerance = 0)) + }, logical(1)) + same_ts_counts <- identical( + ts_counts_wrap[, c("num_nodes", "num_edges", "num_sites", "num_mutations")], + ts_counts_stage[, c("num_nodes", "num_edges", "num_sites", "num_mutations")] + ) + + checks <- data.frame( + metric = c("nLoci", "geno_all_chr", "genMap_all_chr", "ts_table_counts"), + equal = c( + identical(out$pop@nLoci, staged$pop@nLoci), + all(same_geno), + all(same_genMap), + same_ts_counts + ), + stringsAsFactors = FALSE + ) + + list(ts_counts = ts_counts, checks = checks) +} + +print_wrapper_vs_staged <- function(cmp) { + print(cmp$ts_counts) + print(cmp$checks) + invisible(cmp) +} +``` + +## Minimal Usage Examples + +### A. High-level wrapper mode + +```{r ex-runMacsTS} +library(AlphaSimR) +devtools::load_all() +set.seed(1) +out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = 60, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", # or "macs" / "none" + usePhysicalPositions = FALSE, + nThreads = 1L, + returnTs = TRUE +) + +# runMacsTS returns: +# out$pop -> MapPop +# out$tables -> TS table collections (if returnTs=TRUE) +``` + +### B. Staged mode + +```{r ex-staged} +library(AlphaSimR) + +# use the same args and seeds as high-level wrapper mode +args <- out$args +nChr <- 2L +seed_chr <- out$seed + +anc <- AlphaSimR:::simAnc( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed_chr, + usePhysicalPositions = FALSE, + Nref = NA_real_ +) + +mut <- AlphaSimR:::simMut(anc) # uses anc$dTheta and derived mutation seeds by default + +# Optional for inbred/ploidy expansion in TS: +# mut <- AlphaSimR:::finalizeInbredTs(mut, inbred = TRUE, ploidy = 2L) + +pop <- AlphaSimR:::asMapPop( + chr_info = list( + tables = mut$tables, + breaks = list(c(0, 1)), + rates = list(c(1)) + ), + ploidy = 2L, + inbred = FALSE, + segSites = 60 +) +``` + +## Validation + +### Wrapper vs staged equivalence + +```{r wrapper-vs-staged-equivalence} +# Reuse objects from the previous ection: +# - out : runMacsTS(...) result +# - mut : simMut(...) result from staged path +# - pop : asMapPop(...) result from staged path + +stopifnot(exists("out"), exists("mut"), exists("pop")) +cmp <- compare_wrapper_vs_staged( + out = out, + staged = list( + tables = mut$tables, + pop = pop + ) +) +print_wrapper_vs_staged(cmp) +``` + +### Wrapper vs staged (inbred=TRUE, ploidy>1) + +```{r wrapper-vs-staged-inbred} +# Example: inbred TRUE with ploidy 2 +set.seed(1) +out_inbred <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = 60, + inbred = TRUE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + usePhysicalPositions = TRUE, + expandInbredTs = TRUE, + nThreads = 1L, + returnTs = TRUE, + Nref = 10000 +) + +anc_inbred <- AlphaSimR:::simAnc( + args = out_inbred$args, + nChr = 2L, + inbred = TRUE, + ploidy = 2L, + nThreads = 1L, + seed = out_inbred$seed, + usePhysicalPositions = TRUE, + #Nref = NA_real_, + Nref = 10000 +) +mut_inbred <- AlphaSimR:::simMut(anc_inbred) +fin_inbred <- AlphaSimR:::finalizeInbredTs(mut_inbred, inbred = TRUE, ploidy = 2L) + +pop_inbred <- AlphaSimR:::asMapPop( + chr_info = list( + tables = fin_inbred$tables, + breaks = rep(list(c(0, 1)), 2L), + rates = rep(list(c(1)), 2L) + ), + ploidy = 2L, + inbred = TRUE, + segSites = 60, + site_sampling_seed = 42L, + nThreads = 1L +) + +cmp_inbred <- compare_wrapper_vs_staged( + out = out_inbred, + staged = list( + tables = fin_inbred$tables, + pop = pop_inbred + ) +) +print_wrapper_vs_staged(cmp_inbred) +``` + +Output a ts as an example and check it in Python: +```{r export-inbred-ts} +tables_src <- if (exists("fin_inbred")) { + fin_inbred$tables +} else if (exists("out_inbred")) { + out_inbred$tables +} else { + stop("Need fin_inbred or out_inbred in environment. Run chunk 5.1b first.") +} +# chr1 +tc_xptr <- tables_src[[1]] +tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) +ts <- tc$tree_sequence() +ts$write('testData/inbred_test.trees') +``` + +```{r py-setup} +library(reticulate) +# Use your own path here! +use_python('/usr/bin/python3', required = TRUE) +``` + + +```{python} +import numpy as np +import tskit +ts_inbred = tskit.load('testData/inbred_test.trees') +ts_inbred.samples() + +print(ts_inbred.first().draw_text()) +from IPython.display import display +svg_size = (800, 250) +svg_string = ts_inbred.first().draw_svg( + size=svg_size, time_scale="rank", omit_sites=True, + y_axis=True, y_label=" " # optional: show a time scale on the left +) +with open("tmp_tree.svg", "w") as f: + f.write(svg_string) +print(ts_inbred.tables.nodes[2612:2620]) +print(ts_inbred.tables.nodes[0:4]) + +g_matrix = ts_inbred.genotype_matrix() +for hap in range(0, len(g_matrix[0]), 2): + print(hap, hap+1) + print(np.array_equal(g_matrix[:, hap], g_matrix[:, hap+1])) + +``` +Sampled nodes are duplicated as expected for inbred/ploidy expansion, from nodes 0-3. Each pair of hap (from the same individual) have same alleles. + + +### Parameter sensitivity checks +In tests/testthat/test-runMacsTS-sensitivity.R diff --git a/dev/testMaCSTS4.html b/dev/testMaCSTS4.html new file mode 100644 index 00000000..eeb96490 --- /dev/null +++ b/dev/testMaCSTS4.html @@ -0,0 +1,893 @@ + + + + + + + + + + + + + + +test MaCSTS 4: wrapper/staged workflow overview + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
+

General Notes

+

This notebook summarizes the current TS workflow design and parameter +effects, based on testMaCSTS1.Rmd, +testMaCSTS2.Rmd, and testMaCSTS3.Rmd.

+

It starts from the two supported ways to run:

+
    +
  1. high-level wrapper: runMacsTS(...)
  2. +
  3. staged low-level path (for developers and advanced users): +simAnc(...) -> simMut(...) -> finalizeInbredTs(...) -> asMapPop(...)
  4. +
+
+
+

1) Two Ways To Run

+
+

A. High-level wrapper (runMacsTS)

+

runMacsTS is the default user-facing entry point. It is +designed to feel like runMacs/runMacs2 but with TS-aware +internals and mode control.

+
    +
  • Builds MaCS command from species/manual inputs
  • +
  • Runs ancestry and mutation according to +mutationMode
  • +
  • Converts to MapPop (including optional +segSites sampling)
  • +
  • Optionally returns TS tables/metadata
  • +
+
+
+

B. Staged workflow (simAnc + simMut + +…)

+

This path is for development/debugging and explicit control over each +stage.

+
    +
  • simAnc: ancestry-only TS from MaCS engine +(useMacsMut=FALSE)
  • +
  • simMut: post-TS mutation placement on edge table (if +mutationMode="postTs")
  • +
  • finalizeInbredTs: optional inbred leaf expansion in TS +(if inbred=TRUE and ploidy>1)
  • +
  • asMapPop: convert TS to MapPop +(sampling/filtering + map construction)
  • +
+
+
+
+

2) Function Relationship

+
cat("
+runMacsTS()
+  ├─ command builder (species/manual)
+  ├─ mutationMode = 'macs'  -> MaCSTS(..., useMacsMut=TRUE, expandInbredSamples=FALSE)
+  ├─ mutationMode = 'postTs'-> simAnc(...) -> simMut(...)
+  ├─ mutationMode = 'none'  -> simAnc(...) only (TS-only unless user mutates later)
+  ├─ optional finalizeInbredTs(...)
+  └─ asMapPop(...) -> MapPop
+
+Lower layers:
+  simAnc()  -> MaCSTS(... useMacsMut=FALSE ...)
+  simMut()  -> tsMutateTableCollection(...) per chromosome
+  finalizeInbredTs() -> tsFinalizeInbredTableCollection(...) per chromosome
+  MaCSTS()  -> C++ simulator + TS recorder
+")
+

runMacsTS() ├─ command builder (species/manual) ├─ mutationMode = +‘macs’ -> MaCSTS(…, useMacsMut=TRUE, expandInbredSamples=FALSE) ├─ +mutationMode = ‘postTs’-> simAnc(…) -> simMut(…) ├─ mutationMode = +‘none’ -> simAnc(…) only (TS-only unless user mutates later) ├─ +optional finalizeInbredTs(…) └─ asMapPop(…) -> MapPop

+

Lower layers: simAnc() -> MaCSTS(… useMacsMut=FALSE …) simMut() +-> tsMutateTableCollection(…) per chromosome finalizeInbredTs() -> +tsFinalizeInbredTableCollection(…) per chromosome MaCSTS() -> C++ +simulator + TS recorder

+
+
+

3) Core Parameters And Their Effects

+
param_effects <- data.frame(
+  parameter = c(
+    "mutationMode",
+    "useMacsMut (MaCSTS)",
+    "usePhysicalPositions",
+    "Nref",
+    "segSites",
+    "inbred + ploidy",
+    "expandInbredTs",
+    "seed",
+    "mutSeed",
+    "nThreads"
+  ),
+  where_used = c(
+    "runMacsTS",
+    "MaCSTS",
+    "MaCSTS/asMapPop",
+    "MaCSTS (timeScale)",
+    "asMapPop",
+    "MaCSTS/asMapPop/finalizeInbredTs",
+    "runMacsTS/finalizeInbredTs",
+    "simAnc/MaCSTS ancestry RNG",
+    "simMut post-TS RNG",
+    "MaCS chromosomes + asMapPop worker"
+  ),
+  main_effect = c(
+    "Selects mutation path: macs vs postTs vs none",
+    "Adds MaCS-style mutation during ancestry if TRUE",
+    "TS coordinates in bp (TRUE) or [0,1] (FALSE)",
+    "Rescales node/mutation times; sets time_units to generations",
+    "Caps number of retained variants per chromosome in conversion",
+    "Controls sample interpretation and output haplotype structure",
+    "If TRUE with inbred/ploidy>1, duplicates TS sample leaves",
+    "Determines ancestry reproducibility",
+    "Determines post-TS mutation reproducibility",
+    "Parallelism level when available"
+  ),
+  stringsAsFactors = FALSE
+)
+knitr::kable(param_effects)
+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
parameterwhere_usedmain_effect
mutationModerunMacsTSSelects mutation path: macs vs postTs vs none
useMacsMut (MaCSTS)MaCSTSAdds MaCS-style mutation during ancestry if TRUE
usePhysicalPositionsMaCSTS/asMapPopTS coordinates in bp (TRUE) or [0,1] (FALSE)
NrefMaCSTS (timeScale)Rescales node/mutation times; sets time_units to +generations
segSitesasMapPopCaps number of retained variants per chromosome in +conversion
inbred + ploidyMaCSTS/asMapPop/finalizeInbredTsControls sample interpretation and output haplotype +structure
expandInbredTsrunMacsTS/finalizeInbredTsIf TRUE with inbred/ploidy>1, duplicates TS sample +leaves
seedsimAnc/MaCSTS ancestry RNGDetermines ancestry reproducibility
mutSeedsimMut post-TS RNGDetermines post-TS mutation reproducibility
nThreadsMaCS chromosomes + asMapPop workerParallelism level when available
+
+
+

Helpers to Compare Two Ways To Run

+
tc_counts <- function(tc_xptr) {
+  tc <- RcppTskit::TableCollection$new(xptr = tc_xptr)
+  data.frame(
+    num_nodes = as.integer(tc$num_nodes()),
+    num_edges = as.integer(tc$num_edges()),
+    num_sites = as.integer(tc$num_sites()),
+    num_mutations = as.integer(tc$num_mutations())
+  )
+}
+
+collect_ts_counts <- function(tables, method) {
+  do.call(rbind, lapply(seq_along(tables), function(chr) {
+    cbind(chr = chr, method = method, tc_counts(tables[[chr]]))
+  }))
+}
+
+compare_wrapper_vs_staged <- function(out, staged) {
+  if (!requireNamespace("RcppTskit", quietly = TRUE)) {
+    stop("RcppTskit is required for TS checks.")
+  }
+  if (is.null(out$pop) || is.null(out$tables)) {
+    stop("out must contain both $pop and $tables")
+  }
+  if (is.null(staged$pop) || is.null(staged$tables)) {
+    stop("staged must contain both $pop and $tables")
+  }
+  
+  ts_counts_wrap <- collect_ts_counts(out$tables, method = "wrapper")
+  ts_counts_stage <- collect_ts_counts(staged$tables, method = "staged")
+  ts_counts <- rbind(ts_counts_wrap, ts_counts_stage)
+  
+  nChr <- length(out$pop@geno)
+  same_geno <- vapply(seq_len(nChr), function(chr) {
+    identical(out$pop@geno[[chr]], staged$pop@geno[[chr]])
+  }, logical(1))
+  same_genMap <- vapply(seq_len(nChr), function(chr) {
+    isTRUE(all.equal(out$pop@genMap[[chr]], staged$pop@genMap[[chr]], tolerance = 0))
+  }, logical(1))
+  same_ts_counts <- identical(
+    ts_counts_wrap[, c("num_nodes", "num_edges", "num_sites", "num_mutations")],
+    ts_counts_stage[, c("num_nodes", "num_edges", "num_sites", "num_mutations")]
+  )
+  
+  checks <- data.frame(
+    metric = c("nLoci", "geno_all_chr", "genMap_all_chr", "ts_table_counts"),
+    equal = c(
+      identical(out$pop@nLoci, staged$pop@nLoci),
+      all(same_geno),
+      all(same_genMap),
+      same_ts_counts
+    ),
+    stringsAsFactors = FALSE
+  )
+  
+  list(ts_counts = ts_counts, checks = checks)
+}
+
+print_wrapper_vs_staged <- function(cmp) {
+  print(cmp$ts_counts)
+  print(cmp$checks)
+  invisible(cmp)
+}
+
+
+

Minimal Usage Examples

+
+

A. High-level wrapper mode

+
library(AlphaSimR)
+devtools::load_all()
+set.seed(1)
+out <- AlphaSimR:::runMacsTS(
+  nInd = 4,
+  nChr = 2,
+  segSites = 60,
+  inbred = FALSE,
+  ploidy = 2L,
+  species = "GENERIC",
+  mutationMode = "postTs",      # or "macs" / "none"
+  usePhysicalPositions = FALSE,
+  nThreads = 1L,
+  returnTs = TRUE
+)
+
+# runMacsTS returns:
+# out$pop      -> MapPop
+# out$tables   -> TS table collections (if returnTs=TRUE)
+
+
+

B. Staged mode

+
library(AlphaSimR)
+
+# use the same args and seeds as high-level wrapper mode
+args <- out$args
+nChr <- 2L
+seed_chr <- out$seed
+
+anc <- AlphaSimR:::simAnc(
+  args = args,
+  nChr = nChr,
+  inbred = FALSE,
+  ploidy = 2L,
+  nThreads = 1L,
+  seed = seed_chr,
+  usePhysicalPositions = FALSE,
+  Nref = NA_real_
+)
+
+mut <- AlphaSimR:::simMut(anc)  # uses anc$dTheta and derived mutation seeds by default
+
+# Optional for inbred/ploidy expansion in TS:
+# mut <- AlphaSimR:::finalizeInbredTs(mut, inbred = TRUE, ploidy = 2L)
+
+pop <- AlphaSimR:::asMapPop(
+  chr_info = list(
+    tables = mut$tables,
+    breaks = list(c(0, 1)),
+    rates = list(c(1))
+  ),
+  ploidy = 2L,
+  inbred = FALSE,
+  segSites = 60
+)
+
+
+
+

Validation

+
+

Wrapper vs staged equivalence

+
# Reuse objects from the previous ection:
+# - out  : runMacsTS(...) result
+# - mut  : simMut(...) result from staged path
+# - pop  : asMapPop(...) result from staged path
+
+stopifnot(exists("out"), exists("mut"), exists("pop"))
+cmp <- compare_wrapper_vs_staged(
+  out = out,
+  staged = list(
+    tables = mut$tables,
+    pop = pop
+  )
+)
+print_wrapper_vs_staged(cmp)
+
##   chr  method num_nodes num_edges num_sites num_mutations
+## 1   1 wrapper      4395     10544     15543         15543
+## 2   2 wrapper      4077      9941     14507         14507
+## 3   1  staged      4395     10544     15543         15543
+## 4   2  staged      4077      9941     14507         14507
+##            metric equal
+## 1           nLoci  TRUE
+## 2    geno_all_chr  TRUE
+## 3  genMap_all_chr  TRUE
+## 4 ts_table_counts  TRUE
+
+
+

Wrapper vs staged (inbred=TRUE, ploidy>1)

+
# Example: inbred TRUE with ploidy 2
+set.seed(1)
+out_inbred <- AlphaSimR:::runMacsTS(
+  nInd = 4,
+  nChr = 2,
+  segSites = 60,
+  inbred = TRUE,
+  ploidy = 2L,
+  species = "GENERIC",
+  mutationMode = "postTs",
+  usePhysicalPositions = TRUE,
+  expandInbredTs = TRUE,
+  nThreads = 1L,
+  returnTs = TRUE,
+  Nref = 10000
+)
+
+anc_inbred <- AlphaSimR:::simAnc(
+  args = out_inbred$args,
+  nChr = 2L,
+  inbred = TRUE,
+  ploidy = 2L,
+  nThreads = 1L,
+  seed = out_inbred$seed,
+  usePhysicalPositions = TRUE,
+  #Nref = NA_real_,
+  Nref = 10000
+)
+mut_inbred <- AlphaSimR:::simMut(anc_inbred)
+fin_inbred <- AlphaSimR:::finalizeInbredTs(mut_inbred, inbred = TRUE, ploidy = 2L)
+
+pop_inbred <- AlphaSimR:::asMapPop(
+  chr_info = list(
+    tables = fin_inbred$tables,
+    breaks = rep(list(c(0, 1)), 2L),
+    rates = rep(list(c(1)), 2L)
+  ),
+  ploidy = 2L,
+  inbred = TRUE,
+  segSites = 60,
+  site_sampling_seed = 42L,
+  nThreads = 1L
+)
+
+cmp_inbred <- compare_wrapper_vs_staged(
+  out = out_inbred,
+  staged = list(
+    tables = fin_inbred$tables,
+    pop = pop_inbred
+  )
+)
+print_wrapper_vs_staged(cmp_inbred)
+
##   chr  method num_nodes num_edges num_sites num_mutations
+## 1   1 wrapper      2620      5710      9372          9372
+## 2   2 wrapper      3497      7788     12514         12514
+## 3   1  staged      2620      5710   4225625       4225625
+## 4   2  staged      3497      7788   5750839       5750839
+##            metric equal
+## 1           nLoci  TRUE
+## 2    geno_all_chr FALSE
+## 3  genMap_all_chr FALSE
+## 4 ts_table_counts FALSE
+

Output a ts as an example and check it in Python:

+
tables_src <- if (exists("fin_inbred")) {
+  fin_inbred$tables
+} else if (exists("out_inbred")) {
+  out_inbred$tables
+} else {
+  stop("Need fin_inbred or out_inbred in environment. Run chunk 5.1b first.")
+}
+# chr1
+tc_xptr <- tables_src[[1]]
+tc <- RcppTskit::TableCollection$new(xptr = tc_xptr)
+ts <- tc$tree_sequence()
+ts$write('testData/inbred_test.trees')
+
library(reticulate)
+# Use your own path here!
+use_python('/usr/bin/python3', required = TRUE)
+
import numpy as np
+import tskit
+ts_inbred = tskit.load('testData/inbred_test.trees')
+ts_inbred.samples()
+
## array([2612, 2613, 2614, 2615, 2616, 2617, 2618, 2619], dtype=int32)
+
print(ts_inbred.first().draw_text())
+
##             727                        
+##     ┏━━━━━━━━┻━━━━━━━━┓                
+##     ┃                243               
+##     ┃         ┏━━━━━━━┻━━━━━━┓         
+##     ┃         ┃              4         
+##     ┃         ┃         ┏━━━━┻━━━━┓    
+##     0         1         2         3    
+##   ┏━┻━━┓    ┏━┻━━┓    ┏━┻━━┓    ┏━┻━━┓ 
+## 2612 2613 2614 2615 2616 2617 2618 2619
+
from IPython.display import display
+svg_size = (800, 250)
+svg_string = ts_inbred.first().draw_svg(
+    size=svg_size, time_scale="rank", omit_sites=True,
+    y_axis=True, y_label=" "  # optional: show a time scale on the left
+)
+with open("tmp_tree.svg", "w") as f:
+    f.write(svg_string)
+
## 5752
+
print(ts_inbred.tables.nodes[2612:2620])
+
## ╔══╤═════╤══════════╤══════════╤════╤════════╗
+## ║id│flags│population│individual│time│metadata║
+## ╠══╪═════╪══════════╪══════════╪════╪════════╣
+## ║0 │    1│         0│         0│   0│        ║
+## ║1 │    1│         0│         0│   0│        ║
+## ║2 │    1│         0│         1│   0│        ║
+## ║3 │    1│         0│         1│   0│        ║
+## ║4 │    1│         0│         2│   0│        ║
+## ║5 │    1│         0│         2│   0│        ║
+## ║6 │    1│         0│         3│   0│        ║
+## ║7 │    1│         0│         3│   0│        ║
+## ╚══╧═════╧══════════╧══════════╧════╧════════╝
+
print(ts_inbred.tables.nodes[0:4])
+
## ╔══╤═════╤══════════╤══════════╤══════════╤════════╗
+## ║id│flags│population│individual│time      │metadata║
+## ╠══╪═════╪══════════╪══════════╪══════════╪════════╣
+## ║0 │    0│         0│        -1│0.00000000│        ║
+## ║1 │    0│         0│        -1│0.00000000│        ║
+## ║2 │    0│         0│        -1│0.00000000│        ║
+## ║3 │    0│         0│        -1│0.00000000│        ║
+## ╚══╧═════╧══════════╧══════════╧══════════╧════════╝
+
g_matrix = ts_inbred.genotype_matrix()
+for hap in range(0, len(g_matrix[0]), 2):
+    print(hap, hap+1)
+    print(np.array_equal(g_matrix[:, hap], g_matrix[:, hap+1]))
+
## 0 1
+## True
+## 2 3
+## True
+## 4 5
+## True
+## 6 7
+## True
+

Sampled nodes are duplicated as expected for inbred/ploidy expansion, +from nodes 0-3. Each pair of hap (from the same individual) have same +alleles.

+
+
+

Parameter sensitivity checks

+

In tests/testthat/test-runMacsTS-sensitivity.R

+
+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/dev/testSampling.R b/dev/testSampling.R new file mode 100644 index 00000000..46dde852 --- /dev/null +++ b/dev/testSampling.R @@ -0,0 +1,71 @@ +library(ggplot2) + +L1 <- 1e6 +chr_info <- list( + list(ts_path="dev/testData/msprime_chr0.trees", + breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8))) +founderGenomes <- asMapPop( + chr_info = chr_info, + inbred = FALSE, + ploidy = 2L + ) +all_pos <- chrKeptPosBpList +all_pos <- unlist(all_pos) +breaks <- seq(min(all_pos), max(all_pos), length.out = 11) +bg_counts <- cut(all_pos, breaks = breaks, include.lowest = TRUE) %>% + table() %>% + as.numeric() + +n_iterations <- 50 +n_bins <- 10 +segSites <- 77 + +chr_info <- list( + list(ts_path="dev/testData/msprime_chr0.trees", + breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=segSites)) + +all_bp_positions <- list() +all_gen_map_positions <- list() + +#set.seed(42) +random_seeds <- sample(1:1000000, size = n_iterations) + +for (i in 1:n_iterations) { + current_seed <- random_seeds[i] + + founderGenomes <- asMapPop( + chr_info = chr_info, + inbred = FALSE, + ploidy = 2L, + site_sampling_seed = current_seed + ) + + bp_pos <- unlist(chrKeptPosBpList) + all_bp_positions[[i]] <- bp_pos + + gen_map_pos <- unlist(founderGenomes@genMap) + all_gen_map_positions[[i]] <- gen_map_pos +} + + +df_bp <- data.frame(pos = unlist(all_bp_positions)) +df_gen <- data.frame(pos = unlist(all_gen_map_positions)) + +sampled_counts <- cut(df_bp$pos, breaks = breaks, include.lowest = TRUE) %>% + table() %>% + as.numeric() + +plot_data <- data.frame( + bin_mid = (breaks[-1] + breaks[-length(breaks)]) / 2, + sampling_ratio = (sampled_counts) / bg_counts +) + +p1 <- ggplot(plot_data, aes(x = bin_mid/1000, y = sampling_ratio)) + + geom_bar(stat = "identity", fill = "skyblue", color = "white") + + geom_hline(yintercept = mean(plot_data$sampling_ratio, na.rm = TRUE), + linetype = "dashed", color = "red") + + labs(title = paste(segSites, "segSites (", length(all_pos), "in total) over", n_iterations, "runs"), + x = "Position (kbp)", + y = "Frequency (Count) / Background") + + theme_minimal() +print(p1) diff --git a/dev/testTsForwardRecorder.Rmd b/dev/testTsForwardRecorder.Rmd new file mode 100644 index 00000000..71b01463 --- /dev/null +++ b/dev/testTsForwardRecorder.Rmd @@ -0,0 +1,1457 @@ +--- +title: "Forward TS recorder workflow and bridge comparison" +output: html_document +date: "2026-07-20" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) +``` + +## General Notes + +This notebook shows the current forward tree-sequence recording workflow. +It uses the same forward simulation pattern as `dev/notesRealBreakpoints.md`: + +1. create founders from tree sequences, +2. run a short AlphaSimR breeding loop, +3. record meiosis breakpoints in forward time, +4. compare the direct forward TS recorder with the older + `bridgeCollectSegGenFromSimOutput()` path, +5. write `.trees` files that can be compared in Python. + +Two founder entry points are shown: + +1. start from `runMacsTS(...)`, +2. start from existing msprime `.trees` files. + +### Main workflow differences between old "bridge" and forward ts recorder: + +| Aspect | Old bridge path | Current forward recorder | +|---|---|---| +| When TS edges are made | After simulation | During each cross | +| Required recombination record | Stored `SP$recHistGen` | Temporary `tsSegGen` matrix only | +| Main stored object during simulation | `SP$recHistGen` | `attr(SP, "tsForwardRecorder")` | +| Segment data kept by default | Reconstructed later for bridge output | Not kept by default | +| Role of `SP$pedigree` | Used with `recHistGen` to reconstruct child-parent edge relationships after simulation | Still used for TS individual parent links, node times, and default sample inference, but not as the main source of inheritance edges | +| Recombination map source | Supplied in validation `chr_info` when bridge converts `recHistGen` to coordinates | Stored on the founder as `tsForwardPosMeta`; from `runMacsTS()` defaults/`-R` or explicit `asMapPop(chr_info)` maps | +| User output function | `bridgeWriteTrees()` | `tsForwardFinalizeFromSimParam()` | +| Metadata timing | Added when bridge writes trees | Added while recording nodes/individuals | +| Edge append path | R row loop | C++ bulk append | +| Child node append path | R row loop | C++ bulk append, with or without metadata | + +In short, the bridge path stores recombination history first and reconstructs +tree-sequence rows later. The forward recorder uses transient meiosis segments +to append tree-sequence rows immediately. It still uses pedigree information +for TS individual rows and node timing, but normal use does not need to keep +`recHistGen` or `tsSegGen`. + +## 1) Setup + +```{r libraries} +library(RcppTskit) +library(jsonlite) +library(ggplot2) +library(AlphaSimR) +devtools::load_all() + +out_dir <- 'testData' +``` + +## 2) Validation Helpers + +These helpers are only for interpretation and validation. The actual workflow +steps are kept in the main sections below so the user-facing process is clear. + +```{r helpers} +normalize_edge_df <- function(df) { + out <- data.frame( + chr = as.integer(df$chr), + child = as.integer(df$child), + parent = as.integer(df$parent), + left = as.numeric(df$left), + right = as.numeric(df$right), + stringsAsFactors = FALSE + ) + out <- out[out$right > out$left, , drop = FALSE] + if (nrow(out) == 0L) { + return(out) + } + ord <- order(out$chr, out$child, out$parent, out$left, out$right) + out <- out[ord, , drop = FALSE] + rownames(out) <- NULL + out +} + +collect_forward_edges_for_children <- function(recorder, chr, child_iids) { + chrState <- recorder$chr[[chr]] + tc <- chrState$tc + n_edge <- as.integer(tc$num_edges()) + out <- vector("list", n_edge) + k <- 0L + + iid_keys <- ls(chrState$indMap, all.names = TRUE) + if (length(iid_keys) == 0L) { + return(data.frame(chr = integer(), child = integer(), parent = integer(), + left = numeric(), right = numeric(), stringsAsFactors = FALSE)) + } + ind_rows <- vapply(iid_keys, function(key) { + as.integer(get(key, envir = chrState$indMap, inherits = FALSE)) + }, integer(1)) + ind_row_to_iid <- setNames(as.integer(iid_keys), as.character(ind_rows)) + + for (i in seq_len(n_edge)) { + e <- tc$edge_table_get_row(i - 1L) + child_node <- as.integer(e$child) + parent_node <- as.integer(e$parent) + child_ind_row <- as.integer(tc$node_table_get_row(child_node)$individual) + parent_ind_row <- as.integer(tc$node_table_get_row(parent_node)$individual) + + child_iid <- ind_row_to_iid[as.character(child_ind_row)] + parent_iid <- ind_row_to_iid[as.character(parent_ind_row)] + if (length(child_iid) == 0L || length(parent_iid) == 0L || + is.na(child_iid) || is.na(parent_iid)) { + next + } + child_iid <- as.integer(child_iid) + if (!(child_iid %in% child_iids)) { + next + } + + k <- k + 1L + out[[k]] <- data.frame( + chr = as.integer(chr), + child = child_iid, + parent = as.integer(parent_iid), + left = as.numeric(e$left), + right = as.numeric(e$right), + stringsAsFactors = FALSE + ) + } + + if (k == 0L) { + return(data.frame(chr = integer(), child = integer(), parent = integer(), + left = numeric(), right = numeric(), stringsAsFactors = FALSE)) + } + do.call(rbind, out[seq_len(k)]) +} + +collect_forward_edges_all_chr <- function(recorder, child_iids) { + out <- lapply(seq_len(recorder$nChr), function(cc) { + collect_forward_edges_for_children(recorder, chr = cc, child_iids = child_iids) + }) + normalize_edge_df(do.call(rbind, out)) +} + +collect_bridge_edges_for_children <- function(SP, sim_output, chr_info, child_iids) { + pos_list <- attr(sim_output[[1L]], "tsForwardPosMeta", exact = TRUE)$posList + bridge_list <- bridgeCollectSegGenFromSimOutput( + SP, + sim_output, + chr_info = chr_info, + pos_list = pos_list + ) + if (length(bridge_list) == 0L) { + return(data.frame(chr = integer(), child = integer(), parent = integer(), + left = numeric(), right = numeric(), stringsAsFactors = FALSE)) + } + bridge_df <- do.call(rbind, bridge_list) + bridge_edges <- data.frame( + chr = as.integer(bridge_df$chr), + child = as.integer(bridge_df$childId), + parent = as.integer(bridge_df$parentId), + left = as.numeric(bridge_df$left), + right = as.numeric(bridge_df$right), + stringsAsFactors = FALSE + ) + bridge_edges <- bridge_edges[bridge_edges$child %in% child_iids, , drop = FALSE] + normalize_edge_df(bridge_edges) +} + +compare_direct_vs_bridge_edges <- function(recorder, SP, sim_output, chr_info) { + child_iids <- unlist(lapply(sim_output[-1L], function(pop) as.integer(pop@iid)), use.names = FALSE) + direct_edges <- collect_forward_edges_all_chr(recorder, child_iids = child_iids) + bridge_edges <- collect_bridge_edges_for_children( + SP = SP, + sim_output = sim_output, + chr_info = chr_info, + child_iids = child_iids + ) + + checks <- data.frame( + metric = c("n_edges", "chr_child_parent", "left", "right"), + equal = c( + nrow(direct_edges) == nrow(bridge_edges), + identical(direct_edges[, c("chr", "child", "parent"), drop = FALSE], + bridge_edges[, c("chr", "child", "parent"), drop = FALSE]), + isTRUE(all.equal(direct_edges$left, bridge_edges$left, tolerance = 1e-6)), + isTRUE(all.equal(direct_edges$right, bridge_edges$right, tolerance = 1e-6)) + ), + stringsAsFactors = FALSE + ) + + list( + checks = checks, + direct_edges = direct_edges, + bridge_edges = bridge_edges + ) +} + +edge_comparison_summary <- function(cmp) { + direct <- cmp$direct_edges + bridge <- cmp$bridge_edges + n <- min(nrow(direct), nrow(bridge)) + same_ids <- if (n == 0L) { + nrow(direct) == nrow(bridge) + } else { + identical(direct[seq_len(n), c("chr", "child", "parent"), drop = FALSE], + bridge[seq_len(n), c("chr", "child", "parent"), drop = FALSE]) + } + max_left_diff <- if (n == 0L) NA_real_ else max(abs(direct$left[seq_len(n)] - bridge$left[seq_len(n)])) + max_right_diff <- if (n == 0L) NA_real_ else max(abs(direct$right[seq_len(n)] - bridge$right[seq_len(n)])) + + data.frame( + item = c( + "direct forward edge rows", + "bridge forward edge rows", + "same chr/child/parent ordering", + "max absolute left-coordinate difference", + "max absolute right-coordinate difference" + ), + value = c( + as.character(nrow(direct)), + as.character(nrow(bridge)), + as.character(same_ids), + as.character(signif(max_left_diff, 6)), + as.character(signif(max_right_diff, 6)) + ), + stringsAsFactors = FALSE + ) +} + +edge_example_table <- function(cmp, n = 8L) { + direct <- cmp$direct_edges + bridge <- cmp$bridge_edges + n <- min(n, nrow(direct), nrow(bridge)) + if (n == 0L) { + return(data.frame()) + } + data.frame( + row = seq_len(n), + chr = direct$chr[seq_len(n)], + child = direct$child[seq_len(n)], + parent = direct$parent[seq_len(n)], + direct_left = direct$left[seq_len(n)], + bridge_left = bridge$left[seq_len(n)], + left_diff = direct$left[seq_len(n)] - bridge$left[seq_len(n)], + direct_right = direct$right[seq_len(n)], + bridge_right = bridge$right[seq_len(n)], + right_diff = direct$right[seq_len(n)] - bridge$right[seq_len(n)], + stringsAsFactors = FALSE + ) +} + +edge_example_table_by_chr <- function(cmp, n = 5L) { + direct <- cmp$direct_edges + out <- lapply(split(seq_len(nrow(direct)), direct$chr), function(idx) { + cmp_chr <- list( + direct_edges = cmp$direct_edges[idx, , drop = FALSE], + bridge_edges = cmp$bridge_edges[idx, , drop = FALSE] + ) + edge_example_table(cmp_chr, n = n) + }) + do.call(rbind, out) +} + + +find_extra_recHistGen_example <- function(SP) { + RHG <- SP$recHistGen + RH <- SP$recHist + if (is.null(RHG) || is.null(RH)) { + return(NULL) + } + + as_rec_matrix <- function(x) { + if (is.null(x) || length(x) == 0L) { + return(NULL) + } + x <- as.matrix(x) + if (ncol(x) < 2L || nrow(x) == 0L) { + return(NULL) + } + x + } + + for (iid in seq_along(RHG)) { + for (chr in seq_along(RHG[[iid]])) { + gm <- as.numeric(SP$genMap[[chr]]) + for (hap in seq_along(RHG[[iid]][[chr]])) { + rhg <- as_rec_matrix(RHG[[iid]][[chr]][[hap]]) + rh <- as_rec_matrix(RH[[iid]][[chr]][[hap]]) + if (is.null(rhg) || is.null(rh) || nrow(rhg) <= nrow(rh)) { + next + } + + next_marker <- findInterval(as.numeric(rhg[, 2]), gm) + 1L + next_marker <- pmin(pmax(next_marker, 1L), length(gm)) + next_marker[seq_along(next_marker) == 1L] <- 1L + duplicated_marker <- unique(next_marker[-1L][duplicated(next_marker[-1L])]) + if (length(duplicated_marker) == 0L) { + next + } + + marker <- duplicated_marker[[1L]] + keep <- which(next_marker == marker) + keep <- seq(max(1L, min(keep) - 1L), min(nrow(rhg), max(keep) + 1L)) + table_next_marker <- next_marker[keep] + table_left_marker <- ifelse( + table_next_marker > 1L, + gm[table_next_marker - 1L], + NA_real_ + ) + rhg_table <- data.frame( + row = keep, + source_hap = as.integer(rhg[keep, 1]), + breakpoint_morgan = as.numeric(rhg[keep, 2]), + next_marker = table_next_marker, + left_marker_morgan = table_left_marker, + right_marker_morgan = gm[table_next_marker], + stringsAsFactors = FALSE + ) + rh_table <- data.frame( + row = seq_len(nrow(rh)), + source_hap = as.integer(rh[, 1]), + start_marker = as.integer(rh[, 2]), + start_marker_morgan = gm[pmin(pmax(as.integer(rh[, 2]), 1L), length(gm))], + stringsAsFactors = FALSE + ) + + return(list( + iid = iid, + chr = chr, + hap = hap, + marker = marker, + rhg_table = rhg_table, + rh_table = rh_table + )) + } + } + } + NULL +} +``` + +## 3) Entry Point A: Start With `runMacsTS` + +`runMacsTS()` returns a `MapPop` plus TS table pointers when `returnTs=TRUE`. +For the new direct recorder path, use `mac_out$pop` directly. The extra +file-backed `chr_info` below is only for the old bridge comparison functions, +because those functions still expect `chr_info[[cc]]$ts_path`. + +```{r runMacsTS-founders} +set.seed(42) + +# Step 1A: create founder tree sequences with runMacsTS. +mac_out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = c(60L, 120L), + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + usePhysicalPositions = TRUE, + nThreads = 1L, + returnTs = TRUE +) + +# Direct forward-recorder input: use the MapPop returned by runMacsTS. +mac_founder <- mac_out$pop + +# Old bridge input: bridgeCollectSegGenFromSimOutput()/bridgeWriteTrees() still +# use chr_info[[cc]]$ts_path, so this validation-only helper writes the in-memory +# runMacsTS founder tables to files and reconstructs the bridge rate map. +mac_bridge_chr_info <- AlphaSimR:::runMacsTSBridgeChrInfo( + mac_out, + out_dir = out_dir, + out_basename = "runMacsTS_founder" +) +``` + +### Forward Simulation With Direct TS Recorder + +```{r runMacsTS-forward} +# Step 2A: run the forward simulator and let the direct TS recorder update +# tables during meiosis. Keep recHistGen only for validation against the old +# bridge path. +old_opts_mac <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE +) + +set.seed(42) +mac_SP <- SimParam$new(mac_founder) +mac_SP$nThreads <- 1L +mac_SP$quadProb <- 0 +mac_SP$setSexes("yes_sys") +mac_SP$addTraitA(nQtlPerChr = 5, mean = 500, var = 450) +mac_SP$setTrackPed(TRUE) +mac_SP$setTrackRecGen(TRUE) + +mac_basePop <- newPop(mac_founder, simParam = mac_SP) +mac_SP$setTrackTs(TRUE, founderPop = mac_basePop) +mac_basePop <- setPheno(mac_basePop, h2 = 0.5, simParam = mac_SP) + +mac_sim_output <- list(mac_basePop) +for (cycle in seq_len(2L)) { + prev <- mac_sim_output[[cycle]] + chosen <- selectInd(pop = prev, nInd = min(6L, nInd(prev)), use = "gv", simParam = mac_SP) + offspring <- randCross(pop = chosen, nCrosses = 2L, nProgeny = 5L, simParam = mac_SP) + offspring <- setPheno(pop = offspring, h2 = 0.5, simParam = mac_SP) + mac_sim_output[[cycle + 1L]] <- offspring +} + +# Only for debugging and validation; for users, run tsForwardFinalizeFromSimParam() to write .trees files (see below). +mac_recorder <- attr(mac_SP, "tsForwardRecorder", exact = TRUE) +mac_recorder +stopifnot(inherits(mac_recorder, "tsForwardRecorder")) +# restore options +options(old_opts_mac) +``` + +### Compare Direct Recorder With The Old Bridge Path + +Each row in these edge tables means: for one child haplotype, the interval +`[left, right)` on chromosome `chr` inherited from `parent`. The direct recorder +appends these intervals directly to the TS edge table during crossing. The old +bridge path reconstructs the same intervals later from `recHistGen`. + + +The comparison is about the forward-added inheritance edges for offspring +created after the founder generation. A single edge row means: + +- `chr`: chromosome index in AlphaSimR, +- `child`: AlphaSimR individual id for the offspring, +- `parent`: AlphaSimR individual id for the parent that contributed this interval, +- `left`, `right`: the half-open tree-sequence interval `[left, right)`. + +The direct recorder writes these intervals to the TS edge table during crossing. +The bridge path reconstructs them later from `recHistGen` using +`bridgeCollectSegGenFromSimOutput()`. The summary table reports both edge-row +counts and the maximum absolute coordinate difference. The example table then +prints paired direct/bridge rows so the agreement can be inspected directly, +not just as a `TRUE`/`FALSE` result. + +Expected result: + +- direct and bridge edge counts should be the same, +- `same chr/child/parent ordering` should be `TRUE`, +- max absolute left/right differences should be zero or within floating-point + tolerance, +- the direct and bridge `.trees` files should have matching forward-added edge + structure and can be inspected further with Python/tskit. + +```{r runMacsTS-compare} +mac_cmp <- compare_direct_vs_bridge_edges( + recorder = mac_recorder, + SP = mac_SP, + sim_output = mac_sim_output, + chr_info = mac_bridge_chr_info +) + +knitr::kable(edge_comparison_summary(mac_cmp)) +#knitr::kable(edge_example_table(mac_cmp, n = 30L)) +knitr::kable(edge_example_table_by_chr(mac_cmp, n = 5L), digits = 3, + format.args = list(scientific = FALSE, nsmall = 3) +) +``` + +### Write Comparable Tree Files + +```{r runMacsTS-write-trees} +mac_direct_paths <- tsForwardFinalizeFromSimParam( + mac_SP, + out_dir = out_dir, + out_basename = "runMacsTS_direct", + clear = FALSE +) + +# keep founder nodes; nodes in the current generation and nodes in their pedigree +mac_direct_simplified_paths <- tsForwardFinalizeFromSimParam( + mac_SP, + out_dir = out_dir, + out_basename = "runMacsTS_direct_simplified_keep_unary", + simplify = TRUE, + keep_unary = TRUE, + clear = FALSE +) + +mac_bridge_list <- bridgeCollectSegGenFromSimOutput( + mac_SP, + mac_sim_output, + chr_info = mac_bridge_chr_info, + pos_list = attr(mac_sim_output[[1L]], "tsForwardPosMeta", exact = TRUE)$posList +) +mac_bridge_df <- do.call(rbind, mac_bridge_list) +bridgeWriteTrees( + chr_info = mac_bridge_chr_info, + edgeDf = mac_bridge_df, + SP = mac_SP, + out_dir = out_dir, + out_basename = "runMacsTS_bridge" +) +mac_bridge_paths <- file.path(out_dir, paste0("runMacsTS_bridge_chr", seq_along(mac_bridge_chr_info) - 1L, ".trees")) + +mac_tree_paths <- data.frame( + chr = seq_along(mac_bridge_chr_info), + direct_path = mac_direct_paths, + direct_simplified_path = mac_direct_simplified_paths, + bridge_path = mac_bridge_paths, + direct_exists = file.exists(mac_direct_paths), + direct_simplified_exists = file.exists(mac_direct_simplified_paths), + bridge_exists = file.exists(mac_bridge_paths), + stringsAsFactors = FALSE +) +mac_tree_paths +``` + +## 4) Entry Point B: Start With Existing msprime Tree Files + +This mirrors the setup in `dev/notesRealBreakpoints.md`. The recombination map +is supplied explicitly in `chr_info`. Here the rates are deliberately higher +than the original msprime examples, on the order of `1e-6`, so the forward +simulation creates more crossing-over events, including events between retained +markers. + +```{r msprime-founders} +L1 <- 1e6 +L2 <- 2e6 +msprime_chr_info <- list( + list( + ts_path = paste0(out_dir, "/msprime_chr0.trees"), + breaks = c(0, L1 / 2, L1), + rates = c(5e-5, 5e-6), + segSites = 60L + ), + list( + ts_path = paste0(out_dir, "/msprime_chr1.trees"), + breaks = c(0, L2 / 3, 2 * L2 / 3, L2), + rates = c(5e-7, 5e-6, 5e-7), + segSites = 155L + ) +) + +stopifnot(all(file.exists(vapply(msprime_chr_info, `[[`, character(1), "ts_path")))) + +msprime_founder <- asMapPop( + chr_info = msprime_chr_info, + inbred = FALSE, + ploidy = 2L +) +``` + +### Forward Simulation With Direct TS Recorder + +```{r msprime-forward} +# Step 2B: run the same forward TS recording process, now starting from +# existing msprime tree files. +old_opts_msprime <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE +) + +set.seed(42) +msprime_SP <- SimParam$new(msprime_founder) +msprime_SP$nThreads <- 1L +msprime_SP$quadProb <- 0 +msprime_SP$setSexes("no") +msprime_SP$addTraitA(nQtlPerChr = 5, mean = 500, var = 450) +msprime_SP$setTrackPed(TRUE) +msprime_SP$setTrackRecGen(TRUE) + +msprime_basePop <- newPop(msprime_founder, simParam = msprime_SP) +msprime_SP$setTrackTs(TRUE, founderPop = msprime_basePop) +msprime_basePop <- setPheno(msprime_basePop, h2 = 0.5, simParam = msprime_SP) + +msprime_sim_output <- list(msprime_basePop) +for (cycle in seq_len(2L)) { + prev <- msprime_sim_output[[cycle]] + chosen <- selectInd(pop = prev, nInd = min(2L, nInd(prev)), use = "gv", simParam = msprime_SP) + offspring <- randCross(pop = chosen, nCrosses = 1L, nProgeny = 5L, simParam = msprime_SP) + offspring <- setPheno(pop = offspring, h2 = 0.5, simParam = msprime_SP) + msprime_sim_output[[cycle + 1L]] <- offspring +} + +msprime_recorder <- attr(msprime_SP, "tsForwardRecorder", exact = TRUE) +stopifnot(inherits(msprime_recorder, "tsForwardRecorder")) +options(old_opts_msprime) +``` + +### Compare Direct Recorder With The Old Bridge Path + +```{r msprime-compare} +msprime_cmp <- compare_direct_vs_bridge_edges( + recorder = msprime_recorder, + SP = msprime_SP, + sim_output = msprime_sim_output, + chr_info = msprime_chr_info +) + +knitr::kable(edge_comparison_summary(msprime_cmp)) +#knitr::kable(edge_example_table(msprime_cmp, n = 10L)) +knitr::kable(edge_example_table_by_chr(msprime_cmp, n = 5L), digits = 3, + format.args = list(scientific = FALSE, nsmall = 3) +) +``` + +### Recombination Breakpoints Between Markers + +The comparison above uses `bridgeCollectSegGenFromSimOutput()`, so the bridge +side is reconstructed from `recHistGen`. When the direct-recorder edges match +that bridge output, it means the forward recorder is using the same breakpoint +resolution as `recHistGen`. + +The marker-index `recHist` representation can still miss double crossing-over +events that happen between the same two retained markers, because the marker +ancestry can return to the same state before the next marker. + +```{r msprime-double-crossover} +double_example <- find_extra_recHistGen_example(msprime_SP) +if (is.null(double_example)) { + cat("No between-marker double-crossover example found in this seeded run.\n") +} else { + cat( + "Check ind", double_example$iid, + "; chr", double_example$chr, + "; hap", double_example$hap, "\n" + ) + + RHG <- msprime_SP$recHistGen + RH <- msprime_SP$recHist + gm <- msprime_SP$genMap[[double_example$chr]] + + rh <- as.matrix(RH[[double_example$iid]][[double_example$chr]][[double_example$hap]]) + rhg <- as.matrix(RHG[[double_example$iid]][[double_example$chr]][[double_example$hap]]) + + cat( + "recHistGen has", nrow(rhg) - nrow(rh), + "more recorded recombination events than recHist.\n" + ) + + cat("\nrecHist: marker-index ancestry changes\n") + print(rh) + cat("\nrecHistGen: actual breakpoint positions in Morgan\n") + print(rhg) + + x <- as.numeric(rhg[, 2]) + left <- findInterval(x, gm) + left <- pmax(left, 1L) + right <- pmin(left + 1L, length(gm)) + + recHistGen_intervals <- data.frame( + x = x, + left_i = left, + left_v = gm[left], + right_i = right, + right_v = gm[right], + stringsAsFactors = FALSE + ) + + cat("\nSNP interval containing each recHistGen breakpoint\n") + print(recHistGen_intervals) +} +``` + +Rows in the interval table with the same `left_i` and `right_i` are multiple +breakpoints between the same two retained SNPs. These are retained by +`recHistGen`, and therefore by the forward TS recorder, but they are collapsed +in marker-index `recHist`. + +### Write Comparable Tree Files + +```{r msprime-write-trees} +msprime_direct_paths <- tsForwardFinalizeFromSimParam( + msprime_SP, + out_dir = out_dir, + out_basename = "msprime_direct", + clear = FALSE +) + +# keep founder nodes; nodes in the current generation and nodes in their pedigree +msprime_direct_simplified_paths <- tsForwardFinalizeFromSimParam( + msprime_SP, + out_dir = out_dir, + out_basename = "msprime_direct_simplified_keep_unary", + simplify = TRUE, + keep_unary = TRUE, + clear = FALSE +) + +msprime_bridge_list <- bridgeCollectSegGenFromSimOutput( + msprime_SP, + msprime_sim_output, + chr_info = msprime_chr_info, + pos_list = attr(msprime_sim_output[[1L]], "tsForwardPosMeta", exact = TRUE)$posList +) +msprime_bridge_df <- do.call(rbind, msprime_bridge_list) +bridgeWriteTrees( + chr_info = msprime_chr_info, + edgeDf = msprime_bridge_df, + SP = msprime_SP, + out_dir = out_dir, + out_basename = "msprime_bridge" +) +msprime_bridge_paths <- file.path(out_dir, paste0("msprime_bridge_chr", seq_along(msprime_chr_info) - 1L, ".trees")) + +msprime_tree_paths <- data.frame( + chr = seq_along(msprime_chr_info), + direct_path = msprime_direct_paths, + direct_simplified_path = msprime_direct_simplified_paths, + bridge_path = msprime_bridge_paths, + direct_exists = file.exists(msprime_direct_paths), + direct_simplified_exists = file.exists(msprime_direct_simplified_paths), + bridge_exists = file.exists(msprime_bridge_paths), + stringsAsFactors = FALSE +) + +``` + +```{r combine-tree-paths} +tree_path_cols <- c( + "chr", + "direct_path", + "direct_simplified_path", + "bridge_path", + "direct_exists", + "direct_simplified_exists", + "bridge_exists" +) +align_tree_path_cols <- function(x) { + missing_cols <- setdiff(tree_path_cols, names(x)) + for (col in missing_cols) { + x[[col]] <- NA + } + x[, tree_path_cols, drop = FALSE] +} +all_tree_paths <- rbind( + align_tree_path_cols(mac_tree_paths), + align_tree_path_cols(msprime_tree_paths) +) +all_tree_paths +``` + +## 5) Files To Compare In Python And Interpret + +Use the following Python code outside R, or run the chunk after configuring a +Python environment with `tskit` installed. +```{r py-setup} +# Use your own path here! +reticulate::use_python("/usr/bin/python3", required = TRUE) +library(reticulate) +reticulate::py_config() +``` + +```{r python-paths} +python_pairs <- data.frame( + label = c("runMacsTS chr0", "runMacsTS chr1", "msprime chr0", "msprime chr1"), + direct_path = normalizePath(all_tree_paths$direct_path, mustWork = FALSE), + bridge_path = normalizePath(all_tree_paths$bridge_path, mustWork = FALSE), + stringsAsFactors = FALSE +) +library(reticulate) +pairs_obj <- lapply(seq_len(nrow(python_pairs)), function(i) { + as.list(python_pairs[i, , drop = FALSE]) +}) +reticulate::py_run_string("pairs = r.pairs_obj") +``` + +```{python compare-tree-files} +from pathlib import Path +import tskit + +required_fields = {"direct_path", "bridge_path"} +missing = required_fields - set(pairs[0]) +if missing: + raise ValueError(f"python_pairs is missing {sorted(missing)}. Rerun the python-paths R chunk.") + +def direct_simplified_path(direct_path): + path = Path(direct_path) + return path.with_name( + path.name.replace("_direct_chr", "_direct_simplified_keep_unary_chr") + ) + +for row in pairs: + print(row) + direct = tskit.load(row["direct_path"]) + direct_simplified = tskit.load(direct_simplified_path(row["direct_path"])) + bridge = tskit.load(row["bridge_path"]) + print(row["label"]) + print(" order: direct, bridge, direct_simplified_keep_unary") + print(" nodes:", direct.num_nodes, bridge.num_nodes, direct_simplified.num_nodes) + print(" edges:", direct.num_edges, bridge.num_edges, direct_simplified.num_edges) + print(" trees:", direct.num_trees, bridge.num_trees, direct_simplified.num_trees) + print(" sites:", direct.num_sites, bridge.num_sites, direct_simplified.num_sites) +``` + +Print one tree from each differently generated result. The simplified direct +files are generated above by +`tsForwardFinalizeFromSimParam(..., simplify = TRUE, keep_unary = TRUE)`. + +```{python print-example-trees} + +for row in pairs: + if row["label"] not in {"msprime chr0"}: + continue + for method in ["direct", "bridge"]: + ts_path = Path(row[f"{method}_path"]) + ts = tskit.load(ts_path) + + print(f"\n{row['label']} - {method}") + print("original counts") + print(" trees:", ts.num_trees) + print(" nodes:", ts.num_nodes) + print(" edges:", ts.num_edges) + print(ts.first().draw_text()) + + direct = tskit.load(row["direct_path"]) + simplified_path = direct_simplified_path(row["direct_path"]) + simplified = tskit.load(simplified_path) + print(f"\n{row['label']} - direct simplified by AlphaSimR finalize, keep_unary=True") + print(" path:", simplified_path) + print(" trees:", simplified.num_trees, "reduced by", direct.num_trees - simplified.num_trees) + print(" nodes:", simplified.num_nodes, "reduced by", direct.num_nodes - simplified.num_nodes) + print(" edges:", simplified.num_edges, "reduced by", direct.num_edges - simplified.num_edges) + print(simplified.first().draw_text()) + +# see the information of the only offspring of founder node 1 +print(direct.node(270)) +print(simplified.node(24)) + +print(direct.individual(17)) +print(simplified.individual(14)) +``` + +Print and draw pedigrees from the same files: + +```{python print-pedigrees} +from pathlib import Path +import tskit +from matplotlib import pyplot as plt +import networkx as nx + +def draw_pedigree(ped_ts, title): + plt.figure(figsize=(8, 5)) + + G = nx.DiGraph() + for ind in ped_ts.individuals(): + if len(ind.nodes) == 0: + continue + time = ped_ts.node(ind.nodes[0]).time + pop = ped_ts.node(ind.nodes[0]).population + G.add_node(ind.id, time=time, population=pop) + for p in ind.parents: + if p != tskit.NULL: + G.add_edge(ind.id, p) + + pos = nx.multipartite_layout(G, subset_key="time", align="horizontal") + colours = plt.rcParams["axes.prop_cycle"].by_key()["color"] + node_colours = [ + colours[attr["population"] % len(colours)] + for attr in G.nodes.values() + ] + + nx.draw_networkx(G, pos, with_labels=True, node_color=node_colours) + plt.title(title) + plt.show() + plt.close() + +print(pairs) +for row in pairs: + if row["label"] not in ["msprime chr1", "runMacsTS chr1"]: + continue + #print(row) + paths = { + "direct": row["direct_path"], + "bridge": row["bridge_path"], + "direct_simplified": direct_simplified_path(row["direct_path"]) + } + + for method, path in paths.items(): + print(row) + ts = tskit.load(path) + print(f"\n{row['label']} - {method}") + draw_pedigree(ts, f"{row['label']} - {method}") +``` + +## 6) Test Recombination Map Handling + +This section checks how recombination-map information is carried from founder +generation into the forward simulation and the direct TS recorder. When +`runMacsTS()` is run with a MaCS `-R` hotspot file, the resulting founder keeps +that map metadata, so the forward recorder can use it without additional user +input. When `asMapPop(chr_info = list(..., breaks = ..., rates = ...))` is used, +the explicit `breaks/rates` input controls the founder `genMap` used by the +forward simulation. + +We test this because there are two separate sources of recombination-map +information: the map used to generate the MaCS ancestry, and the map stored on +the founder for later AlphaSimR forward recombination. These examples check that +the forward edge-start distribution follows the map available to the forward +simulation, including the case where constant-rate MaCS ancestry is rebuilt with +an explicit non-constant map for the forward stage. + +The four cases are: + +1. constant recombination map from the normal `runMacsTS()` path, +2. constant-rate `runMacsTS()` ancestry rebuilt with explicit hotspot + `breaks/rates` for the forward simulation, +3. MaCS `-R` hotspot file parsed automatically by `runMacsTS()`, +4. MaCS `-R` ancestry tables rebuilt with explicit `breaks/rates` through + `asMapPop(chr_info = list(tables = ...))`. + +The dashed lines in the plot show the expected number of edge starts per +window: number of transmitted haplotypes times the window's genetic length. + +```{r runmacts-recombination-map-edge-windows} +recomb_test_bp <- 1e8 +recomb_test_Ne <- 100 +recomb_test_mut_rate <- 2.5e-8 +recomb_test_rec_rate <- 1e-8 +recomb_test_seg_sites <- 80L +recomb_test_window_bp <- 1e7 +recomb_test_n_forward_gen <- 2L +recomb_test_n_crosses <- 3L +recomb_test_n_progeny <- 5L +recomb_test_ploidy <- 2L +recomb_test_hotspot_lines <- c("0.2 0.3 5", "0.6 0.8 0.1") +recomb_test_hotspot_path <- file.path(out_dir, "runMacsTS_hotspots_for_window_counts.txt") + +edge_start_window_counts <- function(edges, seq_len, window_bp = 1e7) { + starts <- seq(0, seq_len - window_bp, by = window_bp) + ends <- pmin(starts + window_bp, seq_len) + edge_starts <- edges$left[edges$left > 0 & edges$left < seq_len] + data.frame( + window = seq_along(starts), + window_start = starts, + window_end = ends, + n_edge_starts = vapply(seq_along(starts), function(i) { + sum(edge_starts >= starts[[i]] & edge_starts < ends[[i]]) + }, integer(1)), + stringsAsFactors = FALSE + ) +} + +run_forward_edge_windows <- function(founder, rep_id, case, seq_len, window_bp = 1e7) { + SP <- SimParam$new(founder) + SP$nThreads <- 1L + SP$quadProb <- 0 + SP$setTrackPed(TRUE) + + base_pop <- newPop(founder, simParam = SP) + SP$setTrackTs(TRUE, founderPop = base_pop) + + set.seed(10000L + rep_id) + sim_output <- list(base_pop) + for (gen in seq_len(recomb_test_n_forward_gen)) { + sim_output[[gen + 1L]] <- randCross( + pop = sim_output[[gen]], + nCrosses = recomb_test_n_crosses, + nProgeny = recomb_test_n_progeny, + simParam = SP + ) + } + + recorder <- attr(SP, "tsForwardRecorder", exact = TRUE) + child_iids <- unlist(lapply(sim_output[-1L], function(pop) as.integer(pop@iid)), use.names = FALSE) + edges <- collect_forward_edges_all_chr(recorder, child_iids = child_iids) + out <- edge_start_window_counts(edges, seq_len = seq_len, window_bp = window_bp) + out$rep <- rep_id + out$case <- case + out +} + +expected_edge_start_windows <- function(seq_len, window_bp, breaks, rates, + n_meioses, expected_map) { + starts <- seq(0, seq_len - window_bp, by = window_bp) + ends <- pmin(starts + window_bp, seq_len) + genetic_span <- rateMap2cumMorgan(ends, breaks, rates) - + rateMap2cumMorgan(starts, breaks, rates) + data.frame( + window = seq_along(starts), + window_start = starts, + window_end = ends, + window_mid = (starts + ends) / 2, + expected_edge_starts = n_meioses * genetic_span, + expected_map = expected_map, + stringsAsFactors = FALSE + ) +} + +runmacts_recombination_map_replicate <- function(rep_id) { + bp <- recomb_test_bp + Ne <- recomb_test_Ne + mut_rate <- recomb_test_mut_rate + rec_rate <- recomb_test_rec_rate + seg_sites <- recomb_test_seg_sites + + dir.create(out_dir, recursive = TRUE, showWarnings = FALSE) + writeLines(recomb_test_hotspot_lines, recomb_test_hotspot_path) + + old_opts <- options( + AlphaSimR.tsForwardAttachMetadata = TRUE, + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts), add = TRUE) + + manual_command <- paste( + bp, + "-t", 4 * Ne * mut_rate, + "-r", 4 * Ne * rec_rate, + "-R", recomb_test_hotspot_path + ) + + explicit_forward_map <- AlphaSimR:::.runMacsTS_map_from_hotspots( + path = recomb_test_hotspot_path, + nChr = 1, + seqLen = bp, + genLen = rec_rate * bp, + usePhysicalPositions = TRUE + ) + + constant_seed <- as.integer(20000L + rep_id) + constant_mut_seed <- as.integer(25000L + rep_id) + constant_site_seed <- as.integer(30000L + rep_id) + + run_constant_macs <- function() { + AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + segSites = seg_sites, + inbred = FALSE, + ploidy = recomb_test_ploidy, + species = "GENERIC", + mutationMode = "postTs", + usePhysicalPositions = TRUE, + nThreads = 1L, + seed = constant_seed, + mutSeed = constant_mut_seed, + siteSamplingSeed = constant_site_seed, + returnTs = TRUE + ) + } + + # Group 1 source: constant-rate MaCS ancestry with the default constant + # forward map retained from runMacsTS(). + constant_out <- run_constant_macs() + + # Group 2 source: an independent copy of the same constant-rate MaCS + # ancestry, rebuilt below with explicit hotspot breaks/rates. + constant_out_custom_map <- run_constant_macs() + + # Group 2: constant-rate MaCS ancestry, but explicit hotspot breaks/rates + # are supplied to asMapPop() so the forward simulation uses the custom map. + constant_founder_custom_forward_map <- asMapPop( + chr_info = list( + tables = constant_out_custom_map$tables, + breaks = explicit_forward_map$breaks, + rates = explicit_forward_map$rates + ), + inbred = FALSE, + ploidy = recomb_test_ploidy, + segSites = seg_sites, + site_sampling_seed = constant_site_seed, + nThreads = 1L + ) + + hotspot_seed <- as.integer(40000L + rep_id) + hotspot_mut_seed <- as.integer(45000L + rep_id) + hotspot_site_seed <- as.integer(50000L + rep_id) + + run_hotspot_macs <- function() { + AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + segSites = seg_sites, + inbred = FALSE, + ploidy = recomb_test_ploidy, + manualCommand = manual_command, + manualGenLen = rec_rate * bp, + mutationMode = "postTs", + usePhysicalPositions = TRUE, + nThreads = 1L, + seed = hotspot_seed, + mutSeed = hotspot_mut_seed, + siteSamplingSeed = hotspot_site_seed, + returnTs = TRUE + ) + } + + # Group 3 source: MaCS -R ancestry where runMacsTS() automatically retains + # the hotspot map metadata for the forward simulation. + hotspot_out_auto <- run_hotspot_macs() + + # Group 4 source: an independent copy of the same MaCS -R ancestry, rebuilt + # below with explicit hotspot breaks/rates. + hotspot_out_explicit <- run_hotspot_macs() + + hotspot_pos_meta <- attr(hotspot_out_explicit$pop, "tsForwardPosMeta", exact = TRUE) + + # Group 4: MaCS -R ancestry rebuilt with the same explicit hotspot + # breaks/rates through asMapPop(). + explicit_founder <- asMapPop( + chr_info = list( + tables = hotspot_out_explicit$tables, + breaks = hotspot_pos_meta$breaksList, + rates = hotspot_pos_meta$ratesList + ), + inbred = FALSE, + ploidy = recomb_test_ploidy, + segSites = seg_sites, + site_sampling_seed = as.integer(50000L + rep_id), + nThreads = 1L + ) + + do.call(rbind, list( + # Group 1: constant-rate MaCS ancestry and constant-rate forward map. + run_forward_edge_windows( + founder = constant_out$pop, + rep_id = rep_id, + case = "constant", + seq_len = bp + ), + # Group 2: constant-rate MaCS ancestry and explicit hotspot forward map. + run_forward_edge_windows( + founder = constant_founder_custom_forward_map, + rep_id = rep_id, + case = "constant_ancestry_explicit_forward_map", + seq_len = bp + ), + # Group 3: MaCS -R ancestry and automatically retained hotspot map. + run_forward_edge_windows( + founder = hotspot_out_auto$pop, + rep_id = rep_id, + case = "macs_R_auto", + seq_len = bp + ), + # Group 4: MaCS -R ancestry and explicit hotspot forward map. + run_forward_edge_windows( + founder = explicit_founder, + rep_id = rep_id, + case = "macs_R_explicit_breaks_rates", + seq_len = bp + ) + )) +} + +edge_window_reps <- do.call(rbind, lapply(seq_len(50L), runmacts_recombination_map_replicate)) + +expected_n_meioses <- recomb_test_n_forward_gen * + recomb_test_n_crosses * + recomb_test_n_progeny * + recomb_test_ploidy + +expected_hotspot_map <- AlphaSimR:::.runMacsTS_map_from_hotspots( + path = recomb_test_hotspot_path, + nChr = 1, + seqLen = recomb_test_bp, + genLen = recomb_test_rec_rate * recomb_test_bp, + usePhysicalPositions = TRUE +) + +expected_edge_windows <- rbind( + expected_edge_start_windows( + seq_len = recomb_test_bp, + window_bp = recomb_test_window_bp, + breaks = c(0, recomb_test_bp), + rates = c(recomb_test_rec_rate), + n_meioses = expected_n_meioses, + expected_map = "expected_constant_rate" + ), + expected_edge_start_windows( + seq_len = recomb_test_bp, + window_bp = recomb_test_window_bp, + breaks = expected_hotspot_map$breaks[[1]], + rates = expected_hotspot_map$rates[[1]], + n_meioses = expected_n_meioses, + expected_map = "expected_hotspot_map" + ) +) + +edge_window_summary <- aggregate( + n_edge_starts ~ case + window + window_start + window_end, + data = edge_window_reps, + FUN = function(x) c(mean = mean(x), sd = stats::sd(x)) +) +edge_window_summary <- do.call(data.frame, edge_window_summary) +names(edge_window_summary)[names(edge_window_summary) == "n_edge_starts.mean"] <- "mean_edge_starts" +names(edge_window_summary)[names(edge_window_summary) == "n_edge_starts.sd"] <- "sd_edge_starts" +edge_window_summary <- edge_window_summary[ + order(edge_window_summary$case, edge_window_summary$window), + , + drop = FALSE +] +rownames(edge_window_summary) <- NULL + +edge_window_summary +``` + +```{r runmacts-recombination-map-edge-start-plot} +edge_window_summary$window_mid <- ( + edge_window_summary$window_start + edge_window_summary$window_end +) / 2 + +edge_cases <- unique(edge_window_summary$case) +edge_cols <- setNames(c("#1B9E77", "#D95F02", "#7570B3", "#E7298A")[seq_along(edge_cases)], edge_cases) +expected_cols <- c( + expected_constant_rate = "#555555", + expected_hotspot_map = "#000000" +) +window_width <- min(diff(sort(unique(edge_window_summary$window_mid)))) +edge_offsets <- setNames( + seq(-0.18, 0.18, length.out = length(edge_cases)) * window_width, + edge_cases +) + +min_positive_y <- min( + c( + edge_window_summary$mean_edge_starts[edge_window_summary$mean_edge_starts > 0], + expected_edge_windows$expected_edge_starts[expected_edge_windows$expected_edge_starts > 0] + ), + na.rm = TRUE +) +if (!is.finite(min_positive_y)) { + min_positive_y <- 1 +} +edge_window_summary$plot_x <- edge_window_summary$window_mid + + edge_offsets[as.character(edge_window_summary$case)] +edge_window_summary$ymin <- pmax( + edge_window_summary$mean_edge_starts - edge_window_summary$sd_edge_starts, + min_positive_y / 2 +) +edge_window_summary$ymax <- pmax( + edge_window_summary$mean_edge_starts + edge_window_summary$sd_edge_starts, + min_positive_y / 2 +) + +ggplot( + edge_window_summary, + aes( + x = plot_x, + y = mean_edge_starts, + color = case, + group = case + ) +) + + geom_errorbar(aes(ymin = ymin, ymax = ymax), width = 0) + + geom_line(linewidth = 0.7) + + geom_point(size = 2) + + geom_line( + data = expected_edge_windows, + aes( + x = window_mid, + y = expected_edge_starts, + color = expected_map, + group = expected_map + ), + inherit.aes = FALSE, + linetype = "dashed", + linewidth = 0.9 + ) + + geom_point( + data = expected_edge_windows, + aes( + x = window_mid, + y = expected_edge_starts, + color = expected_map + ), + inherit.aes = FALSE, + shape = 95, + size = 5 + ) + + scale_color_manual(values = c(edge_cols, expected_cols)) + + scale_y_log10( + limits = c(0.1, NA), + breaks = c(0.6, 6, 30), + labels = c("0.6", "6", "30") + ) + + labs( + x = "Genome position (bp)", + y = "Mean number of new edge starts, log10 scale", + color = "Case" + ) + + theme_bw() +``` + +## 7) Standard User Workflow + +This is the clean forward-recorder workflow without bridge validation, +`recHistGen`, saved `tsSegGen`, or comparison helpers. It shows both standard +entry points: start from `runMacsTS()` or start from existing msprime `.trees` +files. In both cases, the user-facing process is: + +1. create founders, +2. initialize `SimParam` and the forward TS recorder, +3. run forward simulation, +4. write final `.trees` files. + +```{r standard-forward-recorder-runmacts} +out_dir <- 'testData' + +standard_runmacts_tree_paths <- local({ + old_opts_standard <- options( + AlphaSimR.tsForwardAttachMetadata = TRUE, + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts_standard), add = TRUE) + + set.seed(42) + + # 1. Create founders from runMacsTS. + standard_mac_out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = c(60L, 120L), + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + usePhysicalPositions = TRUE, + nThreads = 1L, + returnTs = TRUE + ) + standard_founder <- standard_mac_out$pop + + # 2. Initialize AlphaSimR and the forward TS recorder. + standard_SP <- SimParam$new(standard_founder) + standard_SP$nThreads <- 1L + standard_SP$quadProb <- 0 + standard_SP$setTrackPed(TRUE) + + standard_base_pop <- newPop(standard_founder, simParam = standard_SP) + standard_SP$setTrackTs(TRUE, founderPop = standard_base_pop) + + # 3. Run the forward simulation. The recorder updates TS tables during meiosis. + standard_pop <- standard_base_pop + n_forward_gen <- 2L + for (gen in seq_len(n_forward_gen)) { + standard_pop <- randCross( + pop = standard_pop, + nCrosses = 2L, + nProgeny = 5L, + simParam = standard_SP + ) + } + + # 4. Write final tree files. + standard_out_dir <- file.path(out_dir) + dir.create(standard_out_dir, recursive = TRUE, showWarnings = FALSE) + standard_original_paths <- AlphaSimR:::tsForwardFinalizeFromSimParam( + standard_SP, + out_dir = standard_out_dir, + out_basename = "standard_runMacsTS_forward_recorder", + clear = FALSE + ) + standard_simplified_paths <- AlphaSimR:::tsForwardFinalizeFromSimParam( + standard_SP, + out_dir = standard_out_dir, + out_basename = "standard_runMacsTS_forward_recorder_simplified", + simplify = TRUE, + keep_unary = TRUE, + clear = TRUE + ) + list(original = standard_original_paths, simplified = standard_simplified_paths) +}) + +standard_runmacts_tree_paths +``` + +```{r standard-forward-recorder-msprime} +standard_msprime_tree_paths <- local({ + old_opts_standard <- options( + AlphaSimR.tsForwardAttachMetadata = TRUE, + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts_standard), add = TRUE) + + set.seed(42) + + # 1. Create founders from existing msprime tree files. + # The recombination map must be supplied with external tree-sequence files. + standard_L1 <- 1e6 + standard_L2 <- 2e6 + standard_msprime_chr_info <- list( + list( + ts_path = paste0(out_dir, "/msprime_chr0.trees"), + breaks = c(0, standard_L1 / 2, standard_L1), + rates = c(5e-5, 5e-6), + segSites = 60L + ), + list( + ts_path = paste0(out_dir, "/msprime_chr1.trees"), + breaks = c(0, standard_L2 / 3, 2 * standard_L2 / 3, standard_L2), + rates = c(5e-7, 5e-6, 5e-7), + segSites = 155L + ) + ) + stopifnot(all(file.exists(vapply( + standard_msprime_chr_info, `[[`, character(1), "ts_path" + )))) + + standard_msprime_founder <- asMapPop( + chr_info = standard_msprime_chr_info, + inbred = FALSE, + ploidy = 2L + ) + + # 2. Initialize AlphaSimR and the forward TS recorder. + standard_msprime_SP <- SimParam$new(standard_msprime_founder) + standard_msprime_SP$nThreads <- 1L + standard_msprime_SP$quadProb <- 0 + standard_msprime_SP$setTrackPed(TRUE) + + standard_msprime_base_pop <- newPop( + standard_msprime_founder, + simParam = standard_msprime_SP + ) + standard_msprime_SP$setTrackTs(TRUE, founderPop = standard_msprime_base_pop) + + # 3. Run the forward simulation. The recorder updates TS tables during meiosis. + standard_msprime_pop <- standard_msprime_base_pop + n_forward_gen <- 2L + for (gen in seq_len(n_forward_gen)) { + standard_msprime_pop <- randCross( + pop = standard_msprime_pop, + nCrosses = 2L, + nProgeny = 5L, + simParam = standard_msprime_SP + ) + } + + # 4. Write final tree files. + standard_out_dir <- file.path(out_dir) + dir.create(standard_out_dir, recursive = TRUE, showWarnings = FALSE) + standard_msprime_original_paths <- AlphaSimR:::tsForwardFinalizeFromSimParam( + standard_msprime_SP, + out_dir = standard_out_dir, + out_basename = "standard_msprime_forward_recorder", + clear = FALSE + ) + standard_msprime_simplified_paths <- AlphaSimR:::tsForwardFinalizeFromSimParam( + standard_msprime_SP, + out_dir = standard_out_dir, + out_basename = "standard_msprime_forward_recorder_simplified", + simplify = TRUE, + keep_unary = TRUE, + clear = TRUE + ) + list( + original = standard_msprime_original_paths, + simplified = standard_msprime_simplified_paths + ) +}) + +standard_msprime_tree_paths +``` diff --git a/dev/testTsForwardRecorderVcfInput.Rmd b/dev/testTsForwardRecorderVcfInput.Rmd new file mode 100644 index 00000000..74862c9e --- /dev/null +++ b/dev/testTsForwardRecorderVcfInput.Rmd @@ -0,0 +1,631 @@ +--- +title: "Forward TS recorder: tree input versus VCF input" +output: html_document +date: "2026-08-18" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) + +project_root <- normalizePath(if (file.exists("DESCRIPTION")) "." else "..") +local_lib <- file.path(project_root, ".Rlib") +if (dir.exists(local_lib)) { + .libPaths(c(local_lib, .libPaths())) +} +library(AlphaSimR) +library(RcppTskit) +``` + +This is a short companion to `dev/testTsForwardRecorder.Rmd`. It uses the same +msprime forward-simulation parameters, but starts the founders in two ways: + +1. directly from `msprime_chr0.trees` and `msprime_chr1.trees`; +2. from the matching phased VCF, `msprime_combined.vcf`, with `tsRecord=TRUE`. + +The final `.trees` files are not expected to be byte-identical: the tree input +keeps the original ancestral history and source sites, while the VCF input +initializes synthetic founder nodes from haplotypes. The VCF importer also has +an `addTsMut` option. When `addTsMut=FALSE`, VCF marker sites are not written as +synthetic TS mutation events; when `addTsMut=TRUE`, retained VCF marker +positions are added as site rows and allele-1 calls are added as mutation rows +on founder haplotype nodes. Most of this notebook uses `addTsMut=FALSE`; the +last section compares both modes. The validation below checks the common part: +same retained founder haplotypes, same genetic map, same forward breeding loop, +and same forward-added inheritance edges. + +## Helpers + +These are the same validation helpers used in `testTsForwardRecorder.Rmd`, +trimmed to the pieces needed here. + +```{r helpers} +normalize_edge_df <- function(df) { + out <- data.frame( + chr = as.integer(df$chr), + child = as.integer(df$child), + parent = as.integer(df$parent), + left = as.numeric(df$left), + right = as.numeric(df$right), + stringsAsFactors = FALSE + ) + out <- out[out$right > out$left, , drop = FALSE] + if (nrow(out) == 0L) { + return(out) + } + out <- out[order(out$chr, out$child, out$parent, out$left, out$right), , drop = FALSE] + rownames(out) <- NULL + out +} + +collect_forward_edges_for_children <- function(recorder, chr, child_iids) { + chrState <- recorder$chr[[chr]] + tc <- chrState$tc + n_edge <- as.integer(tc$num_edges()) + + iid_keys <- ls(chrState$indMap, all.names = TRUE) + if (length(iid_keys) == 0L || n_edge == 0L) { + return(data.frame(chr = integer(), child = integer(), parent = integer(), + left = numeric(), right = numeric(), stringsAsFactors = FALSE)) + } + + ind_rows <- vapply(iid_keys, function(key) { + as.integer(get(key, envir = chrState$indMap, inherits = FALSE)) + }, integer(1)) + ind_row_to_iid <- setNames(as.integer(iid_keys), as.character(ind_rows)) + + out <- vector("list", n_edge) + k <- 0L + for (i in seq_len(n_edge)) { + e <- tc$edge_table_get_row(i - 1L) + child_ind_row <- as.integer(tc$node_table_get_row(as.integer(e$child))$individual) + parent_ind_row <- as.integer(tc$node_table_get_row(as.integer(e$parent))$individual) + child_iid <- ind_row_to_iid[as.character(child_ind_row)] + parent_iid <- ind_row_to_iid[as.character(parent_ind_row)] + + if (length(child_iid) == 0L || length(parent_iid) == 0L || + is.na(child_iid) || is.na(parent_iid)) { + next + } + child_iid <- as.integer(child_iid) + if (!(child_iid %in% child_iids)) { + next + } + + k <- k + 1L + out[[k]] <- data.frame( + chr = as.integer(chr), + child = child_iid, + parent = as.integer(parent_iid), + left = as.numeric(e$left), + right = as.numeric(e$right), + stringsAsFactors = FALSE + ) + } + + if (k == 0L) { + return(data.frame(chr = integer(), child = integer(), parent = integer(), + left = numeric(), right = numeric(), stringsAsFactors = FALSE)) + } + do.call(rbind, out[seq_len(k)]) +} + +collect_forward_edges_all_chr <- function(recorder, child_iids) { + out <- lapply(seq_len(recorder$nChr), function(chr) { + collect_forward_edges_for_children(recorder, chr = chr, child_iids = child_iids) + }) + normalize_edge_df(do.call(rbind, out)) +} + +same_gen_map <- function(a, b, tol = 1e-12) { + length(a) == length(b) && + all(mapply(function(x, y) { + isTRUE(all.equal(as.numeric(x), as.numeric(y), tolerance = tol)) + }, a, b)) +} + +edge_example_table <- function(tree_edges, vcf_edges, n = 8L) { + n <- min(n, nrow(tree_edges), nrow(vcf_edges)) + if (n == 0L) { + return(data.frame()) + } + data.frame( + row = seq_len(n), + chr = tree_edges$chr[seq_len(n)], + child = tree_edges$child[seq_len(n)], + parent = tree_edges$parent[seq_len(n)], + tree_left = tree_edges$left[seq_len(n)], + vcf_left = vcf_edges$left[seq_len(n)], + left_diff = tree_edges$left[seq_len(n)] - vcf_edges$left[seq_len(n)], + tree_right = tree_edges$right[seq_len(n)], + vcf_right = vcf_edges$right[seq_len(n)], + right_diff = tree_edges$right[seq_len(n)] - vcf_edges$right[seq_len(n)], + stringsAsFactors = FALSE + ) +} + +edge_example_table_by_chr <- function(tree_edges, vcf_edges, n = 5L) { + out <- lapply(split(seq_len(nrow(tree_edges)), tree_edges$chr), function(idx) { + chr <- tree_edges$chr[idx[[1L]]] + vcf_idx <- which(vcf_edges$chr == chr) + edge_example_table( + tree_edges = tree_edges[idx, , drop = FALSE], + vcf_edges = vcf_edges[vcf_idx, , drop = FALSE], + n = n + ) + }) + do.call(rbind, out) +} + +run_standard_forward <- function(founder, seed = 42L) { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE + ) + on.exit(options(old_opts), add = TRUE) + + set.seed(seed) + SP <- SimParam$new(founder) + SP$nThreads <- 1L + SP$quadProb <- 0 + SP$setSexes("no") + SP$addTraitA(nQtlPerChr = 5, mean = 500, var = 450) + SP$setTrackPed(TRUE) + SP$setTrackRecGen(TRUE) + + basePop <- newPop(founder, simParam = SP) + SP$setTrackTs(TRUE, founderPop = basePop) + basePop <- setPheno(basePop, h2 = 0.5, simParam = SP) + + sim_output <- list(basePop) + for (cycle in seq_len(2L)) { + prev <- sim_output[[cycle]] + chosen <- selectInd(pop = prev, nInd = min(2L, nInd(prev)), use = "gv", simParam = SP) + offspring <- randCross(pop = chosen, nCrosses = 1L, nProgeny = 5L, simParam = SP) + offspring <- setPheno(pop = offspring, h2 = 0.5, simParam = SP) + sim_output[[cycle + 1L]] <- offspring + } + + child_iids <- unlist(lapply(sim_output[-1L], function(pop) as.integer(pop@iid)), use.names = FALSE) + recorder <- attr(SP, "tsForwardRecorder", exact = TRUE) + edges <- collect_forward_edges_all_chr(recorder, child_iids = child_iids) + + list(SP = SP, sim_output = sim_output, recorder = recorder, edges = edges) +} +``` + +## Founder Imports + +The recombination map, `segSites`, and site-sampling seed match the msprime +section of `testTsForwardRecorder.Rmd`. + +```{r imports} +out_dir <- file.path(project_root, "dev", "testData") +L1 <- 1e6 +L2 <- 2e6 + +chr_info <- list( + list( + ts_path = file.path(out_dir, "msprime_chr0.trees"), + breaks = c(0, L1 / 2, L1), + rates = c(5e-5, 5e-6), + segSites = 60L + ), + list( + ts_path = file.path(out_dir, "msprime_chr1.trees"), + breaks = c(0, L2 / 3, 2 * L2 / 3, L2), + rates = c(5e-7, 5e-6, 5e-7), + segSites = 155L + ) +) + +stopifnot(all(file.exists(vapply(chr_info, `[[`, character(1), "ts_path")))) +stopifnot(file.exists(file.path(out_dir, "msprime_combined.vcf"))) + +tree_founder <- AlphaSimR:::asMapPop( + chr_info = chr_info, + inbred = FALSE, + ploidy = 2L, + site_sampling_seed = 42L, + returnMeta = TRUE +) + +vcf_founder <- importVCF( + vcfFile = file.path(out_dir, "msprime_combined.vcf"), + breaks = list(chr0 = chr_info[[1L]]$breaks, chr1 = chr_info[[2L]]$breaks), + rates = list(chr0 = chr_info[[1L]]$rates, chr1 = chr_info[[2L]]$rates), + segSites = c(chr0 = 60L, chr1 = 155L), + siteSamplingSeed = 42L, + missing = "error", + tsRecord = TRUE, + addTsMut = FALSE, + returnMeta = TRUE +) +``` + +## Validate Founder Equivalence + +```{r founder-equivalence} +tree_hap <- pullSegSiteHaplo(tree_founder$pop, nThreads = 1L) +vcf_hap <- pullSegSiteHaplo(vcf_founder$pop, nThreads = 1L) +vcf_ts_summary <- lapply(vcf_founder$tsTables, rtsk_table_collection_summary2) + +founder_checks <- data.frame( + check = c( + "nInd", + "ploidy", + "nLoci", + "retained physical positions", + "genetic map numeric values", + "haplotype numeric values", + "VCF has TS forward source", + "VCF TS site tables are empty", + "VCF TS mutation tables are empty" + ), + passed = c( + tree_founder$pop@nInd == vcf_founder$pop@nInd, + tree_founder$pop@ploidy == vcf_founder$pop@ploidy, + identical(tree_founder$pop@nLoci, vcf_founder$pop@nLoci), + identical(unname(tree_founder$keptPosBp), unname(vcf_founder$keptPos)), + same_gen_map(tree_founder$pop@genMap, vcf_founder$pop@genMap), + identical(unname(tree_hap), unname(vcf_hap)), + !is.null(attr(vcf_founder$pop, "tsForwardSource", exact = TRUE)), + all(vapply(vcf_ts_summary, function(x) as.integer(x$num_sites) == 0L, logical(1))), + all(vapply(vcf_ts_summary, function(x) as.integer(x$num_mutations) == 0L, logical(1))) + ) +) +knitr::kable(founder_checks) +stopifnot(all(founder_checks$passed)) +``` + +## Run The Same Forward Simulation + +```{r forward} +tree_run <- run_standard_forward(tree_founder$pop, seed = 42L) +vcf_run <- run_standard_forward(vcf_founder$pop, seed = 42L) +``` + +## Validate Forward Recorder Equivalence + +```{r forward-equivalence} +tree_edges <- tree_run$edges +vcf_edges <- vcf_run$edges +n <- min(nrow(tree_edges), nrow(vcf_edges)) + +edge_checks <- data.frame( + check = c( + "forward edge rows", + "chr/child/parent ordering", + "left coordinates", + "right coordinates" + ), + passed = c( + nrow(tree_edges) == nrow(vcf_edges), + identical(tree_edges[, c("chr", "child", "parent"), drop = FALSE], + vcf_edges[, c("chr", "child", "parent"), drop = FALSE]), + isTRUE(all.equal(tree_edges$left, vcf_edges$left, tolerance = 1e-6)), + isTRUE(all.equal(tree_edges$right, vcf_edges$right, tolerance = 1e-6)) + ) +) +knitr::kable(edge_checks) +stopifnot(all(edge_checks$passed)) + +edge_summary <- data.frame( + source = c("trees", "vcf"), + edge_rows = c(nrow(tree_edges), nrow(vcf_edges)), + max_left_diff = if (n == 0L) NA_real_ else max(abs(tree_edges$left[seq_len(n)] - vcf_edges$left[seq_len(n)])), + max_right_diff = if (n == 0L) NA_real_ else max(abs(tree_edges$right[seq_len(n)] - vcf_edges$right[seq_len(n)])) +) +knitr::kable(edge_summary, digits = 6) + +knitr::kable( + edge_example_table_by_chr(tree_edges, vcf_edges, n = 5L), + digits = 3, + format.args = list(scientific = FALSE, nsmall = 3) +) +``` + +## Write Forward TS Files + +```{r write-trees} +tree_paths <- AlphaSimR:::tsForwardFinalizeFromSimParam( + tree_run$SP, + out_dir = out_dir, + out_basename = "standard_msprime_tree_input_forward_recorder", + clear = TRUE +) + +vcf_paths <- AlphaSimR:::tsForwardFinalizeFromSimParam( + vcf_run$SP, + out_dir = out_dir, + out_basename = "standard_msprime_vcf_input_forward_recorder", + clear = TRUE +) + +tree_files <- data.frame( + chr = seq_along(tree_paths), + tree_input_path = tree_paths, + vcf_input_path = vcf_paths, + tree_exists = file.exists(tree_paths), + vcf_exists = file.exists(vcf_paths), + stringsAsFactors = FALSE +) +knitr::kable(tree_files) +stopifnot(all(tree_files$tree_exists), all(tree_files$vcf_exists)) +``` + +## Missing-Data VCF Smoke Test + +This uses the same two-chromosome VCF with missing genotypes. Missing sites are +filtered before reservoir sampling. This is not expected to match the complete +tree input at all loci, but it should still initialize founder nodes, keep TS +site/mutation tables empty with `addTsMut=FALSE`, and record the forward +simulation. + +```{r missing-vcf} +missing_vcf <- file.path(out_dir, "msprime_combined_missing.vcf") +stopifnot(file.exists(missing_vcf)) + +missing_founder <- importVCF( + vcfFile = missing_vcf, + breaks = list(chr0 = chr_info[[1L]]$breaks, chr1 = chr_info[[2L]]$breaks), + rates = list(chr0 = chr_info[[1L]]$rates, chr1 = chr_info[[2L]]$rates), + segSites = c(chr0 = 40L, chr1 = 100L), + siteSamplingSeed = 42L, + missing = "filter", + tsRecord = TRUE, + addTsMut = FALSE, + returnMeta = TRUE +) + +missing_run <- run_standard_forward(missing_founder$pop, seed = 42L) +missing_paths <- AlphaSimR:::tsForwardFinalizeFromSimParam( + missing_run$SP, + out_dir = out_dir, + out_basename = "standard_msprime_vcf_missing_input_forward_recorder", + clear = TRUE +) + +missing_summary <- data.frame( + nInd = missing_founder$pop@nInd, + ploidy = missing_founder$pop@ploidy, + nLoci = paste(missing_founder$pop@nLoci, collapse = ","), + kept = missing_founder$stats$kept, + skippedMissing = missing_founder$stats$skippedMissing, + forwardEdgeRows = nrow(missing_run$edges), + treeFilesWritten = all(file.exists(missing_paths)), + stringsAsFactors = FALSE +) +knitr::kable(missing_summary) +stopifnot(missing_summary$treeFilesWritten) +``` + +## Python Inspection Of Generated Tree Files + +This mirrors the Python/tskit inspection section in `testTsForwardRecorder.Rmd`, +but points at the newly generated tree-input, VCF-input, and missing-VCF-input +files from this notebook. + +```{r py-setup} +# Use your own path here if needed. +reticulate::use_python("/usr/bin/python3", required = TRUE) +library(reticulate) +reticulate::py_config() +``` + +```{r python-paths} +python_files <- data.frame( + label = c( + paste0("tree input chr", seq_along(tree_paths) - 1L), + paste0("vcf input chr", seq_along(vcf_paths) - 1L), + paste0("vcf missing input chr", seq_along(missing_paths) - 1L) + ), + source = rep(c("tree_input", "vcf_input", "vcf_missing_input"), + c(length(tree_paths), length(vcf_paths), length(missing_paths))), + chr = c(seq_along(tree_paths), seq_along(vcf_paths), seq_along(missing_paths)) - 1L, + path = normalizePath(c(tree_paths, vcf_paths, missing_paths), mustWork = FALSE), + stringsAsFactors = FALSE +) +knitr::kable(python_files) + +library(reticulate) +files_obj <- lapply(seq_len(nrow(python_files)), function(i) { + as.list(python_files[i, , drop = FALSE]) +}) +reticulate::py_run_string("generated_files = r.files_obj") +``` + +```{python compare-generated-tree-files} +from pathlib import Path +import tskit + +for row in generated_files: + ts_path = Path(row["path"]) + ts = tskit.load(ts_path) + print(row["label"]) + print(" path:", ts_path) + print(" nodes:", ts.num_nodes) + print(" edges:", ts.num_edges) + print(" trees:", ts.num_trees) + print(" sites:", ts.num_sites) + print(" mutations:", ts.num_mutations) +``` + +Print the first tree for chromosome 0 from each generated input path. + +```{python print-first-tree} +from pathlib import Path +import tskit + +for row in generated_files: + if int(row["chr"]) != 0: + continue + ts_path = Path(row["path"]) + ts = tskit.load(ts_path) + + print(f"\n{row['label']}") + print(" path:", ts_path) + print(" trees:", ts.num_trees) + print(" nodes:", ts.num_nodes) + print(" edges:", ts.num_edges) + print(ts.first().draw_text()) +``` + +Print one corresponding non-missing chr0 node from the tree-input and VCF-input +outputs. The numeric node IDs differ because the tree-input output keeps the +original source ancestry and source nodes, while the VCF-input output starts +from synthetic founder nodes only. The AlphaSimR node metadata identifies the +same logical node. + +```{python print-specific-corresponding-node} +from pathlib import Path +import json +import tskit + +def generated_path(source, chr_index): + for row in generated_files: + if row["source"] == source and int(row["chr"]) == chr_index: + return Path(row["path"]) + raise ValueError(f"No generated file for source={source}, chr={chr_index}") + +def alpha_node_id(node): + meta = node.metadata + if isinstance(meta, bytes): + meta = json.loads(meta.decode("utf-8")) if meta else {} + return meta.get("alphaSimR", {}).get("id") + +tree_chr0 = tskit.load(generated_path("tree_input", 0)) +vcf_chr0 = tskit.load(generated_path("vcf_input", 0)) + +tree_node = tree_chr0.node(260) +vcf_node = vcf_chr0.node(4) + +print(tree_node) +print("individual:", tree_chr0.individual(tree_node.individual)) +print(vcf_node) +print("individual:", vcf_chr0.individual(vcf_node.individual)) + +print(" same AlphaSimR node id:", alpha_node_id(tree_node) == alpha_node_id(vcf_node)) +print(" AlphaSimR node id:", alpha_node_id(tree_node)) +print(" same flags:", tree_node.flags == vcf_node.flags) +print(" same time:", tree_node.time == vcf_node.time) +print(" same population:", tree_node.population == vcf_node.population) +``` + +Print and draw pedigrees from the generated files, following the same style as +`testTsForwardRecorder.Rmd`. + +```{python print-pedigrees} +from pathlib import Path +import tskit +from matplotlib import pyplot as plt +import networkx as nx + +def draw_pedigree(ped_ts, title): + plt.figure(figsize=(8, 5)) + + G = nx.DiGraph() + for ind in ped_ts.individuals(): + if len(ind.nodes) == 0: + continue + time = ped_ts.node(ind.nodes[0]).time + pop = ped_ts.node(ind.nodes[0]).population + G.add_node(ind.id, time=time, population=pop) + for p in ind.parents: + if p != tskit.NULL: + G.add_edge(ind.id, p) + + pos = nx.multipartite_layout(G, subset_key="time", align="horizontal") + colours = plt.rcParams["axes.prop_cycle"].by_key()["color"] + node_colours = [ + colours[attr["population"] % len(colours)] + for attr in G.nodes.values() + ] + + nx.draw_networkx(G, pos, with_labels=True, node_color=node_colours) + plt.title(title) + plt.show() + plt.close() + +print(generated_files) +for row in generated_files: + if row["label"] not in ["tree input chr1", "vcf input chr1", "vcf missing input chr1"]: + continue + + print(row) + ts = tskit.load(row["path"]) + print(f"\n{row['label']}") + draw_pedigree(ts, row["label"]) +``` + +## Effect Of `addTsMut` + +For VCF input, `addTsMut` only controls whether retained VCF marker states are +materialized into the initial TS site/mutation tables. It should not change the +forward recorder's pedigree, nodes, edges, or tree intervals. With +`addTsMut=TRUE`, the output gains: + +- one site row per retained VCF marker position; +- one mutation row for each founder haplotype carrying allele `1` at that site. + +```{r addTsMut-comparison} +vcf_founder_add_mut <- importVCF( + vcfFile = file.path(out_dir, "msprime_combined.vcf"), + breaks = list(chr0 = chr_info[[1L]]$breaks, chr1 = chr_info[[2L]]$breaks), + rates = list(chr0 = chr_info[[1L]]$rates, chr1 = chr_info[[2L]]$rates), + segSites = c(chr0 = 60L, chr1 = 155L), + siteSamplingSeed = 42L, + missing = "error", + tsRecord = TRUE, + addTsMut = TRUE, + returnMeta = TRUE +) + +vcf_run_add_mut <- run_standard_forward(vcf_founder_add_mut$pop, seed = 42L) +vcf_paths_add_mut <- AlphaSimR:::tsForwardFinalizeFromSimParam( + vcf_run_add_mut$SP, + out_dir = out_dir, + out_basename = "standard_msprime_vcf_addTsMut_forward_recorder", + clear = TRUE +) + +tskit <- reticulate::import("tskit") +ts_counts <- function(paths, addTsMut) { + do.call(rbind, lapply(seq_along(paths), function(i) { + ts <- tskit$load(paths[[i]]) + data.frame( + addTsMut = addTsMut, + chr = i - 1L, + nodes = as.integer(ts$num_nodes), + edges = as.integer(ts$num_edges), + trees = as.integer(ts$num_trees), + sites = as.integer(ts$num_sites), + mutations = as.integer(ts$num_mutations), + stringsAsFactors = FALSE + ) + })) +} + +addTsMut_counts <- rbind( + ts_counts(vcf_paths, addTsMut = FALSE), + ts_counts(vcf_paths_add_mut, addTsMut = TRUE) +) +knitr::kable(addTsMut_counts) + +addTsMut_wide <- merge( + addTsMut_counts[addTsMut_counts$addTsMut == FALSE, ], + addTsMut_counts[addTsMut_counts$addTsMut == TRUE, ], + by = "chr", + suffixes = c("_false", "_true") +) +addTsMut_checks <- data.frame( + chr = addTsMut_wide$chr, + same_nodes = addTsMut_wide$nodes_false == addTsMut_wide$nodes_true, + same_edges = addTsMut_wide$edges_false == addTsMut_wide$edges_true, + same_trees = addTsMut_wide$trees_false == addTsMut_wide$trees_true, + sites_added = addTsMut_wide$sites_false == 0L & addTsMut_wide$sites_true > 0L, + mutations_added = addTsMut_wide$mutations_false == 0L & addTsMut_wide$mutations_true > 0L, + stringsAsFactors = FALSE +) +knitr::kable(addTsMut_checks) +stopifnot(all(addTsMut_checks[, -1L])) +``` diff --git a/dev/test_Rcpptskit_out.Rmd b/dev/test_Rcpptskit_out.Rmd new file mode 100644 index 00000000..ecc33dca --- /dev/null +++ b/dev/test_Rcpptskit_out.Rmd @@ -0,0 +1,125 @@ +--- +title: "test_Rcpptskit_out" +output: html_document +date: "2026-04-01" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +## R Markdown + +This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see . + +When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this: + +```{r cars} +summary(cars) +``` + +## Including Plots + +You can also embed plots, for example: + +```{r pressure, echo=FALSE} +plot(pressure) +``` + +Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot. + +``` +> library(reticulate) +> use_virtualenv("~/r-reticulate-env", required = TRUE) +> tskit <- import("tskit") +> devtools::load_all() +ℹ Loading AlphaSimR +> L1 <- 1e6 +> L2 <- 2e6 +> # here, use the same recombination map as used in msprime +> chr_info <- list( ++ list(ts_path=".dev/testData/msprime_chr0.trees", ++ breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), ++ list(ts_path="dev/testData/msprime_chr1.trees", ++ breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) ++ ) +> founderGenomes1 <- asMapPopPy(chr_info = chr_info, inbred=FALSE, ploidy=2L) +Error in py_call_impl(callable, call_args$unnamed, call_args$named) : + FileNotFoundError: [Errno 2] No such file or directory: '.dev/testData/msprime_chr0.trees' +Run `reticulate::py_last_error()` for details. +Called from: py_call_impl(callable, call_args$unnamed, call_args$named) + +Browse[1]> +> L1 <- 1e6 +> L2 <- 2e6 +> # here, use the same recombination map as used in msprime +> chr_info <- list( ++ list(ts_path="dev/testData/msprime_chr0.trees", ++ breaks=c(0, L1/2, L1), rates=c(1e-8, 2e-8), segSites=60), ++ list(ts_path="dev/testData/msprime_chr1.trees", ++ breaks=c(0, L2/3, 2*L2/3, L2), rates=c(1e-7, 1e-8, 1e-7), segSites=155) ++ ) +> founderGenomes1 <- asMapPopPy(chr_info = chr_info, inbred=FALSE, ploidy=2L) +60 variants sampled (Random seed: 42) +60 variants sampled (Random seed: 42) +155 variants sampled (Random seed: 42) +155 variants sampled (Random seed: 42) +> set.seed(42) +> SP = SimParam$new(founderGenomes1) +> SP$setSexes("yes_sys") +> SP$addTraitA(nQtlPerChr = 5, ++ mean = 500, ++ var = 450) +> +> SP$setTrackPed(TRUE) +> # try the new function here, it automatically set setTrackRec also. +> SP$setTrackRecGen(TRUE) +> basePop = newPop(founderGenomes1) +> basePop = setPheno(basePop, ++ h2 = 0.5) +> +> #--- n generations +> nCycles<-2 +> +> # very simple container for each cycles sim output +> simOutput<-list(basePop) +> cycle<-1 +> for(cycle in 1:nCycles){ ++ cat(paste0(" C",cycle)) ++ # choose the best from last cycle ++ chosenParents<- selectInd(pop=simOutput[[cycle]], nInd=6, use = "gv") ++ # make crosses ++ offspringPop<-randCross(pop=chosenParents, nCrosses=2, nProgeny = 5) ++ # phenotype new offspring ++ offspringPop<-setPheno(pop = offspringPop, h2 = 0.5) ++ # add new offspring to simOutput list ++ simOutput[[cycle+1]]<-offspringPop ++ } + C1 C2 +Warning message: +In selectInd(pop = simOutput[[cycle]], nInd = 6, use = "gv") : + Suitable candidates smaller than nInd, returning 2 individuals + +> rm(tskit) +> tskit +Error: object 'tskit' not found + +> library(RcppTskit) +> bridgeCollectSegGenFromSimOutput(SP, simOutput) +> bridgeWriteTrees(chr_info, do.call(rbind, bridgeSegDfListGen), SP) +Wrote: dev/testData/AlphaSimR_extended_chr0.trees +Wrote: dev/testData/AlphaSimR_extended_chr1.trees +> source("dev/alphaSimR2TsPy.R") +> source("dev/alphaSimR2TsGenPy.R") +> bridgeCollectSegGenFromSimOutputPy(SP, simOutput) +> rm(bridgeSegDfListGen) +> rm(indIdMapByChr) +> rm(nodeIdMapByChr) +> rm(list = lsf.str()) +> source("dev/alphaSimR2TsPy.R") +> source("dev/alphaSimR2TsGenPy.R") +> bridgeCollectSegGenFromSimOutputPy(SP, simOutput) +> bridgeWriteTreesPy(chr_info, do.call(rbind, bridgeSegDfListGen), SP) +Wrote: dev/testData/AlphaSimR_extended_chr0.trees +Wrote: dev/testData/AlphaSimR_extended_chr1.trees +``` diff --git a/dev/test_runMaCSTS.txt.rtf b/dev/test_runMaCSTS.txt.rtf new file mode 100644 index 00000000..0149bc3f --- /dev/null +++ b/dev/test_runMaCSTS.txt.rtf @@ -0,0 +1,46 @@ +{\rtf1\ansi\ansicpg1252\cocoartf2822 +\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +{\*\expandedcolortbl;;} +\paperw11900\paperh16840\margl1440\margr1440\vieww11520\viewh8400\viewkind0 +\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural\partightenfactor0 + +\f0\fs24 \cf0 args <- "4 10000 -t 1e-3 -r 1e-2 -s "\ +seed <- as.integer(12345)\ +\ +# Legacy MaCS output (haplotypes/genMap)\ +macs <- AlphaSimR:::MaCS(\ + args = args, maxSites = as.integer(0), # keep all sites\ + inbred = FALSE, ploidy = 2L, nThreads = 1L, seed = seed\ +)\ +\ +n_sites <- length(macs$genMap[[1]])\ +hap_macs <- matrix(\ + as.integer(hap_macs),\ + nrow = nrow(hap_macs),\ + ncol = ncol(hap_macs),\ + dimnames = dimnames(hap_macs)\ +)\ +\ +\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural\partightenfactor0 +\cf0 hap_macs\ +macs$genMap[[1]]\ +\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural\partightenfactor0 +\cf0 \ +# MaCSTS with MaCS mutation path\ +out_ts <- AlphaSimR:::MaCSTS(\ + args = args, nChr=1,\ + inbred = FALSE, ploidy = 2L, nThreads = 1L, seed = seed,\ + usePhysicalPositions = FALSE,\ + useMacsMut = TRUE,\ + expandInbredSamples = FALSE\ +)\ +\ +tc <- RcppTskit::TableCollection$new(xptr = out_ts$tables[[1]])\ +ts <- tc$tree_sequence()\ +ts$write('dev/testData/MaCSTS.trees')\ +\ +ts_macsts = tskit.load('/Users/jliang2/R_scripts/AlphaSimR_test/dev/testData/MaCSTS.trees')\ +ts_macsts.genotype_matrix()\ +for site in ts_macsts.sites():\ + print(site.position)} \ No newline at end of file diff --git a/man/HybridPop-class.Rd b/man/HybridPop-class.Rd index c1792d29..1c8d491a 100644 --- a/man/HybridPop-class.Rd +++ b/man/HybridPop-class.Rd @@ -3,12 +3,12 @@ \docType{class} \name{HybridPop-class} \alias{HybridPop-class} -\alias{[,HybridPop-method} +\alias{[,HybridPop,ANY,ANY,ANY-method} \alias{c,HybridPop-method} \alias{isHybridPop} \title{Hybrid population} \usage{ -\S4method{[}{HybridPop}(x, i) +\S4method{[}{HybridPop,ANY,ANY,ANY}(x, i) \S4method{c}{HybridPop}(x, ...) @@ -27,7 +27,7 @@ Memory is saved by not storing genotypic data. } \section{Methods (by generic)}{ \itemize{ -\item \code{[}: Extract HybridPop using index or id +\item \code{x = HybridPop[i = ANY, j = ANY, drop = ANY]}: Extract HybridPop using index or id \item \code{c(HybridPop)}: Combine multiple HybridPops diff --git a/man/MapPop-class.Rd b/man/MapPop-class.Rd index c9b532b7..e13a1f20 100644 --- a/man/MapPop-class.Rd +++ b/man/MapPop-class.Rd @@ -3,12 +3,12 @@ \docType{class} \name{MapPop-class} \alias{MapPop-class} -\alias{[,MapPop-method} +\alias{[,MapPop,ANY,ANY,ANY-method} \alias{c,MapPop-method} \alias{isMapPop} \title{Raw population with genetic map} \usage{ -\S4method{[}{MapPop}(x, i) +\S4method{[}{MapPop,ANY,ANY,ANY}(x, i) \S4method{c}{MapPop}(x, ...) @@ -29,7 +29,7 @@ for creating initial populations and setting traits in the } \section{Methods (by generic)}{ \itemize{ -\item \code{[}: Extract MapPop by index +\item \code{x = MapPop[i = ANY, j = ANY, drop = ANY]}: Extract MapPop by index \item \code{c(MapPop)}: Combine multiple MapPops diff --git a/man/MultiPop-class.Rd b/man/MultiPop-class.Rd index 8d8b37d4..2560be21 100644 --- a/man/MultiPop-class.Rd +++ b/man/MultiPop-class.Rd @@ -4,11 +4,11 @@ \name{MultiPop-class} \alias{MultiPop-class} \alias{show,MultiPop-method} -\alias{[,MultiPop-method} +\alias{[,MultiPop,ANY,ANY,ANY-method} \alias{[[,MultiPop-method} \alias{$,MultiPop-method} \alias{names,MultiPop-method} -\alias{[<-,MultiPop-method} +\alias{[<-,MultiPop,ANY,ANY,ANY-method} \alias{[[<-,MultiPop-method} \alias{$<-,MultiPop-method} \alias{names<-,MultiPop-method} @@ -19,7 +19,7 @@ \usage{ \S4method{show}{MultiPop}(object) -\S4method{[}{MultiPop}(x, i) +\S4method{[}{MultiPop,ANY,ANY,ANY}(x, i) \S4method{[[}{MultiPop}(x, i) @@ -27,7 +27,7 @@ \S4method{names}{MultiPop}(x) -\S4method{[}{MultiPop}(x, i) <- value +\S4method{[}{MultiPop,ANY,ANY,ANY}(x, i) <- value \S4method{[[}{MultiPop}(x, i) <- value @@ -63,17 +63,17 @@ and can hence have a nested structure - see examples in \code{\link{newMultiPop} \itemize{ \item \code{show(MultiPop)}: Show MultiPop object summary -\item \code{[}: Subset MultiPop by index +\item \code{x = MultiPop[i = ANY, j = ANY, drop = ANY]}: Subset MultiPop by index -\item \code{[[}: Extract a population by index +\item \code{MultiPop[[]]}: Extract a population by index \item \code{$}: Extract a population by name \item \code{names(MultiPop)}: Access names of pops in MultiPop -\item \code{`[`(MultiPop) <- value}: Replace contents of a subset of elements in MultiPop +\item \code{x = MultiPop[i = ANY, j = ANY] <- value}: Replace contents of a subset of elements in MultiPop -\item \code{`[[`(MultiPop) <- value}: Replace contents of a single element in MultiPop +\item \code{MultiPop[[]] <- value}: Replace contents of a single element in MultiPop \item \code{`$`(MultiPop) <- value}: Replace contents of a single element in MultiPop by name diff --git a/man/NamedMapPop-class.Rd b/man/NamedMapPop-class.Rd index 511dbb0b..bb9da392 100644 --- a/man/NamedMapPop-class.Rd +++ b/man/NamedMapPop-class.Rd @@ -3,12 +3,12 @@ \docType{class} \name{NamedMapPop-class} \alias{NamedMapPop-class} -\alias{[,NamedMapPop-method} +\alias{[,NamedMapPop,ANY,ANY,ANY-method} \alias{c,NamedMapPop-method} \alias{isNamedMapPop} \title{Raw population with genetic map and id} \usage{ -\S4method{[}{NamedMapPop}(x, i) +\S4method{[}{NamedMapPop,ANY,ANY,ANY}(x, i) \S4method{c}{NamedMapPop}(x, ...) @@ -26,7 +26,7 @@ Extends \code{\link{MapPop-class}} with id, mother and father. } \section{Methods (by generic)}{ \itemize{ -\item \code{[}: Extract NamedMapPop by index +\item \code{x = NamedMapPop[i = ANY, j = ANY, drop = ANY]}: Extract NamedMapPop by index \item \code{c(NamedMapPop)}: Combine multiple NamedMapPops diff --git a/man/Pop-class.Rd b/man/Pop-class.Rd index 7fc8b626..3eb99933 100644 --- a/man/Pop-class.Rd +++ b/man/Pop-class.Rd @@ -3,13 +3,13 @@ \docType{class} \name{Pop-class} \alias{Pop-class} -\alias{[,Pop-method} +\alias{[,Pop,ANY,ANY,ANY-method} \alias{c,Pop-method} \alias{show,Pop-method} \alias{length,Pop-method} \title{Population} \usage{ -\S4method{[}{Pop}(x, i) +\S4method{[}{Pop,ANY,ANY,ANY}(x, i) \S4method{c}{Pop}(x, ...) @@ -32,7 +32,7 @@ phenotypes, and pedigrees. } \section{Methods (by generic)}{ \itemize{ -\item \code{[}: Extract Pop by index or id +\item \code{x = Pop[i = ANY, j = ANY, drop = ANY]}: Extract Pop by index or id \item \code{c(Pop)}: Combine multiple Pops diff --git a/man/RawPop-class.Rd b/man/RawPop-class.Rd index 254358d1..6c3700d7 100644 --- a/man/RawPop-class.Rd +++ b/man/RawPop-class.Rd @@ -3,13 +3,13 @@ \docType{class} \name{RawPop-class} \alias{RawPop-class} -\alias{[,RawPop-method} +\alias{[,RawPop,ANY,ANY,ANY-method} \alias{c,RawPop-method} \alias{show,RawPop-method} \alias{isRawPop} \title{Raw Population} \usage{ -\S4method{[}{RawPop}(x, i) +\S4method{[}{RawPop,ANY,ANY,ANY}(x, i) \S4method{c}{RawPop}(x, ...) @@ -31,7 +31,7 @@ The raw population class contains only genotype data. } \section{Methods (by generic)}{ \itemize{ -\item \code{[}: Extract RawPop by index +\item \code{x = RawPop[i = ANY, j = ANY, drop = ANY]}: Extract RawPop by index \item \code{c(RawPop)}: Combine multiple RawPops diff --git a/man/SimParam.Rd b/man/SimParam.Rd index c06b5b74..8e9afdb3 100644 --- a/man/SimParam.Rd +++ b/man/SimParam.Rd @@ -403,6 +403,10 @@ genetic map} \item{\code{recHist}}{list of historic recombination events} + \item{\code{isTrackRecGen}}{is genetic-coordinate recombination being tracked.} + + \item{\code{recHistGen}}{list of historic genetic-coordinate recombination events.} + \item{\code{haplotypes}}{list of computed IBD haplotypes} \item{\code{varA}}{additive genetic variance in founderPop} @@ -426,6 +430,8 @@ relative to all active QTL} \item \href{#method-SimParam-initialize}{\code{SimParam$new()}} \item \href{#method-SimParam-setTrackPed}{\code{SimParam$setTrackPed()}} \item \href{#method-SimParam-setTrackRec}{\code{SimParam$setTrackRec()}} + \item \href{#method-SimParam-setTrackRecGen}{\code{SimParam$setTrackRecGen()}} + \item \href{#method-SimParam-setTrackTs}{\code{SimParam$setTrackTs()}} \item \href{#method-SimParam-resetPed}{\code{SimParam$resetPed()}} \item \href{#method-SimParam-restrSegSites}{\code{SimParam$restrSegSites()}} \item \href{#method-SimParam-setSexes}{\code{SimParam$setSexes()}} @@ -570,6 +576,51 @@ SP$setTrackRec(TRUE) } } +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SimParam-setTrackRecGen}{}}} +\subsection{\code{SimParam$setTrackRecGen()}}{ + Sets genetic-coordinate recombination tracking for the simulation. +By default this is turned off. When turned on, it will also turn on pedigree tracking. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{SimParam$setTrackRecGen(isTrackRecGen, force = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{isTrackRecGen}}{should genetic-coordinate recombination tracking be on.} + \item{\code{force}}{should the check for a running simulation be ignored.} + } + \if{html}{\out{
}} + } +} + +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SimParam-setTrackTs}{}}} +\subsection{\code{SimParam$setTrackTs()}}{ + Sets forward tree-sequence tracking on/off. +When enabled, this also enables genetic-coordinate recombination +tracking and can initialize the forward TS recorder immediately. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{SimParam$setTrackTs(isTrackTs, founderPop = NULL, force = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{isTrackTs}}{should forward tree-sequence tracking be on.} + \item{\code{founderPop}}{founder/sample population used to seed TS node maps. +Required on enable if no recorder is already attached.} + \item{\code{force}}{should the check for a running simulation be ignored.} + } + \if{html}{\out{
}} + } +} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-SimParam-resetPed}{}}} @@ -1807,7 +1858,16 @@ be metacentric.} For internal use only. \subsection{Usage}{ \if{html}{\out{
}} - \preformatted{SimParam$addToRec(lastId, id, mother, father, isDH, hist, ploidy)} + \preformatted{SimParam$addToRec( + lastId, + id, + mother, + father, + isDH, + hist, + histGen = NULL, + ploidy +)} \if{html}{\out{
}} } \subsection{Arguments}{ @@ -1819,6 +1879,7 @@ be metacentric.} \item{\code{father}}{vector of father iids} \item{\code{isDH}}{indicator for DH lines} \item{\code{hist}}{new recombination history} + \item{\code{histGen}}{new recombination history (genetic coordinate)} \item{\code{ploidy}}{ploidy level} } \if{html}{\out{}} diff --git a/man/asMapPop.Rd b/man/asMapPop.Rd new file mode 100644 index 00000000..31b2768e --- /dev/null +++ b/man/asMapPop.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/makeFoundersFromTs.R +\name{asMapPop} +\alias{asMapPop} +\title{Build a MapPop from Tree Sequence Data} +\usage{ +asMapPop( + chr_info, + ploidy = 2L, + inbred = FALSE, + segSites = NULL, + site_sampling_seed = 42L, + nThreads = NULL, + returnMeta = FALSE +) +} +\arguments{ +\item{chr_info}{Input tree-sequence data. Supports either: +1) explicit per-chromosome list entries with \code{ts_path}, +\code{ts}, or \code{tc_xptr} plus \code{breaks} and \code{rates}; or +2) bundle style list containing \code{tables} or \code{ts} plus map +metadata.} + +\item{ploidy}{Integer ploidy used to construct the resulting +\code{\link{MapPop-class}}.} + +\item{inbred}{Logical; whether resulting individuals are inbred.} + +\item{segSites}{Optional site-count override (scalar or per chromosome).} + +\item{site_sampling_seed}{Integer seed used when downsampling segregating sites.} + +\item{nThreads}{Optional chromosome-level worker count.} + +\item{returnMeta}{Logical; if \code{TRUE}, return list with \code{pop}, +\code{keptPosBp}, and \code{chrData}; otherwise return +\code{\link{MapPop-class}} only.} +} +\value{ +A \code{\link{MapPop-class}} object, or metadata list if +\code{returnMeta = TRUE}. +} +\description{ +Converts one or more tree sequences to an AlphaSimR +\code{\link{MapPop-class}} by extracting biallelic segregating variants and +mapping tree-sequence coordinates through a recombination map. The resulting +population keeps the metadata needed for forward tree-sequence recording. +} +\details{ +Each chromosome must provide tree-sequence input and a recombination map. +The map is supplied as \code{breaks} and \code{rates}, where +\code{breaks} are tree-sequence coordinate breakpoints and \code{rates} are +recombination rates for the corresponding intervals. The physical or +tree-sequence coordinates of retained variants are stored on the returned +population as \code{tsForwardPosMeta}. + +If \code{segSites} is supplied, biallelic segregating variants are sampled +with reservoir sampling using \code{site_sampling_seed}. Non-biallelic and +non-segregating variants are ignored. +} +\examples{ +\dontrun{ +chr_info = list(list( + ts_path="dev/testData/msprime_chr0.trees", + breaks=c(0, 1), + rates=c(1) +)) +founderPop = asMapPop(chr_info=chr_info, ploidy=2L) +} + +} diff --git a/man/dot-newPop.Rd b/man/dot-newPop.Rd index 2a577f61..cdba8346 100644 --- a/man/dot-newPop.Rd +++ b/man/dot-newPop.Rd @@ -15,6 +15,7 @@ femaleParentPop = NULL, maleParentPop = NULL, hist = NULL, + histGen = NULL, simParam = NULL, nThreads = NULL, ... diff --git a/man/figures/addInd.png b/man/figures/addInd.png new file mode 100644 index 00000000..57ba0b11 Binary files /dev/null and b/man/figures/addInd.png differ diff --git a/man/figures/originInd.png b/man/figures/originInd.png new file mode 100644 index 00000000..be6c1489 Binary files /dev/null and b/man/figures/originInd.png differ diff --git a/man/importVCF.Rd b/man/importVCF.Rd new file mode 100644 index 00000000..b9b45a02 --- /dev/null +++ b/man/importVCF.Rd @@ -0,0 +1,123 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/importData.R +\name{importVCF} +\alias{importVCF} +\title{Import VCF haplotypes} +\usage{ +importVCF( + vcfFile, + breaks, + rates, + segSites = NULL, + siteSamplingSeed = 42L, + ploidy = NULL, + ped = NULL, + missing = c("filter", "error"), + requirePhased = TRUE, + useVCFIds = TRUE, + tsRecord = FALSE, + tsRecorde = NULL, + addTsMut = TRUE, + seqLen = NULL, + returnMeta = FALSE +) +} +\arguments{ +\item{vcfFile}{path to a VCF file. Plain text and gzip-compressed files are +supported.} + +\item{breaks}{recombination map breakpoints. Supply either a numeric vector +used for every chromosome, or a list of numeric vectors with one entry per +chromosome. Named lists are matched to VCF chromosome names.} + +\item{rates}{recombination rates for the intervals defined by \code{breaks}. +Supply either a numeric vector used for every chromosome, or a list of +numeric vectors with one entry per chromosome. Each rates vector must have +length \code{length(breaks) - 1}.} + +\item{segSites}{optional number of segregating sites to keep per chromosome. +If \code{NULL}, all qualifying sites are retained. A scalar value is used for +every chromosome. A vector or list can be supplied per chromosome; named +values are matched to VCF chromosome names.} + +\item{siteSamplingSeed}{integer seed used for reservoir sampling.} + +\item{ploidy}{optional ploidy level. If \code{NULL}, ploidy is inferred from +the VCF genotype calls and checked for consistency.} + +\item{ped}{an optional pedigree for the supplied genotypes. See details.} + +\item{missing}{how to handle missing genotype calls. Use \code{"filter"} to +drop sites with missing calls or \code{"error"} to stop.} + +\item{requirePhased}{if \code{TRUE}, genotype calls with \code{/} separators +are rejected.} + +\item{useVCFIds}{if \code{TRUE} and \code{ped} is \code{NULL}, VCF sample IDs +are used to return a \code{\link{NamedMapPop-class}}.} + +\item{tsRecord}{if \code{TRUE}, initialize in-memory founder tree-sequence +tables from the imported VCF haplotypes and attach metadata for +\code{SimParam$setTrackTs(TRUE, founderPop=...)}.} + +\item{tsRecorde}{deprecated alias for \code{tsRecord}.} + +\item{addTsMut}{if \code{TRUE} and \code{tsRecord=TRUE}, add retained VCF +sites and allele-1 calls as synthetic tskit site/mutation rows. If +\code{FALSE}, initialize only founder individuals and sample nodes, leaving +the TS site and mutation tables empty.} + +\item{seqLen}{optional chromosome sequence lengths for \code{tsRecord=TRUE}. +Supply either a scalar, vector, or list. Named values are matched to VCF +chromosome names. If \code{NULL}, the maximum breakpoint for each chromosome +is used.} + +\item{returnMeta}{if \code{TRUE}, return a list containing the population, +retained physical positions, sample IDs, and scan statistics.} +} +\value{ +a \code{\link{MapPop-class}} or \code{\link{NamedMapPop-class}}. If +\code{returnMeta = TRUE}, a list with elements \code{pop}, \code{keptPos}, +\code{sampleIds}, \code{stats}, and, when \code{tsRecord=TRUE}, +\code{tsTables}. +} +\description{ +Streams a VCF file and imports phased genotype calls as founder +haplotypes. Sites are filtered to biallelic segregating sites, missing +genotype calls are filtered or rejected, and optional reservoir sampling is +applied independently within each chromosome. +} +\details{ +The optional pedigree follows the same format as \code{\link{importHaplo}}. +If the object is a data.frame or matrix, the first three columns must include +id, mother, and father. If the object is a vector, it is assumed to only +include the id. In this case, the mother and father will be set to \code{"0"} +for all individuals. + +A site is retained only when it has a single ALT allele, every non-missing +genotype allele is coded as 0 or 1, and both alleles are observed in the +founder haplotypes. + +When \code{tsRecord=TRUE} and \code{addTsMut=TRUE}, duplicate retained +physical positions within a chromosome are not allowed because tskit requires +strictly increasing site positions. +} +\examples{ +\dontrun{ +founderPop = importVCF("founders.vcf.gz", + breaks=list(c(0, 1e8)), + rates=list(c(1e-8)), + segSites=1000) + +# Initialize founder tree-sequence tables for forward recording. +founderPopTs = importVCF("founders.vcf.gz", + breaks=list(c(0, 1e8)), + rates=list(c(1e-8)), + segSites=1000, + tsRecord=TRUE, + addTsMut=FALSE) +SP = SimParam$new(founderPopTs) +SP$setTrackTs(TRUE, founderPop=founderPopTs) +} + +} diff --git a/man/runMacsTS.Rd b/man/runMacsTS.Rd new file mode 100644 index 00000000..4b7ecfb4 --- /dev/null +++ b/man/runMacsTS.Rd @@ -0,0 +1,102 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runMacsTs.R +\name{runMacsTS} +\alias{runMacsTS} +\title{Create Founder Haplotypes and Tree Sequences using MaCS} +\usage{ +runMacsTS( + nInd, + nChr = 1, + segSites = NULL, + inbred = FALSE, + species = "GENERIC", + split = NULL, + ploidy = 2L, + manualCommand = NULL, + manualGenLen = NULL, + nThreads = NULL, + mutationMode = c("postTs", "macs", "none"), + usePhysicalPositions = FALSE, + Nref = NA_real_, + seed = NULL, + mutSeed = NULL, + mutSeedOffset = 104729L, + siteSamplingSeed = 42L, + expandInbredTs = FALSE, + returnTs = FALSE +) +} +\arguments{ +\item{nInd}{Integer number of individuals to simulate.} + +\item{nChr}{Integer number of chromosomes.} + +\item{segSites}{Optional site-count cap per chromosome (scalar or vector).} + +\item{inbred}{Logical.} + +\item{species}{Species preset used by \code{\link{runMacs}}.} + +\item{split}{Optional population split time in generations.} + +\item{ploidy}{Integer ploidy.} + +\item{manualCommand}{Optional MaCS command tail (advanced users).} + +\item{manualGenLen}{Optional genetic length(s) in Morgan.} + +\item{nThreads}{Optional thread count.} + +\item{mutationMode}{One of \code{"postTs"}, \code{"macs"}, or +\code{"none"}.} + +\item{usePhysicalPositions}{Logical; TS coordinates in bp if \code{TRUE}.} + +\item{Nref}{Optional reference \code{Ne} for time scaling.} + +\item{seed}{Optional integer vector (length 1 or \code{nChr}) for ancestry.} + +\item{mutSeed}{Optional integer vector (length 1 or \code{nChr}) for +post-TS mutation.} + +\item{mutSeedOffset}{Integer offset used when deriving post-TS mutation seeds.} + +\item{siteSamplingSeed}{Integer seed for \code{\link{asMapPop}} site +sampling.} + +\item{expandInbredTs}{Logical; whether to expand inbred TS sample leaves before conversion.} + +\item{returnTs}{Logical; return TS tables and metadata alongside +\code{\link{MapPop-class}}.} +} +\value{ +\code{\link{MapPop-class}} by default; otherwise a list with +\code{pop}, \code{tables}, and metadata. +} +\description{ +Tree-sequence analogue of \code{\link{runMacs}}. This function simulates +MaCS ancestry, optionally adds mutations, converts the resulting tree +sequence data to a \code{\link{MapPop-class}}, and can return the founder +table collections for forward tree-sequence recording. +} +\details{ +\code{mutationMode = "postTs"} first creates ancestry tables and then calls +\code{\link{simMut}} to place mutations. \code{mutationMode = "macs"} keeps +the mutation placement from the native MaCS path. \code{mutationMode = "none"} +returns ancestry-only tables and requires \code{returnTs = TRUE}. + +When \code{returnTs = TRUE}, the returned population keeps +\code{tsForwardSource} and \code{tsForwardPosMeta} attributes that can be used +by \code{SimParam$setTrackTs(TRUE, founderPop=...)}. +} +\examples{ +\dontrun{ +founderPop = runMacsTS(nInd=10, nChr=1, segSites=100) + +out = runMacsTS(nInd=10, nChr=1, segSites=100, returnTs=TRUE) +SP = SimParam$new(out$pop) +SP$setTrackTs(TRUE, founderPop=out$pop) +paths = tsForwardFinalizeFromSimParam(SP, out_dir=tempdir()) +} + +} diff --git a/man/simAnc.Rd b/man/simAnc.Rd new file mode 100644 index 00000000..3f751651 --- /dev/null +++ b/man/simAnc.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runMacsTs.R +\name{simAnc} +\alias{simAnc} +\title{Simulate MaCS Ancestry as Tree-Sequence Tables} +\usage{ +simAnc( + args, + nChr, + inbred, + ploidy, + nThreads, + seed, + usePhysicalPositions = FALSE, + Nref = NA_real_ +) +} +\arguments{ +\item{args}{Character MaCS command prefix with trailing \code{-s}.} + +\item{nChr}{Integer number of chromosomes.} + +\item{inbred}{Logical.} + +\item{ploidy}{Integer ploidy.} + +\item{nThreads}{Integer thread count.} + +\item{seed}{Integer vector of chromosome seeds.} + +\item{usePhysicalPositions}{Logical; use bp positions in TS if \code{TRUE}.} + +\item{Nref}{Optional numeric reference \code{Ne} for time scaling.} +} +\value{ +List with ancestry table collections and metadata. +} +\description{ +Runs the MaCS ancestry simulation path and returns one tskit table collection +per chromosome, without adding post-ancestry mutations. This is the staged +ancestry step used by \code{\link{runMacsTS}}. +} +\details{ +This function is useful when ancestry simulation and mutation placement need +to be controlled separately. For the standard founder-population workflow, +use \code{\link{runMacsTS}}. +} +\examples{ +\dontrun{ +cmd = runMacs2(nInd=10, nChr=1, segSites=NULL, returnCommand=TRUE) +anc = simAnc(args=paste0(20, " ", cmd, " -s "), + nChr=1, inbred=FALSE, ploidy=2L, + nThreads=1L, seed=123L) +} + +} diff --git a/man/simMut.Rd b/man/simMut.Rd new file mode 100644 index 00000000..022ab3d0 --- /dev/null +++ b/man/simMut.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runMacsTs.R +\name{simMut} +\alias{simMut} +\title{Add Mutations to Ancestry Tree-Sequence Tables} +\usage{ +simMut(x, dTheta = NULL, seed = NULL) +} +\arguments{ +\item{x}{List returned by \code{\link{simAnc}}, or a list of +table-collection pointers.} + +\item{dTheta}{Optional scalar/vector mutation-rate parameter in MaCS units.} + +\item{seed}{Optional scalar/vector integer seeds for mutation sampling.} +} +\value{ +List with mutated table collections and metadata. +} +\description{ +Adds MaCS-style mutations to table collections returned by +\code{\link{simAnc}}. This is the staged mutation step used by +\code{\link{runMacsTS}} when \code{mutationMode = "postTs"}. +} +\details{ +If \code{dTheta} is omitted and \code{x} is the full list returned by +\code{\link{simAnc}}, the mutation-rate metadata stored by \code{simAnc()} is +used. If \code{seed} is omitted, mutation seeds are derived from the ancestry +seeds when available. +} +\examples{ +\dontrun{ +cmd = runMacs2(nInd=10, nChr=1, segSites=NULL, returnCommand=TRUE) +anc = simAnc(args=paste0(20, " ", cmd, " -s "), + nChr=1, inbred=FALSE, ploidy=2L, + nThreads=1L, seed=123L) +mut = simMut(anc, seed=456L) +} + +} diff --git a/man/tsForwardFinalizeFromSimParam.Rd b/man/tsForwardFinalizeFromSimParam.Rd new file mode 100644 index 00000000..6c62b55f --- /dev/null +++ b/man/tsForwardFinalizeFromSimParam.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tsForwardRecorder.R +\name{tsForwardFinalizeFromSimParam} +\alias{tsForwardFinalizeFromSimParam} +\title{Finalize Forward Tree-Sequence Recording from SimParam} +\usage{ +tsForwardFinalizeFromSimParam( + simParam, + out_dir = NULL, + out_basename = "AlphaSimR_forward", + simplify = FALSE, + keep_unary = TRUE, + update_sample_flags = FALSE, + samples = NULL, + keep_existing_samples = TRUE, + clear = FALSE +) +} +\arguments{ +\item{simParam}{\code{\link{SimParam}} object with an attached recorder, +usually initialized with \code{simParam$setTrackTs(TRUE, founderPop=...)}.} + +\item{out_dir}{output directory. If \code{NULL}, output paths are resolved +from the founder tree-sequence source when possible.} + +\item{out_basename}{output basename.} + +\item{simplify}{logical; if \code{TRUE}, call table-collection simplify +before writing.} + +\item{keep_unary}{logical; passed to \code{tc$simplify(keep_unary=...)} when +\code{simplify=TRUE}.} + +\item{update_sample_flags}{logical; passed to +\code{tc$simplify(update_sample_flags=...)} when \code{simplify=TRUE}. +Default is \code{FALSE}.} + +\item{samples}{optional sample set used when simplifying or when +\code{keep_existing_samples = FALSE}.} + +\item{keep_existing_samples}{logical; if \code{TRUE}, keep founder/original +sample flags when sample updates are requested.} + +\item{clear}{logical; if \code{TRUE}, clear the recorder from +\code{simParam} after writing.} +} +\value{ +Character vector of output tree file paths. +} +\description{ +Finalizes the forward tree-sequence recorder attached to a +\code{\link{SimParam}} object and writes one \code{.trees} file per +chromosome. +} +\examples{ +\dontrun{ +founderPop = runMacsTS(nInd=10, nChr=1, segSites=100) +SP = SimParam$new(founderPop) +SP$setTrackTs(TRUE, founderPop=founderPop) +paths = tsForwardFinalizeFromSimParam(SP, out_dir=tempdir(), + out_basename="AlphaSimR_forward", + clear=TRUE) +} + +} diff --git a/man/tsForwardHasRecorder.Rd b/man/tsForwardHasRecorder.Rd new file mode 100644 index 00000000..b4070966 --- /dev/null +++ b/man/tsForwardHasRecorder.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tsForwardRecorder.R +\name{tsForwardHasRecorder} +\alias{tsForwardHasRecorder} +\title{Check Whether a Forward Tree-Sequence Recorder Is Attached} +\usage{ +tsForwardHasRecorder(simParam) +} +\arguments{ +\item{simParam}{\code{\link{SimParam}} object.} +} +\value{ +Logical scalar. +} +\description{ +Returns whether a \code{\link{SimParam}} object currently has an attached +forward tree-sequence recorder. +} +\examples{ +\dontrun{ +founderPop = runMacsTS(nInd=10, nChr=1, segSites=100) +SP = SimParam$new(founderPop) +tsForwardHasRecorder(SP) +SP$setTrackTs(TRUE, founderPop=founderPop) +tsForwardHasRecorder(SP) +} + +} diff --git a/man/tsForwardWriteTreesFromSimParam.Rd b/man/tsForwardWriteTreesFromSimParam.Rd new file mode 100644 index 00000000..2bd62a31 --- /dev/null +++ b/man/tsForwardWriteTreesFromSimParam.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tsForwardRecorder.R +\name{tsForwardWriteTreesFromSimParam} +\alias{tsForwardWriteTreesFromSimParam} +\title{Write Forward Tree Sequences from SimParam with Explicit Samples} +\usage{ +tsForwardWriteTreesFromSimParam( + simParam, + out_dir = NULL, + out_basename = "AlphaSimR_forward", + simplify = FALSE, + keep_unary = TRUE, + update_sample_flags = FALSE, + samples = NULL, + keep_existing_samples = TRUE, + clear = FALSE +) +} +\arguments{ +\item{simParam}{\code{\link{SimParam}} object with an attached recorder.} + +\item{out_dir}{output directory.} + +\item{out_basename}{output basename.} + +\item{simplify}{logical; if \code{TRUE}, call table-collection simplify +before writing.} + +\item{keep_unary}{logical; passed to \code{tc$simplify(keep_unary=...)} when +\code{simplify=TRUE}. Default is \code{TRUE}.} + +\item{update_sample_flags}{logical; passed to +\code{tc$simplify(update_sample_flags=...)} when \code{simplify=TRUE}. +Default is \code{FALSE}.} + +\item{samples}{\code{NULL} for default last-generation samples, an integer +vector used for all chromosomes, or a list of integer vectors by chromosome.} + +\item{keep_existing_samples}{logical; if \code{TRUE}, keep founder/original +sample flags and add requested samples on top.} + +\item{clear}{logical; if \code{TRUE}, clear the recorder from +\code{simParam} after writing.} +} +\value{ +Character vector of output tree file paths. +} +\description{ +Writes the recorder attached to a \code{\link{SimParam}} object with optional +sample updates and simplification. This is a lower-level variant of +\code{\link{tsForwardFinalizeFromSimParam}} for workflows that need direct +control over sampled nodes. +} +\examples{ +\dontrun{ +founderPop = runMacsTS(nInd=10, nChr=1, segSites=100) +SP = SimParam$new(founderPop) +SP$setTrackTs(TRUE, founderPop=founderPop) +paths = tsForwardWriteTreesFromSimParam(SP, out_dir=tempdir(), + simplify=TRUE) +} + +} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 436411a2..3f9d1990 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -661,8 +661,8 @@ BEGIN_RCPP END_RCPP } // cross -Rcpp::List cross(const arma::field >& motherGeno, arma::uvec mother, const arma::field >& fatherGeno, arma::uvec father, const arma::field& femaleMap, const arma::field& maleMap, bool trackRec, arma::uword motherPloidy, arma::uword fatherPloidy, double v, double p, const arma::vec& motherCentromere, const arma::vec& fatherCentromere, double quadProb, int nThreads); -RcppExport SEXP _AlphaSimR_cross(SEXP motherGenoSEXP, SEXP motherSEXP, SEXP fatherGenoSEXP, SEXP fatherSEXP, SEXP femaleMapSEXP, SEXP maleMapSEXP, SEXP trackRecSEXP, SEXP motherPloidySEXP, SEXP fatherPloidySEXP, SEXP vSEXP, SEXP pSEXP, SEXP motherCentromereSEXP, SEXP fatherCentromereSEXP, SEXP quadProbSEXP, SEXP nThreadsSEXP) { +Rcpp::List cross(const arma::field >& motherGeno, arma::uvec mother, const arma::field >& fatherGeno, arma::uvec father, const arma::field& femaleMap, const arma::field& maleMap, bool trackRec, arma::uword motherPloidy, arma::uword fatherPloidy, double v, double p, const arma::vec& motherCentromere, const arma::vec& fatherCentromere, double quadProb, int nThreads, /* modified by Jinyang */ bool trackRecGen, bool returnRecHistGen, bool recordTsDirect, bool returnTsSegGen, const SEXP directAppendFnSEXP); +RcppExport SEXP _AlphaSimR_cross(SEXP motherGenoSEXP, SEXP motherSEXP, SEXP fatherGenoSEXP, SEXP fatherSEXP, SEXP femaleMapSEXP, SEXP maleMapSEXP, SEXP trackRecSEXP, SEXP motherPloidySEXP, SEXP fatherPloidySEXP, SEXP vSEXP, SEXP pSEXP, SEXP motherCentromereSEXP, SEXP fatherCentromereSEXP, SEXP quadProbSEXP, SEXP nThreadsSEXP, SEXP trackRecGenSEXP, SEXP returnRecHistGenSEXP, SEXP recordTsDirectSEXP, SEXP returnTsSegGenSEXP, SEXP directAppendFnSEXPSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -681,7 +681,12 @@ BEGIN_RCPP Rcpp::traits::input_parameter< const arma::vec& >::type fatherCentromere(fatherCentromereSEXP); Rcpp::traits::input_parameter< double >::type quadProb(quadProbSEXP); Rcpp::traits::input_parameter< int >::type nThreads(nThreadsSEXP); - rcpp_result_gen = Rcpp::wrap(cross(motherGeno, mother, fatherGeno, father, femaleMap, maleMap, trackRec, motherPloidy, fatherPloidy, v, p, motherCentromere, fatherCentromere, quadProb, nThreads)); + Rcpp::traits::input_parameter< /* modified by Jinyang */ bool >::type trackRecGen(trackRecGenSEXP); + Rcpp::traits::input_parameter< bool >::type returnRecHistGen(returnRecHistGenSEXP); + Rcpp::traits::input_parameter< bool >::type recordTsDirect(recordTsDirectSEXP); + Rcpp::traits::input_parameter< bool >::type returnTsSegGen(returnTsSegGenSEXP); + Rcpp::traits::input_parameter< const SEXP >::type directAppendFnSEXP(directAppendFnSEXPSEXP); + rcpp_result_gen = Rcpp::wrap(cross(motherGeno, mother, fatherGeno, father, femaleMap, maleMap, trackRec, motherPloidy, fatherPloidy, v, p, motherCentromere, fatherCentromere, quadProb, nThreads, trackRecGen, returnRecHistGen, recordTsDirect, returnTsSegGen, directAppendFnSEXP)); return rcpp_result_gen; END_RCPP } @@ -885,6 +890,26 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// MaCSTS +Rcpp::List MaCSTS(Rcpp::String args, int nChr, bool inbred, arma::uword ploidy, int nThreads, arma::uvec seed, bool usePhysicalPositions, bool useMacsMut, double Nref, bool expandInbredSamples); +RcppExport SEXP _AlphaSimR_MaCSTS(SEXP argsSEXP, SEXP nChrSEXP, SEXP inbredSEXP, SEXP ploidySEXP, SEXP nThreadsSEXP, SEXP seedSEXP, SEXP usePhysicalPositionsSEXP, SEXP useMacsMutSEXP, SEXP NrefSEXP, SEXP expandInbredSamplesSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< Rcpp::String >::type args(argsSEXP); + Rcpp::traits::input_parameter< int >::type nChr(nChrSEXP); + Rcpp::traits::input_parameter< bool >::type inbred(inbredSEXP); + Rcpp::traits::input_parameter< arma::uword >::type ploidy(ploidySEXP); + Rcpp::traits::input_parameter< int >::type nThreads(nThreadsSEXP); + Rcpp::traits::input_parameter< arma::uvec >::type seed(seedSEXP); + Rcpp::traits::input_parameter< bool >::type usePhysicalPositions(usePhysicalPositionsSEXP); + Rcpp::traits::input_parameter< bool >::type useMacsMut(useMacsMutSEXP); + Rcpp::traits::input_parameter< double >::type Nref(NrefSEXP); + Rcpp::traits::input_parameter< bool >::type expandInbredSamples(expandInbredSamplesSEXP); + rcpp_result_gen = Rcpp::wrap(MaCSTS(args, nChr, inbred, ploidy, nThreads, seed, usePhysicalPositions, useMacsMut, Nref, expandInbredSamples)); + return rcpp_result_gen; +END_RCPP +} // rtsk_table_collection_summary2 Rcpp::List rtsk_table_collection_summary2(const SEXP tc); RcppExport SEXP _AlphaSimR_rtsk_table_collection_summary2(SEXP tcSEXP) { @@ -907,6 +932,101 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// tsMutateTableCollection +void tsMutateTableCollection(const SEXP tc, const double theta, const uint64_t seed); +RcppExport SEXP _AlphaSimR_tsMutateTableCollection(SEXP tcSEXP, SEXP thetaSEXP, SEXP seedSEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP); + Rcpp::traits::input_parameter< const double >::type theta(thetaSEXP); + Rcpp::traits::input_parameter< const uint64_t >::type seed(seedSEXP); + tsMutateTableCollection(tc, theta, seed); + return R_NilValue; +END_RCPP +} +// tsFinalizeInbredTableCollection +void tsFinalizeInbredTableCollection(const SEXP tc, const int ploidy); +RcppExport SEXP _AlphaSimR_tsFinalizeInbredTableCollection(SEXP tcSEXP, SEXP ploidySEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP); + Rcpp::traits::input_parameter< const int >::type ploidy(ploidySEXP); + tsFinalizeInbredTableCollection(tc, ploidy); + return R_NilValue; +END_RCPP +} +// vcfFounderTableCollection +SEXP vcfFounderTableCollection(const Rcpp::IntegerMatrix haplo, const Rcpp::NumericVector pos, const double seqLen, const int ploidy, const bool addTsMut); +RcppExport SEXP _AlphaSimR_vcfFounderTableCollection(SEXP haploSEXP, SEXP posSEXP, SEXP seqLenSEXP, SEXP ploidySEXP, SEXP addTsMutSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::IntegerMatrix >::type haplo(haploSEXP); + Rcpp::traits::input_parameter< const Rcpp::NumericVector >::type pos(posSEXP); + Rcpp::traits::input_parameter< const double >::type seqLen(seqLenSEXP); + Rcpp::traits::input_parameter< const int >::type ploidy(ploidySEXP); + Rcpp::traits::input_parameter< const bool >::type addTsMut(addTsMutSEXP); + rcpp_result_gen = Rcpp::wrap(vcfFounderTableCollection(haplo, pos, seqLen, ploidy, addTsMut)); + return rcpp_result_gen; +END_RCPP +} +// tsForwardNodeTableAddRows +Rcpp::IntegerVector tsForwardNodeTableAddRows(const SEXP tc, const Rcpp::IntegerVector flags, const Rcpp::NumericVector time, const Rcpp::IntegerVector population, const Rcpp::IntegerVector individual); +RcppExport SEXP _AlphaSimR_tsForwardNodeTableAddRows(SEXP tcSEXP, SEXP flagsSEXP, SEXP timeSEXP, SEXP populationSEXP, SEXP individualSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type flags(flagsSEXP); + Rcpp::traits::input_parameter< const Rcpp::NumericVector >::type time(timeSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type population(populationSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type individual(individualSEXP); + rcpp_result_gen = Rcpp::wrap(tsForwardNodeTableAddRows(tc, flags, time, population, individual)); + return rcpp_result_gen; +END_RCPP +} +// tsForwardNodeTableAddRowsWithMetadata +Rcpp::IntegerVector tsForwardNodeTableAddRowsWithMetadata(const SEXP tc, const Rcpp::IntegerVector flags, const Rcpp::NumericVector time, const Rcpp::IntegerVector population, const Rcpp::IntegerVector individual, const Rcpp::CharacterVector nodeKey); +RcppExport SEXP _AlphaSimR_tsForwardNodeTableAddRowsWithMetadata(SEXP tcSEXP, SEXP flagsSEXP, SEXP timeSEXP, SEXP populationSEXP, SEXP individualSEXP, SEXP nodeKeySEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type flags(flagsSEXP); + Rcpp::traits::input_parameter< const Rcpp::NumericVector >::type time(timeSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type population(populationSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type individual(individualSEXP); + Rcpp::traits::input_parameter< const Rcpp::CharacterVector >::type nodeKey(nodeKeySEXP); + rcpp_result_gen = Rcpp::wrap(tsForwardNodeTableAddRowsWithMetadata(tc, flags, time, population, individual, nodeKey)); + return rcpp_result_gen; +END_RCPP +} +// tsForwardEdgeTableAddRows +void tsForwardEdgeTableAddRows(const SEXP tc, const Rcpp::NumericVector left, const Rcpp::NumericVector right, const Rcpp::IntegerVector parent, const Rcpp::IntegerVector child); +RcppExport SEXP _AlphaSimR_tsForwardEdgeTableAddRows(SEXP tcSEXP, SEXP leftSEXP, SEXP rightSEXP, SEXP parentSEXP, SEXP childSEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP); + Rcpp::traits::input_parameter< const Rcpp::NumericVector >::type left(leftSEXP); + Rcpp::traits::input_parameter< const Rcpp::NumericVector >::type right(rightSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type parent(parentSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type child(childSEXP); + tsForwardEdgeTableAddRows(tc, left, right, parent, child); + return R_NilValue; +END_RCPP +} +// tsForwardSetSampleFlags +void tsForwardSetSampleFlags(const SEXP tc, const Rcpp::IntegerVector samples, const bool clearExisting); +RcppExport SEXP _AlphaSimR_tsForwardSetSampleFlags(SEXP tcSEXP, SEXP samplesSEXP, SEXP clearExistingSEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type samples(samplesSEXP); + Rcpp::traits::input_parameter< const bool >::type clearExisting(clearExistingSEXP); + tsForwardSetSampleFlags(tc, samples, clearExisting); + return R_NilValue; +END_RCPP +} static const R_CallMethodDef CallEntries[] = { {"_AlphaSimR_solveRRBLUP", (DL_FUNC) &_AlphaSimR_solveRRBLUP, 3}, @@ -950,7 +1070,7 @@ static const R_CallMethodDef CallEntries[] = { {"_AlphaSimR_getNonFounderIbd", (DL_FUNC) &_AlphaSimR_getNonFounderIbd, 3}, {"_AlphaSimR_getFounderIbd", (DL_FUNC) &_AlphaSimR_getFounderIbd, 2}, {"_AlphaSimR_createIbdMat", (DL_FUNC) &_AlphaSimR_createIbdMat, 5}, - {"_AlphaSimR_cross", (DL_FUNC) &_AlphaSimR_cross, 15}, + {"_AlphaSimR_cross", (DL_FUNC) &_AlphaSimR_cross, 20}, {"_AlphaSimR_createDH2", (DL_FUNC) &_AlphaSimR_createDH2, 7}, {"_AlphaSimR_createReducedGenome", (DL_FUNC) &_AlphaSimR_createReducedGenome, 10}, {"_AlphaSimR_popVarCpp", (DL_FUNC) &_AlphaSimR_popVarCpp, 1}, @@ -966,8 +1086,16 @@ static const R_CallMethodDef CallEntries[] = { {"_AlphaSimR_rngDiagnosticsSampleInt", (DL_FUNC) &_AlphaSimR_rngDiagnosticsSampleInt, 4}, {"_AlphaSimR_rngDiagnosticsSamplePoisson", (DL_FUNC) &_AlphaSimR_rngDiagnosticsSamplePoisson, 3}, {"_AlphaSimR_MaCS", (DL_FUNC) &_AlphaSimR_MaCS, 6}, + {"_AlphaSimR_MaCSTS", (DL_FUNC) &_AlphaSimR_MaCSTS, 10}, {"_AlphaSimR_rtsk_table_collection_summary2", (DL_FUNC) &_AlphaSimR_rtsk_table_collection_summary2, 1}, {"_AlphaSimR_rtsk_treeseq_get_num_individuals2", (DL_FUNC) &_AlphaSimR_rtsk_treeseq_get_num_individuals2, 1}, + {"_AlphaSimR_tsMutateTableCollection", (DL_FUNC) &_AlphaSimR_tsMutateTableCollection, 3}, + {"_AlphaSimR_tsFinalizeInbredTableCollection", (DL_FUNC) &_AlphaSimR_tsFinalizeInbredTableCollection, 2}, + {"_AlphaSimR_vcfFounderTableCollection", (DL_FUNC) &_AlphaSimR_vcfFounderTableCollection, 5}, + {"_AlphaSimR_tsForwardNodeTableAddRows", (DL_FUNC) &_AlphaSimR_tsForwardNodeTableAddRows, 5}, + {"_AlphaSimR_tsForwardNodeTableAddRowsWithMetadata", (DL_FUNC) &_AlphaSimR_tsForwardNodeTableAddRowsWithMetadata, 6}, + {"_AlphaSimR_tsForwardEdgeTableAddRows", (DL_FUNC) &_AlphaSimR_tsForwardEdgeTableAddRows, 5}, + {"_AlphaSimR_tsForwardSetSampleFlags", (DL_FUNC) &_AlphaSimR_tsForwardSetSampleFlags, 3}, {NULL, NULL, 0} }; diff --git a/src/algorithm.cpp b/src/algorithm.cpp index 42195a7f..fd75c2b9 100644 --- a/src/algorithm.cpp +++ b/src/algorithm.cpp @@ -1147,6 +1147,59 @@ void GraphBuilder::addMutations(double startPos,double endPos){ } } +void GraphBuilder::addMutationsTs(double startPos,double endPos){ + bool bEndMutate = false; + while(!bEndMutate){ + // find the next point on this interval + startPos+=pRandNumGenerator->expRV(dLastTreeLength* + pConfig->dTheta); + if (startPos>=endPos){ + bEndMutate = true; + }else{ + double dRandomSpot = pRandNumGenerator->unifRV() * dLastTreeLength; + double dMutationTime=-1.; + EdgePtr selectedEdge = getRandomEdgeOnTree(dMutationTime,dRandomSpot); + if (pTsRecorder) { + pTsRecorder->recordMutation(startPos, selectedEdge, dMutationTime); + } + // Keep existing behavior for now so TS and non-TS remain comparable. + mutateBelowEdge(selectedEdge); + + unique_ptr temp(new AlphaSimRReturn()); + temp->length = startPos; + unsigned int iSampleSize = pConfig->iSampleSize; + for (unsigned int iSampleIndex=0;iSampleIndex(pSampleNodeArray[iSampleIndex].get()); + sites[iSampleIndex]=sample->bAffected; + temp->haplotypes.push_back(sample->bAffected); + sample->bAffected=false; + } + mutations.push_back(*temp); + double dFreq=0.; + if (pConfig->bSNPAscertainment){ + int counts=0; + for (unsigned int i=0;ibFlipAlleles && dFreq>.5){ + for (unsigned int i=0;ipAlleleFreqBinPtrSet->find(query); + if (it!=pConfig->pAlleleFreqBinPtrSet->end()){ + AlleleFreqBinPtr bin = *it; + ++bin->iObservedCounts; + }else throw "Did not find a frequency range for freq"; + } + pMutationPtrVector->push_back(new Mutation(startPos, dFreq)); + } + } +} + bool GraphBuilder::getNextPos(double & curPos,HotSpotBinPtrList::iterator & hotSpotIt){ bool bBinCrossed = false; if (hotSpotIt==pConfig->pHotSpotBinPtrList->end()){ @@ -1304,7 +1357,107 @@ void GraphBuilder::build(){ } +void GraphBuilder::buildTs(bool usePhysicalPositions, bool useMacsMut, + bool inbred, unsigned int ploidy){ + pTsRecorder.reset(new TsRecorder( + pConfig->dSeqLength, + usePhysicalPositions ? TsPositionMode::PHYSICAL_BP : TsPositionMode::MACS_UNIT, + inbred, + ploidy)); + + double curPos = 0.0,lastPos = 0.0,dMaxPos = 1.0; + unsigned int iLastCumulativePos = 0; + + HotSpotBinPtrList::iterator hotSpotIt; + if (pConfig->bVariableRecomb){ + hotSpotIt=pConfig->pHotSpotBinPtrList->begin(); + } + // gene conversion stuff + GeneConversionPtr newGC; + double dLogTractRatio = log((pConfig->iGeneConvTract-1.)/pConfig->iGeneConvTract); + int iHistoryMax = 0; + do{ + if (iGraphIteration==0){ + NodePtr dummy1; + EventPtr dummy2; + this->traverseEvents(false,dummy1,dummy2); + if (pTsRecorder) { + pTsRecorder->preRegisterSamples(pSampleNodeArray, pConfig->iSampleSize); + } + }else{ + // at this point decide whether we invoke a plain x-over + // or a new gene conversion event + this->bBeginGeneConversion = false; + if (this->bEndGeneConversion){ + }else{ + this->bBeginGeneConversion = pRandNumGenerator->unifRV()< + (pConfig->dGeneConvRatio/(pConfig->dGeneConvRatio+1))?true:false; + if (bBeginGeneConversion){ + double dTractLen = (1.+log(pRandNumGenerator->unifRV())/ + dLogTractRatio)/pConfig->dSeqLength; + newGC = GeneConversionPtr(new GeneConversion( + curPos+dTractLen)); + pGeneConversionPtrSet->insert(newGC); + } + } + invokeRecombination(newGC); + // mark the graph edges as the local tree + markCurrentTree(); + if (!bIncrementHistory){ + double dBoundary = curPos - dTrailingGap; + if (dBoundary>0.){ + bIncrementHistory = true; + } + }else{ + ++iHistoryMax; + } + if (iHistoryMax>=0){ + pruneARG(iHistoryMax); + } + } + + initializeCurrentTree(); + + if (pConfig->bVariableRecomb){ + bool bBinCrossed; + do{ + bBinCrossed = getNextPos(curPos,hotSpotIt); + }while(bBinCrossed); + }else{ + curPos+=pRandNumGenerator->expRV(getRate()); + } + // check if we reached the end of the region + if (curPos>dMaxPos) curPos=dMaxPos; + if (pConfig->bNewickFormat){ + uint iSegLength = curPos*pConfig->dSeqLength-iLastCumulativePos; + iLastCumulativePos += iSegLength; + } + // check if there was an existing gene conversion event that needs + // to be closed. backtrack if necessary. + this->bEndGeneConversion = checkPendingGeneConversions(curPos); + if (pTsRecorder) { + pTsRecorder->recordTreeInterval(*pEdgeVectorInTree, iTotalTreeEdges, + lastPos, curPos); + } + if (useMacsMut && pConfig->dTheta>0.0){ + addMutationsTs(lastPos,curPos); + } + lastPos = curPos; + ++iGraphIteration; + }while(curPossimplify(); + } +} + vector GraphBuilder::getMutations() { return mutations; } +tsk_table_collection_t * GraphBuilder::releaseTableCollectionTs(double timeScale, + bool expandInbred) { + if (!pTsRecorder) { + return nullptr; + } + return pTsRecorder->release(timeScale, expandInbred); +} diff --git a/src/meiosis.cpp b/src/meiosis.cpp index a7f9ee30..fd9b9f75 100644 --- a/src/meiosis.cpp +++ b/src/meiosis.cpp @@ -1,4 +1,6 @@ #include "alphasimr.h" +#include +#include namespace { @@ -17,6 +19,48 @@ std::vector makeChrRngs(arma::uword nChr) { return chrRngs; } +struct TsSegRow { + int childLocal; + int chr; + int hap; + int parentSide; // 1 = mother/female, 2 = father/male + int parentIndex; // index in supplied parent population (1-based) + int parentHap; // parental haplotype (1-based) + double leftGen; + double rightGen; +}; + +void appendTsSegRowsFromHistGen(const arma::Mat& histGen, + int childLocal, + int chr, + int hap, + int parentSide, + int parentIndex, + double chrGenLen, + std::vector& out){ + if(histGen.n_rows == 0){ + return; + } + for(arma::uword i = 0; i < histGen.n_rows; ++i){ + const double left = histGen(i, 1); + const double right = (i + 1 < histGen.n_rows) ? histGen(i + 1, 1) : chrGenLen; + if(!std::isfinite(left) || !std::isfinite(right) || right <= left){ + continue; + } + const int parentHap = static_cast(std::llround(histGen(i, 0))); + out.push_back(TsSegRow{ + childLocal, + chr, + hap, + parentSide, + parentIndex, + parentHap, + left, + right + }); + } +} + } // namespace // Class for storing recombination history @@ -72,6 +116,90 @@ arma::Mat RecHist::getHist(arma::uword ind, return hist(ind)(chr)(par); } +// Like RecHist, but store double positions (e.g., genetic coordinate) +class RecHistDbl{ +public: + arma::field< //individual + arma::field< //chromosome + arma::field< //ploidy + arma::Mat > > > hist; //(chr, posGen) + + void setSize(arma::uword nInd, + arma::uword nChr, + arma::uword ploidy); + + void addHist(arma::Mat& input, + arma::uword nInd, + arma::uword chrGroup, + arma::uword chrInd); + + arma::Mat getHist(arma::uword ind, + arma::uword chr, + arma::uword par); +}; + +void RecHistDbl::setSize(arma::uword nInd, + arma::uword nChr, + arma::uword ploidy=2){ + hist.set_size(nInd); + for(arma::uword i=0; i& input, + arma::uword nInd, + arma::uword chrGroup, + arma::uword chrInd){ + hist(nInd)(chrGroup)(chrInd) = input; +} + +arma::Mat RecHistDbl::getHist(arma::uword ind, + arma::uword chr, + arma::uword par){ + return hist(ind)(chr)(par); +} + +namespace { + +void appendBivalentTrackRecGen(arma::Mat& histG, + int parentHap1, + int parentHap2, + bool returnRecHistGen, + RecHistDbl& histGen, + arma::uword ind, + arma::uword chr, + arma::uword progenyChr, + int parentSide, + int parentIndex, + double chrGenLen, + bool collectTsSegRows, + std::vector& tsSegRows){ + histG.col(0) *= 100.0; + histG.col(0).replace(100.0, double(parentHap1)); + histG.col(0).replace(200.0, double(parentHap2)); + if(returnRecHistGen){ + histGen.addHist(histG, ind, chr, progenyChr); + } + if(collectTsSegRows){ + appendTsSegRowsFromHistGen( + histG, + static_cast(ind + 1), + static_cast(chr + 1), + static_cast(progenyChr + 1), + parentSide, + parentIndex, + chrGenLen, + tsSegRows + ); + } +} + +} // namespace + // Samples the locations for chiasmata via a gamma process // end, the length of the interval used to sample // v, the interference parameter @@ -923,6 +1051,112 @@ void bivalent(const arma::Col& chr1, } } +// Simulates a gamete using the existing discrete (bin-based) model for geno, +// AND also returns a continuous (genetic-coordinate) recombination history. +// +// - hist: int matrix (originChr, startSite/bin) used for transferGeno +// - histGen: double matrix (originChr, startPosGen) keeping all breakpoints +void bivalent2(const arma::Col& chr1, + const arma::Col& chr2, + const arma::vec& genMap, + double v, + double p, + arma::Col& output, + arma::Mat& hist, + arma::Mat& histGen, + alphasimrRng::rngEngine& rng){ + + arma::uword startPos = 0; + arma::uword endPos; + arma::uword readChr = 0; + double genLen = genMap(genMap.n_elem - 1); + + // 1) Sample crossover positions once (shared) + arma::vec posCO = sampleChiasmata(genLen, v, p, rng); + + // 2) Thin crossovers (same rule as original) + if(posCO.n_elem > 0){ + arma::vec thin = alphasimrRng::runifVec(posCO.n_elem, rng); + posCO = posCO(find(thin > 0.5)); + } + + // Ensure increasing order for intervalSearch and for histGen + if(posCO.n_elem > 1){ + posCO = sort(posCO); + } + + arma::uword nCO = posCO.n_elem; + + // 3) Build continuous history (keep all breakpoints) + // Row 0 always starts from chr 1 at position 0.0 + histGen.set_size(nCO + 1, 2); + histGen(0,0) = 1.0; + histGen(0,1) = 0.0; + + readChr = 0; + for(arma::uword i = 0; i < nCO; ++i){ + readChr = (readChr + 1) % 2; + histGen(i + 1, 0) = double(readChr + 1); + histGen(i + 1, 1) = posCO(i); + } + + // 4) Build discrete history for transferGeno (may be simplified) + // Match original convention: row0 is (1,1); later start sites use endPos+2 + arma::Mat histRaw(nCO + 1, 2); + histRaw(0,0) = 1; + histRaw(0,1) = 1; + + if(nCO == 0){ + // No crossovers: single record is enough + hist = histRaw; + output = chr1; + return; + } + + readChr = 0; + startPos = 0; + for(arma::uword i = 0; i < nCO; ++i){ + readChr = (readChr + 1) % 2; + double x = posCO(i); + endPos = intervalSearch(genMap, x, startPos); + histRaw(i + 1, 0) = int(readChr + 1); + histRaw(i + 1, 1) = int(endPos + 2); + startPos = endPos; + } + + // Remove unobservable/redundant records for the discrete geno-transfer path only + hist = removeDoubleCO(histRaw); + + // 5) Use the discrete history to transfer genotype bits (unchanged logic) + int nBins = chr1.n_elem; + + if(hist.n_rows == 1){ + output = chr1; + return; + } + + for(arma::uword i = 0; i < (hist.n_rows - 1); ++i){ + switch(hist(i,0)){ + case 1: + transferGeno(chr1, output, hist(i,1), hist(i+1,1)); + break; + case 2: + transferGeno(chr2, output, hist(i,1), hist(i+1,1)); + break; + } + } + + switch(hist(hist.n_rows - 1, 0)){ + case 1: + transferGeno(chr1, output, hist(hist.n_rows - 1, 1), nBins*8 + 1); + break; + case 2: + transferGeno(chr2, output, hist(hist.n_rows - 1, 1), nBins*8 + 1); + break; + } +} + + // Simulates a gamete using a count-location model for recombination // rng is the explicit dqrng stream used for crossover sampling and thinning. void quadrivalent(const arma::Col& chr1, @@ -1099,7 +1333,30 @@ Rcpp::List cross( const arma::vec& motherCentromere, const arma::vec& fatherCentromere, double quadProb, - int nThreads){ + int nThreads, + /* modified by Jinyang */ + bool trackRecGen, + bool returnRecHistGen, + bool recordTsDirect, + bool returnTsSegGen, + const SEXP directAppendFnSEXP){ + if(returnRecHistGen && !trackRecGen){ + Rcpp::stop("returnRecHistGen requires trackRecGen = TRUE."); + } + if(recordTsDirect && !trackRecGen){ + Rcpp::stop("recordTsDirect requires trackRecGen = TRUE."); + } + if(trackRecGen && quadProb > 0.0){ + Rcpp::stop("tsSegGen from histGen is currently supported only when quadProb == 0."); + } + SEXP directAppendFnObj = R_NilValue; + if(recordTsDirect){ + if(Rf_isNull(directAppendFnSEXP)){ + Rcpp::stop("recordTsDirect requires a non-NULL directAppendFn."); + } + directAppendFnObj = directAppendFnSEXP; + } + const bool collectTsSegRows = trackRecGen && (recordTsDirect || returnTsSegGen); mother -= 1; // R to C++ father -= 1; // R to C++ arma::uword ploidy = (motherPloidy+fatherPloidy)/2; @@ -1111,6 +1368,17 @@ Rcpp::List cross( if(trackRec){ hist.setSize(nInd,nChr,ploidy); } + + // modified by Jinyang + RecHistDbl histGen; + if(returnRecHistGen){ + histGen.setSize(nInd, nChr, ploidy); + } + std::vector > tsSegByChr; + if(collectTsSegRows){ + tsSegByChr.resize(nChr); + } + if(nChr < static_cast(nThreads) ){ nThreads = nChr; } @@ -1122,6 +1390,8 @@ Rcpp::List cross( for(arma::uword chr=0; chr hist1, hist2; + // modified by Jinyang + arma::Mat histG1, histG2; arma::uvec xm(motherPloidy); // Indicator for mother chromosomes for(arma::uword i=0; i tmpGeno(nBins,ploidy,nInd); arma::Col gamete1(nBins), gamete2(nBins); + std::vector tsSegRows; + if(collectTsSegRows){ + tsSegRows.reserve(static_cast(nInd * ploidy * 4)); + } //Loop through individuals for(arma::uword ind=0; ind2){ if(alphasimrRng::runif(rng)>quadProb){ //Bivalent 1 - bivalent(motherGeno(chr).slice(mother(ind)).col(xm(x)), - motherGeno(chr).slice(mother(ind)).col(xm(x+1)), - femaleMap(chr), - v, - p, - gamete1, - hist1, - rng); + // modified by Jinyang ---- + if(trackRecGen){ + bivalent2(motherGeno(chr).slice(mother(ind)).col(xm(x)), + motherGeno(chr).slice(mother(ind)).col(xm(x+1)), + femaleMap(chr), + v, + p, + gamete1, + hist1, + histG1, + rng); + } else {// ----modified by Jinyang + bivalent(motherGeno(chr).slice(mother(ind)).col(xm(x)), + motherGeno(chr).slice(mother(ind)).col(xm(x+1)), + femaleMap(chr), + v, + p, + gamete1, + hist1, + rng); + } tmpGeno.slice(ind).col(progenyChr) = gamete1; if(trackRec){ hist1.col(0) *= 100; //To avoid conflicts @@ -1158,17 +1447,50 @@ Rcpp::List cross( hist1.col(0).replace(200,int(xm(x+1))+1); hist.addHist(hist1,ind,chr,progenyChr); } + // modified by Jinyang ---- + if(trackRecGen){ + appendBivalentTrackRecGen( + histG1, + int(xm(x)) + 1, + int(xm(x+1)) + 1, + returnRecHistGen, + histGen, + ind, + chr, + progenyChr, + 1, + static_cast(mother(ind) + 1), + femaleGenLen, + collectTsSegRows, + tsSegRows + ); + } + // ----modified by Jinyang ++progenyChr; //Bivalent 2 - bivalent(motherGeno(chr).slice(mother(ind)).col(xm(x+2)), - motherGeno(chr).slice(mother(ind)).col(xm(x+3)), - femaleMap(chr), - v, - p, - gamete1, - hist1, - rng); + // modified by Jinyang ---- + if(trackRecGen){ + bivalent2(motherGeno(chr).slice(mother(ind)).col(xm(x+2)), + motherGeno(chr).slice(mother(ind)).col(xm(x+3)), + femaleMap(chr), + v, + p, + gamete1, + hist1, + histG1, + rng); + } else { + // ----modified by Jinyang + bivalent(motherGeno(chr).slice(mother(ind)).col(xm(x+2)), + motherGeno(chr).slice(mother(ind)).col(xm(x+3)), + femaleMap(chr), + v, + p, + gamete1, + hist1, + rng); + } tmpGeno.slice(ind).col(progenyChr) = gamete1; if(trackRec){ hist1.col(0) *= 100; //To avoid conflicts @@ -1176,6 +1498,25 @@ Rcpp::List cross( hist1.col(0).replace(200,int(xm(x+3))+1); hist.addHist(hist1,ind,chr,progenyChr); } + // modified by Jinyang ---- + if(trackRecGen){ + appendBivalentTrackRecGen( + histG1, + int(xm(x+2)) + 1, + int(xm(x+3)) + 1, + returnRecHistGen, + histGen, + ind, + chr, + progenyChr, + 1, + static_cast(mother(ind) + 1), + femaleGenLen, + collectTsSegRows, + tsSegRows + ); + } + // ----modified by Jinyang ++progenyChr; }else{ //Quadrivalent @@ -1208,14 +1549,29 @@ Rcpp::List cross( } }else{ //Bivalent - bivalent(motherGeno(chr).slice(mother(ind)).col(xm(x)), - motherGeno(chr).slice(mother(ind)).col(xm(x+1)), - femaleMap(chr), - v, - p, - gamete1, - hist1, - rng); + // modified by Jinyang ---- + if(trackRecGen){ + bivalent2(motherGeno(chr).slice(mother(ind)).col(xm(x)), + motherGeno(chr).slice(mother(ind)).col(xm(x+1)), + femaleMap(chr), + v, + p, + gamete1, + hist1, + histG1, + rng); + } else { + // ----modified by Jinyang + bivalent(motherGeno(chr).slice(mother(ind)).col(xm(x)), + motherGeno(chr).slice(mother(ind)).col(xm(x+1)), + femaleMap(chr), + v, + p, + gamete1, + hist1, + rng); + } + tmpGeno.slice(ind).col(progenyChr) = gamete1; if(trackRec){ hist1.col(0) *= 100; //To avoid conflicts @@ -1223,6 +1579,25 @@ Rcpp::List cross( hist1.col(0).replace(200,int(xm(x+1))+1); hist.addHist(hist1,ind,chr,progenyChr); } + // modified by Jinyang ---- + if(trackRecGen){ + appendBivalentTrackRecGen( + histG1, + int(xm(x)) + 1, + int(xm(x+1)) + 1, + returnRecHistGen, + histGen, + ind, + chr, + progenyChr, + 1, + static_cast(mother(ind) + 1), + femaleGenLen, + collectTsSegRows, + tsSegRows + ); + } + // ----modified by Jinyang ++progenyChr; } } @@ -1233,14 +1608,28 @@ Rcpp::List cross( if((fatherPloidy-x)>2){ if(alphasimrRng::runif(rng)>quadProb){ //Bivalent 1 - bivalent(fatherGeno(chr).slice(father(ind)).col(xf(x)), - fatherGeno(chr).slice(father(ind)).col(xf(x+1)), - maleMap(chr), - v, - p, - gamete1, - hist1, - rng); + // modified by Jinyang ---- + if(trackRecGen){ + bivalent2(fatherGeno(chr).slice(father(ind)).col(xf(x)), + fatherGeno(chr).slice(father(ind)).col(xf(x+1)), + maleMap(chr), + v, + p, + gamete1, + hist1, + histG1, + rng); + } else { + // ----modified by Jinyang + bivalent(fatherGeno(chr).slice(father(ind)).col(xf(x)), + fatherGeno(chr).slice(father(ind)).col(xf(x+1)), + maleMap(chr), + v, + p, + gamete1, + hist1, + rng); + } tmpGeno.slice(ind).col(progenyChr) = gamete1; if(trackRec){ hist1.col(0) *= 100; //To avoid conflicts @@ -1248,17 +1637,49 @@ Rcpp::List cross( hist1.col(0).replace(200,int(xf(x+1))+1); hist.addHist(hist1,ind,chr,progenyChr); } + // modified by Jinyang ---- + if(trackRecGen){ + appendBivalentTrackRecGen( + histG1, + int(xf(x)) + 1, + int(xf(x+1)) + 1, + returnRecHistGen, + histGen, + ind, + chr, + progenyChr, + 2, + static_cast(father(ind) + 1), + maleGenLen, + collectTsSegRows, + tsSegRows + ); + } ++progenyChr; //Bivalent 2 - bivalent(fatherGeno(chr).slice(father(ind)).col(xf(x+2)), - fatherGeno(chr).slice(father(ind)).col(xf(x+3)), - maleMap(chr), - v, - p, - gamete1, - hist1, - rng); + // modified by Jinyang ---- + if(trackRecGen){ + bivalent2(fatherGeno(chr).slice(father(ind)).col(xf(x+2)), + fatherGeno(chr).slice(father(ind)).col(xf(x+3)), + maleMap(chr), + v, + p, + gamete1, + hist1, + histG1, + rng); + } else { + // ----modified by Jinyang + bivalent(fatherGeno(chr).slice(father(ind)).col(xf(x+2)), + fatherGeno(chr).slice(father(ind)).col(xf(x+3)), + maleMap(chr), + v, + p, + gamete1, + hist1, + rng); + } tmpGeno.slice(ind).col(progenyChr) = gamete1; if(trackRec){ hist1.col(0) *= 100; //To avoid conflicts @@ -1266,6 +1687,24 @@ Rcpp::List cross( hist1.col(0).replace(200,int(xf(x+3))+1); hist.addHist(hist1,ind,chr,progenyChr); } + // modified by Jinyang ---- + if(trackRecGen){ + appendBivalentTrackRecGen( + histG1, + int(xf(x+2)) + 1, + int(xf(x+3)) + 1, + returnRecHistGen, + histGen, + ind, + chr, + progenyChr, + 2, + static_cast(father(ind) + 1), + maleGenLen, + collectTsSegRows, + tsSegRows + ); + } ++progenyChr; }else{ //Quadrivalent @@ -1298,14 +1737,28 @@ Rcpp::List cross( } }else{ //Bivalent - bivalent(fatherGeno(chr).slice(father(ind)).col(xf(x)), - fatherGeno(chr).slice(father(ind)).col(xf(x+1)), - maleMap(chr), - v, - p, - gamete1, - hist1, - rng); + // modified by Jinyang ---- + if(trackRecGen){ + bivalent2(fatherGeno(chr).slice(father(ind)).col(xf(x)), + fatherGeno(chr).slice(father(ind)).col(xf(x+1)), + maleMap(chr), + v, + p, + gamete1, + hist1, + histG1, + rng); + } else { + // ----modified by Jinyang + bivalent(fatherGeno(chr).slice(father(ind)).col(xf(x)), + fatherGeno(chr).slice(father(ind)).col(xf(x+1)), + maleMap(chr), + v, + p, + gamete1, + hist1, + rng); + } tmpGeno.slice(ind).col(progenyChr) = gamete1; if(trackRec){ hist1.col(0) *= 100; //To avoid conflicts @@ -1313,15 +1766,92 @@ Rcpp::List cross( hist1.col(0).replace(200,int(xf(x+1))+1); hist.addHist(hist1,ind,chr,progenyChr); } + // modified by Jinyang ---- + if(trackRecGen){ + appendBivalentTrackRecGen( + histG1, + int(xf(x)) + 1, + int(xf(x+1)) + 1, + returnRecHistGen, + histGen, + ind, + chr, + progenyChr, + 2, + static_cast(father(ind) + 1), + maleGenLen, + collectTsSegRows, + tsSegRows + ); + } ++progenyChr; } } } //End individual loop geno(chr) = tmpGeno; + if(collectTsSegRows){ + tsSegByChr[chr].swap(tsSegRows); + } } //End chromosome loop + + arma::mat tsSegGenMat; + if(collectTsSegRows){ + std::size_t nSeg = 0; + for(const auto& x : tsSegByChr){ + nSeg += x.size(); + } + tsSegGenMat.set_size(nSeg, 8); + std::size_t row = 0; + for(const auto& x : tsSegByChr){ + for(const auto& s : x){ + tsSegGenMat(row, 0) = s.childLocal; + tsSegGenMat(row, 1) = s.chr; + tsSegGenMat(row, 2) = s.hap; + tsSegGenMat(row, 3) = s.parentSide; + tsSegGenMat(row, 4) = s.parentIndex; + tsSegGenMat(row, 5) = s.parentHap; + tsSegGenMat(row, 6) = s.leftGen; + tsSegGenMat(row, 7) = s.rightGen; + ++row; + } + } + } + if(recordTsDirect && trackRecGen && tsSegGenMat.n_rows > 0){ + Rcpp::RObject ok = Rcpp::Function(directAppendFnObj)(tsSegGenMat); + if(TYPEOF(ok) == LGLSXP && !Rcpp::as(ok)){ + Rcpp::stop("Direct TS append callback returned FALSE."); + } + } + + // modified by Jinyang ---- if(trackRec){ + if(trackRecGen){ + if(returnRecHistGen){ + if(returnTsSegGen){ + return Rcpp::List::create(Rcpp::Named("geno")=geno, + Rcpp::Named("recHist")=hist.hist, + Rcpp::Named("recHistGen")=histGen.hist, + Rcpp::Named("tsSegGen")=tsSegGenMat); + } + return Rcpp::List::create(Rcpp::Named("geno")=geno, + Rcpp::Named("recHist")=hist.hist, + Rcpp::Named("recHistGen")=histGen.hist); + } + if(returnTsSegGen){ + return Rcpp::List::create(Rcpp::Named("geno")=geno, + Rcpp::Named("recHist")=hist.hist, + Rcpp::Named("tsSegGen")=tsSegGenMat); + } + return Rcpp::List::create(Rcpp::Named("geno")=geno, + Rcpp::Named("recHist")=hist.hist); + } else { + return Rcpp::List::create(Rcpp::Named("geno")=geno, + Rcpp::Named("recHist")=hist.hist); + } + } + if(trackRecGen && returnTsSegGen){ return Rcpp::List::create(Rcpp::Named("geno")=geno, - Rcpp::Named("recHist")=hist.hist); + Rcpp::Named("tsSegGen")=tsSegGenMat); } return Rcpp::List::create(Rcpp::Named("geno")=geno); } diff --git a/src/postTS.cpp b/src/postTS.cpp new file mode 100644 index 00000000..916bb957 --- /dev/null +++ b/src/postTS.cpp @@ -0,0 +1,210 @@ +#include "rng.h" +#include "postTS.h" + +#include +#include +#include +#include +#include + +namespace tsPost { + +void checkTsk(const int status, const char *context) { + if (status < 0) { + throw std::runtime_error(std::string(context) + ": " + + std::string(tsk_strerror(status))); + } +} + +void expandInbredSamplesInPlace(tsk_table_collection_t *tables, + const unsigned int ploidy) { + if (tables == nullptr || ploidy <= 1) { + return; + } + const double sequenceLength = tables->sequence_length; + if (!(sequenceLength > 0.0)) { + return; + } + + std::vector originalSamples; + originalSamples.reserve(tables->nodes.num_rows); + for (tsk_id_t nodeId = 0; + nodeId < static_cast(tables->nodes.num_rows); + ++nodeId) { + if ((tables->nodes.flags[nodeId] & TSK_NODE_IS_SAMPLE) != 0) { + originalSamples.push_back(nodeId); + } + } + if (originalSamples.empty()) { + return; + } + + const double smallestPositive = std::nextafter(0.0, 1.0); + std::vector minParentTimeByNode( + tables->nodes.num_rows, + std::numeric_limits::infinity()); + for (tsk_size_t edgeId = 0; edgeId < tables->edges.num_rows; ++edgeId) { + const tsk_id_t childId = tables->edges.child[edgeId]; + const tsk_id_t parentId = tables->edges.parent[edgeId]; + if (childId == TSK_NULL || parentId == TSK_NULL || + childId < 0 || + static_cast(childId) >= tables->nodes.num_rows) { + continue; + } + const double parentTime = tables->nodes.time[parentId]; + if (std::isfinite(parentTime) && + parentTime < minParentTimeByNode[childId]) { + minParentTimeByNode[childId] = parentTime; + } + } + + for (const tsk_id_t sampleNodeId : originalSamples) { + const double minParentTime = minParentTimeByNode[sampleNodeId]; + double internalTime = tables->nodes.time[sampleNodeId]; + if (!(internalTime > 0.0)) { + internalTime = 1e-12; + if (std::isfinite(minParentTime) && minParentTime > 0.0) { + internalTime = std::min(internalTime, 0.5 * minParentTime); + } + if (!(internalTime > 0.0)) { + internalTime = smallestPositive; + } + if (std::isfinite(minParentTime) && !(internalTime < minParentTime)) { + internalTime = std::nextafter(minParentTime, 0.0); + } + if (!(internalTime > 0.0)) { + internalTime = smallestPositive; + } + } + + tables->nodes.time[sampleNodeId] = internalTime; + tables->nodes.flags[sampleNodeId] + &= ~static_cast(TSK_NODE_IS_SAMPLE); + const tsk_id_t population = tables->nodes.population[sampleNodeId]; + const tsk_id_t individual = tables->nodes.individual[sampleNodeId]; + tables->nodes.individual[sampleNodeId] = TSK_NULL; + + for (tsk_size_t mutationId = 0; + mutationId < tables->mutations.num_rows; + ++mutationId) { + if (tables->mutations.node[mutationId] != sampleNodeId) { + continue; + } + const double mutationTime = tables->mutations.time[mutationId]; + if (!tsk_is_unknown_time(mutationTime) && mutationTime < internalTime) { + tables->mutations.time[mutationId] = internalTime; + } + } + + for (unsigned int copy = 0; copy < ploidy; ++copy) { + const tsk_id_t childNodeId = tsk_node_table_add_row(&tables->nodes, + TSK_NODE_IS_SAMPLE, + 0.0, + population, + individual, + nullptr, + 0); + checkTsk(static_cast(childNodeId), + "Failed to add duplicated inbred sample node"); + const tsk_id_t edgeId = tsk_edge_table_add_row(&tables->edges, + 0.0, + sequenceLength, + sampleNodeId, + childNodeId, + nullptr, + 0); + checkTsk(static_cast(edgeId), + "Failed to add duplicated inbred sample edge"); + } + } +} + +void mutateTablesInPlace(tsk_table_collection_t *tables, + const double theta, + const uint64_t seed) { + if (!(theta > 0.0) || !std::isfinite(theta)) { + return; + } + if (tables == nullptr) { + throw std::runtime_error("Table collection pointer is null"); + } + if (!(tables->sequence_length > 0.0)) { + throw std::runtime_error("Table collection has invalid sequence_length"); + } + + dqrng::rng64_t rng = alphasimrRng::createRng(seed); + static const char ancestralState[] = "0"; + static const char derivedState[] = "1"; + const double sequenceLength = tables->sequence_length; + + for (tsk_size_t edgeId = 0; edgeId < tables->edges.num_rows; ++edgeId) { + const tsk_id_t parent = tables->edges.parent[edgeId]; + const tsk_id_t child = tables->edges.child[edgeId]; + if (parent == TSK_NULL || child == TSK_NULL || + parent < 0 || child < 0) { + continue; + } + + const double left = tables->edges.left[edgeId]; + const double right = tables->edges.right[edgeId]; + const double span = right - left; + if (!(span > 0.0)) { + continue; + } + + const double parentTime = tables->nodes.time[parent]; + const double childTime = tables->nodes.time[child]; + const double branch = parentTime - childTime; + if (!(branch > 0.0) || !std::isfinite(branch)) { + continue; + } + + const double spanFraction = span / sequenceLength; + const double lambda = theta * spanFraction * branch; + if (!(lambda > 0.0) || !std::isfinite(lambda)) { + continue; + } + + const arma::uword nMut = alphasimrRng::samplePoisson(lambda, *rng); + for (arma::uword i = 0; i < nMut; ++i) { + double position = left + alphasimrRng::runif(*rng) * span; + if (position >= sequenceLength) { + position = std::nextafter(sequenceLength, 0.0); + } + const tsk_id_t siteId = tsk_site_table_add_row(&tables->sites, + position, + ancestralState, + 1, + nullptr, + 0); + checkTsk(static_cast(siteId), "Failed to add site row"); + + double mutationTime = childTime + alphasimrRng::runif(*rng) * branch; + if (!(mutationTime > childTime)) { + mutationTime = std::nextafter(childTime, parentTime); + } + if (!(mutationTime < parentTime)) { + mutationTime = std::nextafter(parentTime, childTime); + } + + const tsk_id_t mutationId = tsk_mutation_table_add_row(&tables->mutations, + siteId, + child, + TSK_NULL, + mutationTime, + derivedState, + 1, + nullptr, + 0); + checkTsk(static_cast(mutationId), "Failed to add mutation row"); + } + } + + (void)tsk_table_collection_drop_index(tables, 0); + checkTsk(tsk_table_collection_sort(tables, nullptr, 0), + "Failed to sort table collection after post-TS mutation"); + checkTsk(tsk_table_collection_build_index(tables, 0), + "Failed to build index after post-TS mutation"); +} + +} // namespace tsPost diff --git a/src/postTS.h b/src/postTS.h new file mode 100644 index 00000000..eb3ecd7e --- /dev/null +++ b/src/postTS.h @@ -0,0 +1,21 @@ +#ifndef ALPHASIMR_POST_TS_H +#define ALPHASIMR_POST_TS_H + +#include + +#include "tskit.h" + +namespace tsPost { + +void checkTsk(int status, const char *context); + +void expandInbredSamplesInPlace(tsk_table_collection_t *tables, + unsigned int ploidy); + +void mutateTablesInPlace(tsk_table_collection_t *tables, + double theta, + uint64_t seed); + +} // namespace tsPost + +#endif diff --git a/src/simulator.cpp b/src/simulator.cpp index 92335f0c..37655684 100644 --- a/src/simulator.cpp +++ b/src/simulator.cpp @@ -6,6 +6,7 @@ #include #include #include +#include #include #include #include @@ -13,6 +14,7 @@ #include // Include for boost::split #include // Include boost::for is_any_of #include "simulator.h" +#include #include // Include for boost::split #include "misc.h" @@ -628,6 +630,34 @@ vector Simulator::beginSimulationMemory() { return toRet; } +tsk_table_collection_t * Simulator::beginSimulationTs(bool usePhysicalPositions, + bool useMacsMut, + double timeScale, + bool inbred, + unsigned int ploidy, + bool expandInbred) { + + if (pConfig->iIterations != 1) { + Rcpp::stop("TS mode currently supports iIterations = 1"); + } + + tsk_table_collection_t * toRet = nullptr; + try { + RandNumGenerator *rg = new RandNumGenerator(pConfig->iRandomSeed); + GraphBuilder graphBuilder = GraphBuilder(pConfig, rg); + graphBuilder.buildTs(usePhysicalPositions, useMacsMut, inbred, ploidy); + toRet = graphBuilder.releaseTableCollectionTs(timeScale, expandInbred); + delete rg; + } catch (const std::exception & e) { + Rcpp::Rcerr << "Simulator caught exception with message:" << endl + << e.what() << endl; + } catch (const char *message) { + Rcpp::Rcerr << "Simulator caught exception with message:" << endl + << message << endl; + } + return toRet; +} + void Simulator::beginSimulation() { try { @@ -689,6 +719,46 @@ vector runFromAlphaSimR(string in) { return test; } +tsk_table_collection_t * runFromAlphaSimRTs(string in, bool usePhysicalPositions, + bool useMacsMut, + double timeScale, + bool inbred, + unsigned int ploidy, + bool expandInbred) { + vector words; + Simulator simulator; + + if (in == ""){ + Rcpp::stop("Not enough args for macs call"); + } + if (in.empty()) { + Rcpp::stop("Not enough args for macs call"); + } + boost::split(words, in, boost::is_any_of(", "), boost::token_compress_on); + CommandArguments arguments; + vector subOption; + // sample size + subOption.emplace_back(words[0]); + // seq length + subOption.emplace_back(words[1]); + arguments.push_back(subOption); + subOption.clear(); + for (unsigned int i=2;i=65)){ + arguments.push_back(subOption); + subOption.clear(); + } + } + if (arguments.size() == 0) { + Rcpp::stop("Not enough args for macs call"); + } + + simulator.readInputParameters(arguments); + return simulator.beginSimulationTs(usePhysicalPositions, useMacsMut, timeScale, + inbred, ploidy, expandInbred); +} + // Runs MaCS once per chromosome and converts the output to AlphaSimR's packed // genotype representation. // @@ -840,3 +910,79 @@ Rcpp::List MaCS(Rcpp::String args, arma::uvec maxSites, bool inbred, return Rcpp::List::create(Rcpp::Named("geno")=geno, Rcpp::Named("genMap")=genMap); } + +// Runs MaCS once per chromosome and returns tree-sequence table collections. +// nChr is the number of chromosomes to simulate. +// usePhysicalPositions controls coordinate space for TS tables: +// FALSE (default): unit interval [0, 1], same coordinate system as runMacs internals +// TRUE: physical bp coordinates [0, dSeqLength] +// useMacsMut controls whether MaCS-style mutation sampling is performed during +// ancestry generation (TRUE), or ancestry-only tables are returned (FALSE). +// Nref optionally sets a reference effective population size for conversion +// from scaled coalescent units to generations using timeScale = 4 * Nref. +// [[Rcpp::export]] +Rcpp::List MaCSTS(Rcpp::String args, int nChr, bool inbred, + arma::uword ploidy, int nThreads, arma::uvec seed, + bool usePhysicalPositions = false, + bool useMacsMut = false, + double Nref = NA_REAL, + bool expandInbredSamples = true){ + if (args == "") { + Rcpp::stop("error passing argument string - it's empty"); + } + if (nChr <= 0) { + Rcpp::stop("nChr must be a positive integer"); + } + if (ploidy == 0) { + Rcpp::stop("ploidy must be a positive integer"); + } + + std::string argsString = args; + const arma::uword nChrU = static_cast(nChr); + if (seed.n_elem != nChrU) { + Rcpp::stop("seed length must match number of chromosomes"); + } + double timeScale = 1.0; + if (std::isfinite(Nref)) { + if (!(Nref > 0.0)) { + Rcpp::stop("Nref must be positive when provided"); + } + timeScale = 4.0 * Nref; + } + + std::vector tables(nChrU, nullptr); + +#ifdef _OPENMP +#pragma omp parallel for schedule(static) num_threads(nThreads) +#endif + for (arma::uword chr = 0; chr < nChrU; ++chr) { + std::string seedString = + std::to_string(static_cast(seed[chr])); + tables[chr] = runFromAlphaSimRTs(argsString + seedString, + usePhysicalPositions, + useMacsMut, + timeScale, + inbred, + static_cast(ploidy), + expandInbredSamples); + } + + Rcpp::List tsTables(nChrU); + for (arma::uword chr = 0; chr < nChrU; ++chr) { + if (tables[chr] == nullptr) { + Rcpp::stop("TS simulation failed for chromosome %d", + static_cast(chr + 1)); + } + rtsk_table_collection_t out(tables[chr], true); + tsTables[chr] = out; + } + + return Rcpp::List::create( + Rcpp::Named("tables") = tsTables, + Rcpp::Named("usePhysicalPositions") = usePhysicalPositions, + Rcpp::Named("useMacsMut") = useMacsMut, + Rcpp::Named("expandInbredSamples") = expandInbredSamples, + Rcpp::Named("mutationMode") = useMacsMut ? "macs" : "none", + Rcpp::Named("timeScale") = timeScale, + Rcpp::Named("Nref") = std::isfinite(Nref) ? Nref : NA_REAL); +} diff --git a/src/simulator.h b/src/simulator.h index b20c1648..ca20de4a 100644 --- a/src/simulator.h +++ b/src/simulator.h @@ -3,6 +3,8 @@ #include #include #include +#include +#include //#include #include #include @@ -10,6 +12,7 @@ #include #include #include "constants.h" +#include "tskit.h" using namespace std; @@ -478,6 +481,40 @@ class Mutation{ bool bPrintOutput; }; +enum class TsPositionMode {MACS_UNIT, PHYSICAL_BP}; + +class TsRecorder { +public: + TsRecorder(double seqLengthBp, TsPositionMode positionMode, + bool inbred, unsigned int ploidy); + ~TsRecorder(); + void preRegisterSamples(NodePtr * pSampleNodes, unsigned int nSamples); + void recordTreeInterval(const EdgePtrVector & treeEdges, + unsigned int iTotalTreeEdges, + double leftPosUnit, double rightPosUnit); + void recordMutation(double mutationPosUnit, EdgePtr & selectedEdge, + double mutationTime); + void simplify(); + tsk_table_collection_t * release(double timeScale = 1.0, + bool expandInbred = true); + +private: + tsk_table_collection_t * pTables; + TsPositionMode positionMode; + double dSequenceLengthBp; + bool bSamplesPreRegistered; + bool bSimplified; + bool bInbred; + unsigned int iPloidy; + std::vector sampleNodeIds; + std::unordered_map nodeIdMap; + std::unordered_map sampleNodeIndividualMap; + void expandInbredSamples(); + double toTsPosition(double posUnit) const; + tsk_id_t ensurePopulation(short int population); + tsk_id_t getOrCreateNode(NodePtr & node); +}; + // Configuration container populated by parameter reading procedure // can be used by any simulator implementation class Configuration @@ -531,9 +568,13 @@ class GraphBuilder // The entry point for building the graph while traversing the // the chromosome on the unit interval. void build(); + void buildTs(bool usePhysicalPositions = false, bool useMacsMut = false, + bool inbred = false, unsigned int ploidy = 2); // Print the haplotypes in MS format void printHaplotypes(); vector getMutations(); + tsk_table_collection_t * releaseTableCollectionTs(double timeScale = 1.0, + bool expandInbred = true); private: // The random number generator @@ -618,6 +659,7 @@ class GraphBuilder bool bBeginGeneConversion; // flag to close a pending gene conversion event bool bEndGeneConversion; + std::unique_ptr pTsRecorder; // if gene conversion is to be closed at this iteration use the following // two saved edges EdgePtr gcOldEdge,gcNewEdge; @@ -655,6 +697,7 @@ class GraphBuilder // Add a mutation uniformly to the local tree, allowing it to trickle down // to the sampled chromosomes void addMutations(double startPos,double endPos); + void addMutationsTs(double startPos,double endPos); // Uniform randomly selects an edge (and position) to insert a xover or mutation node into EdgePtr getRandomEdgeOnTree(double & dSplitPoint,double dRandSpot); // Once a coalescent height is determined, uniform randomly select an @@ -743,6 +786,12 @@ class Simulator // case, constructs a new graphbuilder and calls the build() function void beginSimulation(); vector beginSimulationMemory(); + tsk_table_collection_t * beginSimulationTs(bool usePhysicalPositions = false, + bool useMacsMut = false, + double timeScale = 1.0, + bool inbred = false, + unsigned int ploidy = 2, + bool expandInbred = true); Simulator(); ~Simulator(); //destructor diff --git a/src/ts.cpp b/src/ts.cpp index fcaaf473..3cd006e0 100644 --- a/src/ts.cpp +++ b/src/ts.cpp @@ -1,8 +1,42 @@ #include "alphasimr.h" #include +#include "postTS.h" +#include +#include +#include +#include // [[Rcpp::depends(RcppTskit)]] // [[Rcpp::plugins(RcppTskit)]] +namespace { + +inline SEXP asTableCollectionXptr(const SEXP tc) { + if (TYPEOF(tc) == EXTPTRSXP) { + return tc; + } + if (TYPEOF(tc) == ENVSXP) { + Rcpp::Environment env(tc); + if (env.exists("xptr")) { + return env["xptr"]; + } + } + if (TYPEOF(tc) == VECSXP) { + Rcpp::List lst(tc); + if (lst.containsElementNamed("xptr")) { + return lst["xptr"]; + } + } + Rcpp::stop("tc must be a table-collection external pointer or an object with `$xptr`"); +} + +inline void stopIfTskError(const tsk_id_t id, const char * context) { + if (id < 0) { + Rcpp::stop("%s: %s", context, tsk_strerror(static_cast(id))); + } +} + +} // namespace + // TODO: This is just an example - we will replace it later with other // functions working with tree sequences. For example to obtain haplotypes // using https://tskit.dev/tskit/docs/stable/c-api.html#decoding-genotypes @@ -56,3 +90,377 @@ int rtsk_treeseq_get_num_individuals2(const SEXP ts) { rtsk_treeseq_t ts_xptr(ts); return static_cast(tsk_treeseq_get_num_individuals(ts_xptr)); } + +// [[Rcpp::export]] +void tsMutateTableCollection(const SEXP tc, const double theta, + const uint64_t seed) { + rtsk_table_collection_t tc_xptr(asTableCollectionXptr(tc)); + tsk_table_collection_t *tables = tc_xptr; + tsPost::mutateTablesInPlace(tables, theta, seed); +} + +// [[Rcpp::export]] +void tsFinalizeInbredTableCollection(const SEXP tc, const int ploidy) { + if (ploidy <= 1) { + return; + } + rtsk_table_collection_t tc_xptr(asTableCollectionXptr(tc)); + tsk_table_collection_t *tables = tc_xptr; + if (tables == nullptr) { + Rcpp::stop("Table collection pointer is null"); + } + + tsPost::expandInbredSamplesInPlace(tables, static_cast(ploidy)); + (void)tsk_table_collection_drop_index(tables, 0); + tsPost::checkTsk(tsk_table_collection_sort(tables, nullptr, 0), + "Failed to sort table collection after inbred finalization"); + tsPost::checkTsk(tsk_table_collection_build_index(tables, 0), + "Failed to build index after inbred finalization"); +} + +// [[Rcpp::export]] +SEXP vcfFounderTableCollection(const Rcpp::IntegerMatrix haplo, + const Rcpp::NumericVector pos, + const double seqLen, + const int ploidy, + const bool addTsMut) { + const int nHaplo = haplo.nrow(); + const int nSites = haplo.ncol(); + if (ploidy <= 0) { + Rcpp::stop("ploidy must be a positive integer"); + } + if (nHaplo <= 0 || nSites <= 0) { + Rcpp::stop("haplo must have at least one row and one column"); + } + if (nHaplo % ploidy != 0) { + Rcpp::stop("number of haplotypes must be divisible by ploidy"); + } + if (pos.size() != nSites) { + Rcpp::stop("pos length must match ncol(haplo)"); + } + if (!std::isfinite(seqLen) || seqLen <= 0.0) { + Rcpp::stop("seqLen must be a finite positive value"); + } + + tsk_table_collection_t *tables = new tsk_table_collection_t; + int ret = tsk_table_collection_init(tables, 0); + if (ret < 0) { + delete tables; + Rcpp::stop("Failed to initialise tsk tables: %s", tsk_strerror(ret)); + } + tables->sequence_length = seqLen; + + try { + static const char generationUnits[] = "generations"; + ret = tsk_table_collection_set_time_units( + tables, generationUnits, sizeof(generationUnits) - 1); + if (ret < 0) { + Rcpp::stop("Failed to set TS time_units: %s", tsk_strerror(ret)); + } + + const int nInd = nHaplo / ploidy; + std::vector individualIds; + individualIds.reserve(static_cast(nInd)); + for (int ind = 0; ind < nInd; ++ind) { + const tsk_id_t individualId = tsk_individual_table_add_row( + &tables->individuals, + 0, + nullptr, 0, + nullptr, 0, + nullptr, 0); + stopIfTskError(individualId, "Failed to add individual row"); + individualIds.push_back(individualId); + } + + std::vector sampleNodeIds; + sampleNodeIds.reserve(static_cast(nHaplo)); + for (int h = 0; h < nHaplo; ++h) { + const int ind = h / ploidy; + const tsk_id_t nodeId = tsk_node_table_add_row( + &tables->nodes, + TSK_NODE_IS_SAMPLE, + 0.0, + TSK_NULL, + individualIds[static_cast(ind)], + nullptr, 0); + stopIfTskError(nodeId, "Failed to add sample node row"); + sampleNodeIds.push_back(nodeId); + } + + if (addTsMut) { + double lastPos = -std::numeric_limits::infinity(); + for (int site = 0; site < nSites; ++site) { + double sitePos = pos[site]; + if (!std::isfinite(sitePos)) { + Rcpp::stop("site positions must be finite"); + } + if (sitePos < 0.0 || sitePos > seqLen) { + Rcpp::stop("site position outside [0, seqLen]"); + } + if (sitePos >= seqLen) { + sitePos = std::nextafter(seqLen, 0.0); + } + if (sitePos <= lastPos) { + Rcpp::stop("site positions must be strictly increasing"); + } + lastPos = sitePos; + + static const char ancestralState[] = "0"; + const tsk_id_t siteId = tsk_site_table_add_row( + &tables->sites, + sitePos, + ancestralState, + 1, + nullptr, 0); + stopIfTskError(siteId, "Failed to add site row"); + + static const char derivedState[] = "1"; + for (int h = 0; h < nHaplo; ++h) { + const int allele = haplo(h, site); + if (allele == NA_INTEGER || (allele != 0 && allele != 1)) { + Rcpp::stop("haplo entries must be 0 or 1"); + } + if (allele == 1) { + const tsk_id_t mutationId = tsk_mutation_table_add_row( + &tables->mutations, + siteId, + sampleNodeIds[static_cast(h)], + TSK_NULL, + TSK_UNKNOWN_TIME, + derivedState, + 1, + nullptr, 0); + stopIfTskError(mutationId, "Failed to add mutation row"); + } + } + } + } + + ret = tsk_table_collection_sort(tables, nullptr, 0); + if (ret < 0) { + Rcpp::stop("Failed to sort table collection: %s", tsk_strerror(ret)); + } + ret = tsk_table_collection_build_index(tables, 0); + if (ret < 0) { + Rcpp::stop("Failed to build table collection index: %s", tsk_strerror(ret)); + } + } catch (...) { + tsk_table_collection_free(tables); + delete tables; + throw; + } + + rtsk_table_collection_t out(tables, true); + return out; +} + +// [[Rcpp::export]] +Rcpp::IntegerVector tsForwardNodeTableAddRows(const SEXP tc, + const Rcpp::IntegerVector flags, + const Rcpp::NumericVector time, + const Rcpp::IntegerVector population, + const Rcpp::IntegerVector individual) { + const R_xlen_t n = time.size(); + if (flags.size() != n || population.size() != n || individual.size() != n) { + Rcpp::stop("flags/time/population/individual must have identical lengths"); + } + rtsk_table_collection_t tc_xptr(asTableCollectionXptr(tc)); + tsk_table_collection_t *tables = tc_xptr; + if (tables == nullptr) { + Rcpp::stop("Table collection pointer is null"); + } + + Rcpp::IntegerVector out(n); + if (n == 0) { + return out; + } + std::vector flagsData; + std::vector populationData; + std::vector individualData; + flagsData.reserve(static_cast(n)); + populationData.reserve(static_cast(n)); + individualData.reserve(static_cast(n)); + for (R_xlen_t i = 0; i < n; ++i) { + const double t = time[i]; + if (!R_finite(t)) { + Rcpp::stop("node time must be finite at row %d", static_cast(i + 1)); + } + flagsData.push_back(static_cast(flags[i])); + populationData.push_back(static_cast(population[i])); + individualData.push_back(static_cast(individual[i])); + } + + const tsk_size_t start = tables->nodes.num_rows; + const int ret = tsk_node_table_append_columns( + &tables->nodes, + static_cast(n), + flagsData.data(), + REAL(time), + populationData.data(), + individualData.data(), + nullptr, + nullptr + ); + stopIfTskError(static_cast(ret), "Failed to append node rows"); + + for (R_xlen_t i = 0; i < n; ++i) { + out[i] = static_cast(start + static_cast(i)); + } + return out; +} + +// [[Rcpp::export]] +Rcpp::IntegerVector tsForwardNodeTableAddRowsWithMetadata( + const SEXP tc, + const Rcpp::IntegerVector flags, + const Rcpp::NumericVector time, + const Rcpp::IntegerVector population, + const Rcpp::IntegerVector individual, + const Rcpp::CharacterVector nodeKey) { + const R_xlen_t n = time.size(); + if (flags.size() != n || population.size() != n || individual.size() != n || + nodeKey.size() != n) { + Rcpp::stop("flags/time/population/individual/nodeKey must have identical lengths"); + } + rtsk_table_collection_t tc_xptr(asTableCollectionXptr(tc)); + tsk_table_collection_t *tables = tc_xptr; + if (tables == nullptr) { + Rcpp::stop("Table collection pointer is null"); + } + + Rcpp::IntegerVector out(n); + if (n == 0) { + return out; + } + + std::vector flagsData; + std::vector populationData; + std::vector individualData; + std::vector metadataData; + std::vector metadataOffset; + flagsData.reserve(static_cast(n)); + populationData.reserve(static_cast(n)); + individualData.reserve(static_cast(n)); + metadataOffset.reserve(static_cast(n) + 1); + metadataOffset.push_back(0); + + for (R_xlen_t i = 0; i < n; ++i) { + const double t = time[i]; + if (!R_finite(t)) { + Rcpp::stop("node time must be finite at row %d", static_cast(i + 1)); + } + if (Rcpp::CharacterVector::is_na(nodeKey[i])) { + Rcpp::stop("nodeKey must not be NA at row %d", static_cast(i + 1)); + } + + flagsData.push_back(static_cast(flags[i])); + populationData.push_back(static_cast(population[i])); + individualData.push_back(static_cast(individual[i])); + + const std::string key = Rcpp::as(nodeKey[i]); + const std::string metadata = "{\"alphaSimR\":{\"id\":\"" + key + "\"}}"; + metadataData.insert(metadataData.end(), metadata.begin(), metadata.end()); + metadataOffset.push_back(static_cast(metadataData.size())); + } + + const tsk_size_t start = tables->nodes.num_rows; + const int ret = tsk_node_table_append_columns( + &tables->nodes, + static_cast(n), + flagsData.data(), + REAL(time), + populationData.data(), + individualData.data(), + metadataData.data(), + metadataOffset.data() + ); + stopIfTskError(static_cast(ret), "Failed to append node rows with metadata"); + + for (R_xlen_t i = 0; i < n; ++i) { + out[i] = static_cast(start + static_cast(i)); + } + return out; +} + +// [[Rcpp::export]] +void tsForwardEdgeTableAddRows(const SEXP tc, + const Rcpp::NumericVector left, + const Rcpp::NumericVector right, + const Rcpp::IntegerVector parent, + const Rcpp::IntegerVector child) { + const R_xlen_t n = left.size(); + if (right.size() != n || parent.size() != n || child.size() != n) { + Rcpp::stop("left/right/parent/child must have identical lengths"); + } + rtsk_table_collection_t tc_xptr(asTableCollectionXptr(tc)); + tsk_table_collection_t *tables = tc_xptr; + if (tables == nullptr) { + Rcpp::stop("Table collection pointer is null"); + } + + std::vector leftData; + std::vector rightData; + std::vector parentData; + std::vector childData; + leftData.reserve(static_cast(n)); + rightData.reserve(static_cast(n)); + parentData.reserve(static_cast(n)); + childData.reserve(static_cast(n)); + + for (R_xlen_t i = 0; i < n; ++i) { + const double l = left[i]; + const double r = right[i]; + if (!R_finite(l) || !R_finite(r) || r <= l) { + continue; + } + leftData.push_back(l); + rightData.push_back(r); + parentData.push_back(static_cast(parent[i])); + childData.push_back(static_cast(child[i])); + } + + if (leftData.empty()) { + return; + } + + const int ret = tsk_edge_table_append_columns( + &tables->edges, + static_cast(leftData.size()), + leftData.data(), + rightData.data(), + parentData.data(), + childData.data(), + nullptr, + nullptr + ); + stopIfTskError(static_cast(ret), "Failed to append edge rows"); +} + +// [[Rcpp::export]] +void tsForwardSetSampleFlags(const SEXP tc, + const Rcpp::IntegerVector samples, + const bool clearExisting = true) { + rtsk_table_collection_t tc_xptr(asTableCollectionXptr(tc)); + tsk_table_collection_t *tables = tc_xptr; + if (tables == nullptr) { + Rcpp::stop("Table collection pointer is null"); + } + + const tsk_size_t nNodes = tables->nodes.num_rows; + if (clearExisting) { + for (tsk_size_t i = 0; i < nNodes; ++i) { + tables->nodes.flags[i] &= ~static_cast(TSK_NODE_IS_SAMPLE); + } + } + + for (R_xlen_t i = 0; i < samples.size(); ++i) { + const int node = samples[i]; + if (node == NA_INTEGER) { + continue; + } + if (node < 0 || static_cast(node) >= nNodes) { + Rcpp::stop("sample node id out of bounds at index %d", static_cast(i + 1)); + } + tables->nodes.flags[node] |= static_cast(TSK_NODE_IS_SAMPLE); + } +} diff --git a/src/tsRecorder.cpp b/src/tsRecorder.cpp new file mode 100644 index 00000000..e37c8b3c --- /dev/null +++ b/src/tsRecorder.cpp @@ -0,0 +1,276 @@ +#include "simulator.h" +#include "postTS.h" + +#include +#include +#include +#include + +namespace { + +inline void checkTsk(int status, const char * context) { + if (status < 0) { + throw std::runtime_error(std::string(context) + ": " + + std::string(tsk_strerror(status))); + } +} + +void rescaleTableCollectionTimes(tsk_table_collection_t * tables, double timeScale) { + if (tables == nullptr || timeScale == 1.0) { + return; + } + if (!(timeScale > 0.0) || !std::isfinite(timeScale)) { + throw std::runtime_error("timeScale must be a finite positive value"); + } + + for (tsk_size_t i = 0; i < tables->nodes.num_rows; ++i) { + tables->nodes.time[i] *= timeScale; + } + for (tsk_size_t i = 0; i < tables->mutations.num_rows; ++i) { + const double t = tables->mutations.time[i]; + if (!tsk_is_unknown_time(t)) { + tables->mutations.time[i] = t * timeScale; + } + } + for (tsk_size_t i = 0; i < tables->migrations.num_rows; ++i) { + tables->migrations.time[i] *= timeScale; + } + + static const char generationUnits[] = "generations"; + checkTsk(tsk_table_collection_set_time_units( + tables, generationUnits, sizeof(generationUnits) - 1), + "Failed to set TS time_units"); +} + +} // namespace + +TsRecorder::TsRecorder(double seqLengthBp, TsPositionMode positionMode, + bool inbred, unsigned int ploidy): + pTables(nullptr), + positionMode(positionMode), + dSequenceLengthBp(seqLengthBp > 0.0 ? seqLengthBp : 1.0), + bSamplesPreRegistered(false), + bSimplified(false), + bInbred(inbred), + iPloidy(ploidy > 0 ? ploidy : 1) { + + pTables = new tsk_table_collection_t; + checkTsk(tsk_table_collection_init(pTables, 0), "Failed to initialise tsk tables"); + pTables->sequence_length = positionMode == TsPositionMode::PHYSICAL_BP ? + dSequenceLengthBp : 1.0; +} + +TsRecorder::~TsRecorder() { + if (pTables != nullptr) { + tsk_table_collection_free(pTables); + delete pTables; + pTables = nullptr; + } +} + +void TsRecorder::preRegisterSamples(NodePtr * pSampleNodes, unsigned int nSamples) { + if (bSamplesPreRegistered) { + return; + } + if (pTables == nullptr) { + throw std::runtime_error("TS tables are not initialized"); + } + if (!bInbred && (nSamples % iPloidy != 0)) { + throw std::runtime_error("Sample count is not divisible by ploidy in outbred TS mode"); + } + + sampleNodeIds.clear(); + sampleNodeIndividualMap.clear(); + sampleNodeIds.reserve(nSamples); + + const unsigned int nIndividuals = bInbred ? nSamples : nSamples / iPloidy; + std::vector individualIds; + individualIds.reserve(nIndividuals); + for (unsigned int i = 0; i < nIndividuals; ++i) { + tsk_id_t indivId = tsk_individual_table_add_row(&pTables->individuals, + 0, + nullptr, + 0, + nullptr, + 0, + nullptr, + 0); + checkTsk(static_cast(indivId), "Failed to add individual row"); + individualIds.push_back(indivId); + } + + for (unsigned int i = 0; i < nSamples; ++i) { + NodePtr & node = pSampleNodes[i]; + if (!node) { + continue; + } + const unsigned long long nodeKey = node->getId(); + const unsigned int individualIndex = bInbred ? i : i / iPloidy; + sampleNodeIndividualMap[nodeKey] = individualIds[individualIndex]; + // Preserve runMacs sample order in TS node ids by creating sample rows first. + sampleNodeIds.push_back(getOrCreateNode(node)); + } + bSamplesPreRegistered = true; +} + +double TsRecorder::toTsPosition(double posUnit) const { + double out = positionMode == TsPositionMode::PHYSICAL_BP ? + posUnit * dSequenceLengthBp : posUnit; + const double seqLength = positionMode == TsPositionMode::PHYSICAL_BP ? + dSequenceLengthBp : 1.0; + if (out < 0.0) { + out = 0.0; + } else if (out > seqLength) { + out = seqLength; + } + return out; +} + +tsk_id_t TsRecorder::ensurePopulation(short int population) { + if (population < 0) { + return TSK_NULL; + } + while (pTables->populations.num_rows <= static_cast(population)) { + tsk_id_t newPopulation = tsk_population_table_add_row(&pTables->populations, + nullptr, 0); + checkTsk(static_cast(newPopulation), "Failed to add population row"); + } + return static_cast(population); +} + +tsk_id_t TsRecorder::getOrCreateNode(NodePtr & node) { + const unsigned long long nodeKey = node->getId(); + const auto it = nodeIdMap.find(nodeKey); + if (it != nodeIdMap.end()) { + return it->second; + } + + tsk_flags_t flags = 0; + if (node->getType() == Node::SAMPLE) { + flags |= TSK_NODE_IS_SAMPLE; + } + const tsk_id_t population = ensurePopulation(node->getPopulation()); + tsk_id_t individual = TSK_NULL; + if (node->getType() == Node::SAMPLE) { + const auto sampleIt = sampleNodeIndividualMap.find(nodeKey); + if (sampleIt != sampleNodeIndividualMap.end()) { + individual = sampleIt->second; + } + } + tsk_id_t nodeId = tsk_node_table_add_row(&pTables->nodes, + flags, + node->getHeight(), + population, + individual, + nullptr, + 0); + checkTsk(static_cast(nodeId), "Failed to add node row"); + nodeIdMap.insert(std::make_pair(nodeKey, nodeId)); + return nodeId; +} + +void TsRecorder::recordTreeInterval(const EdgePtrVector & treeEdges, + unsigned int iTotalTreeEdges, + double leftPosUnit, double rightPosUnit) { + const double left = toTsPosition(leftPosUnit); + const double right = toTsPosition(rightPosUnit); + if (right <= left) { + return; + } + + for (unsigned int i = 0; i < iTotalTreeEdges; ++i) { + EdgePtr edge = treeEdges[i]; + if (edge->bDeleted) { + continue; + } + NodePtr & parentNode = edge->getTopNodeRef(); + NodePtr & childNode = edge->getBottomNodeRef(); + const tsk_id_t parent = getOrCreateNode(parentNode); + const tsk_id_t child = getOrCreateNode(childNode); + tsk_id_t edgeId = tsk_edge_table_add_row(&pTables->edges, + left, + right, + parent, + child, + nullptr, + 0); + checkTsk(static_cast(edgeId), "Failed to add edge row"); + } +} + +void TsRecorder::recordMutation(double mutationPosUnit, EdgePtr & selectedEdge, + double mutationTime) { + double position = toTsPosition(mutationPosUnit); + const double seqLength = positionMode == TsPositionMode::PHYSICAL_BP ? + dSequenceLengthBp : 1.0; + if (position >= seqLength) { + // Enforce [0, sequence_length) constraint used by tskit for site positions. + position = std::nextafter(seqLength, 0.0); + } + + static const char ancestralState[] = "0"; + static const char derivedState[] = "1"; + tsk_id_t siteId = tsk_site_table_add_row(&pTables->sites, + position, + ancestralState, + 1, + nullptr, + 0); + checkTsk(static_cast(siteId), "Failed to add site row"); + + NodePtr & childNode = selectedEdge->getBottomNodeRef(); + const tsk_id_t nodeId = getOrCreateNode(childNode); + tsk_id_t mutationId = tsk_mutation_table_add_row(&pTables->mutations, + siteId, + nodeId, + TSK_NULL, + mutationTime, + derivedState, + 1, + nullptr, + 0); + checkTsk(static_cast(mutationId), "Failed to add mutation row"); +} + +void TsRecorder::simplify() { + if (pTables == nullptr || bSimplified) { + return; + } + if (sampleNodeIds.empty()) { + bSimplified = true; + return; + } + checkTsk(tsk_table_collection_sort(pTables, nullptr, 0), + "Failed to sort table collection before simplify"); + checkTsk(tsk_table_collection_simplify(pTables, + sampleNodeIds.data(), + sampleNodeIds.size(), + 0, + nullptr), + "Failed to simplify table collection"); + bSimplified = true; +} + +void TsRecorder::expandInbredSamples() { + if (!bInbred || iPloidy <= 1) { + return; + } + tsPost::expandInbredSamplesInPlace(pTables, iPloidy); +} + +tsk_table_collection_t * TsRecorder::release(double timeScale, bool expandInbred) { + if (pTables == nullptr) { + return nullptr; + } + if (expandInbred) { + expandInbredSamples(); + } + rescaleTableCollectionTimes(pTables, timeScale); + checkTsk(tsk_table_collection_sort(pTables, nullptr, 0), + "Failed to sort table collection"); + checkTsk(tsk_table_collection_build_index(pTables, 0), + "Failed to build table collection index"); + tsk_table_collection_t * out = pTables; + pTables = nullptr; + return out; +} diff --git a/tests/testthat/test-importData.R b/tests/testthat/test-importData.R index 9089b788..ad1740f7 100644 --- a/tests/testthat/test-importData.R +++ b/tests/testthat/test-importData.R @@ -46,3 +46,187 @@ test_that("importTrait",{ expect_equal(unname(pop@gv[2,1]), -3, tolerance=1e-6) }) +test_that("importVCF streams phased VCF and filters unusable sites",{ + vcfFile = tempfile(fileext=".vcf") + writeLines(c( + "##fileformat=VCFv4.2", + paste("#CHROM", "POS", "ID", "REF", "ALT", "QUAL", "FILTER", + "INFO", "FORMAT", "s1", "s2", sep="\t"), + paste("1", "10", "rs1", "A", "C", ".", "PASS", ".", "GT", + "0|1", "1|0", sep="\t"), + paste("1", "20", "rsMulti", "A", "C,G", ".", "PASS", ".", "GT", + "0|1", "1|0", sep="\t"), + paste("1", "30", "rsMissing", "A", "C", ".", "PASS", ".", "GT", + "0|.", "1|1", sep="\t"), + paste("1", "40", "rsBadAllele", "A", "C", ".", "PASS", ".", "GT", + "0|2", "1|1", sep="\t"), + paste("1", "50", "rs5", "A", "C", ".", "PASS", ".", "GT", + "1|1", "0|0", sep="\t"), + paste("1", "60", "rsMono", "A", "C", ".", "PASS", ".", "GT", + "0|0", "0|0", sep="\t"), + paste("2", "5", "rs6", "A", "C", ".", "PASS", ".", "GT", + "0|0", "0|1", sep="\t") + ), vcfFile) + + out = importVCF(vcfFile=vcfFile, + breaks=list("1"=c(0, 100), "2"=c(0, 10)), + rates=list("1"=c(0.01), "2"=c(0.1)), + returnMeta=TRUE) + pop = out$pop + + expect_true(isNamedMapPop(pop)) + expect_equal(pop@id, c("s1", "s2")) + expect_equal(pop@nInd, 2L) + expect_equal(pop@ploidy, 2L) + expect_equal(pop@nLoci, c(2L, 1L)) + expect_equal(names(pop@genMap), c("1", "2")) + expect_equal(unname(pop@genMap[["1"]]), c(0, 0.4), tolerance=1e-12) + expect_equal(unname(pop@genMap[["2"]]), 0, tolerance=1e-12) + expect_equal(out$keptPos[["1"]], c(10, 50)) + expect_equal(out$keptPos[["2"]], 5) + expect_equal(out$stats$skippedNonBiallelic, 1L) + expect_equal(out$stats$skippedMissing, 1L) + expect_equal(out$stats$skippedInvalidAllele, 1L) + expect_equal(out$stats$skippedNonSegregating, 1L) + + H = pullSegSiteHaplo(pop, nThreads=1L) + expected = rbind(c(0, 1, 0), + c(1, 1, 0), + c(1, 0, 0), + c(0, 0, 1)) + rownames(expected) = c("s1_1", "s1_2", "s2_1", "s2_2") + colnames(expected) = c("rs1", "rs5", "rs6") + expect_equal(H, expected) +}) + +test_that("importVCF rejects unphased genotype calls by default",{ + vcfFile = tempfile(fileext=".vcf") + writeLines(c( + "##fileformat=VCFv4.2", + paste("#CHROM", "POS", "ID", "REF", "ALT", "QUAL", "FILTER", + "INFO", "FORMAT", "s1", "s2", sep="\t"), + paste("1", "10", "rs1", "A", "C", ".", "PASS", ".", "GT", + "0/1", "1|0", sep="\t") + ), vcfFile) + + expect_error( + importVCF(vcfFile=vcfFile, + breaks=c(0, 100), + rates=c(0.01)), + regexp="unphased" + ) +}) + +test_that("importVCF reservoir samples per chromosome",{ + vcfFile = tempfile(fileext=".vcf") + writeLines(c( + "##fileformat=VCFv4.2", + paste("#CHROM", "POS", "ID", "REF", "ALT", "QUAL", "FILTER", + "INFO", "FORMAT", "s1", "s2", sep="\t"), + paste("1", "10", "rs1", "A", "C", ".", "PASS", ".", "GT", + "0|1", "1|0", sep="\t"), + paste("1", "20", "rs2", "A", "C", ".", "PASS", ".", "GT", + "1|0", "0|1", sep="\t"), + paste("2", "10", "rs3", "A", "C", ".", "PASS", ".", "GT", + "0|1", "1|0", sep="\t"), + paste("2", "20", "rs4", "A", "C", ".", "PASS", ".", "GT", + "1|0", "0|1", sep="\t") + ), vcfFile) + + out = importVCF(vcfFile=vcfFile, + breaks=list("1"=c(0, 100), "2"=c(0, 100)), + rates=list("1"=c(0.01), "2"=c(0.01)), + segSites=c("1"=1L, "2"=1L), + siteSamplingSeed=12L, + returnMeta=TRUE) + + expect_equal(out$pop@nLoci, c(1L, 1L)) + expect_equal(out$stats$keptByChr, c("1"=1L, "2"=1L)) +}) + +test_that("importVCF can initialize TS forward recorder tables",{ + vcfFile = tempfile(fileext=".vcf") + writeLines(c( + "##fileformat=VCFv4.2", + paste("#CHROM", "POS", "ID", "REF", "ALT", "QUAL", "FILTER", + "INFO", "FORMAT", "s1", "s2", sep="\t"), + paste("1", "10", "rs1", "A", "C", ".", "PASS", ".", "GT", + "0|1", "1|0", sep="\t"), + paste("1", "50", "rs2", "A", "C", ".", "PASS", ".", "GT", + "1|1", "0|0", sep="\t") + ), vcfFile) + + out = importVCF(vcfFile=vcfFile, + breaks=list("1"=c(0, 100)), + rates=list("1"=c(0.01)), + tsRecord=TRUE, + returnMeta=TRUE) + outAlias = importVCF(vcfFile=vcfFile, + breaks=list("1"=c(0, 100)), + rates=list("1"=c(0.01)), + tsRecorde=TRUE, + returnMeta=TRUE) + outNoMut = importVCF(vcfFile=vcfFile, + breaks=list("1"=c(0, 100)), + rates=list("1"=c(0.01)), + tsRecord=TRUE, + addTsMut=FALSE, + returnMeta=TRUE) + founder = out$pop + + expect_true(!is.null(attr(founder, "tsForwardSource", exact=TRUE))) + expect_true(!is.null(attr(founder, "tsForwardPosMeta", exact=TRUE))) + expect_length(out$tsTables, 1L) + expect_length(outAlias$tsTables, 1L) + expect_length(outNoMut$tsTables, 1L) + + summary = rtsk_table_collection_summary2(out$tsTables[[1L]]) + expect_equal(as.integer(summary$num_individuals), 2L) + expect_equal(as.integer(summary$num_nodes), 4L) + expect_equal(as.integer(summary$num_sites), 2L) + expect_equal(as.integer(summary$num_mutations), 4L) + + summaryNoMut = rtsk_table_collection_summary2(outNoMut$tsTables[[1L]]) + expect_equal(as.integer(summaryNoMut$num_individuals), 2L) + expect_equal(as.integer(summaryNoMut$num_nodes), 4L) + expect_equal(as.integer(summaryNoMut$num_sites), 0L) + expect_equal(as.integer(summaryNoMut$num_mutations), 0L) + + SP = SimParam$new(founder) + SP$nThreads = 1L + SP$quadProb = 0 + pop0 = newPop(founder, simParam=SP) + expect_silent(SP$setTrackTs(TRUE, founderPop=pop0)) + expect_true(AlphaSimR:::tsForwardHasRecorder(SP)) + + pop1 = makeCross(pop0, matrix(c(1, 2), ncol=2), nProgeny=1, + simParam=SP) + expect_equal(pop1@nInd, 1L) + + paths = AlphaSimR:::tsForwardFinalizeFromSimParam( + SP, + out_dir=tempdir(), + out_basename=paste0("vcf_ts_forward_", Sys.getpid()), + clear=TRUE + ) + expect_true(file.exists(paths[[1L]])) + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + unlink(paths, force=TRUE) + + SPnoMut = SimParam$new(outNoMut$pop) + SPnoMut$nThreads = 1L + SPnoMut$quadProb = 0 + pop0NoMut = newPop(outNoMut$pop, simParam=SPnoMut) + expect_silent(SPnoMut$setTrackTs(TRUE, founderPop=pop0NoMut)) + pop1NoMut = makeCross(pop0NoMut, matrix(c(1, 2), ncol=2), nProgeny=1, + simParam=SPnoMut) + expect_equal(pop1NoMut@nInd, 1L) + pathsNoMut = AlphaSimR:::tsForwardFinalizeFromSimParam( + SPnoMut, + out_dir=tempdir(), + out_basename=paste0("vcf_ts_forward_no_mut_", Sys.getpid()), + clear=TRUE + ) + expect_true(file.exists(pathsNoMut[[1L]])) + unlink(pathsNoMut, force=TRUE) +}) diff --git a/tests/testthat/test-macsts-staged.R b/tests/testthat/test-macsts-staged.R new file mode 100644 index 00000000..61f20a42 --- /dev/null +++ b/tests/testthat/test-macsts-staged.R @@ -0,0 +1,280 @@ +context("MaCSTS staged simAnc/simMut checks") + +skip_if_not_installed("RcppTskit") + +ts_get <- function(ts, name) { + value <- ts[[name]] + if (is.function(value)) { + value() + } else { + value + } +} + +ts_variants_iterator <- function(ts) { + variants <- ts[["variants"]] + if (is.function(variants)) { + variants() + } else { + variants + } +} + +ts_next_variant <- function(it) { + if (is.null(it)) { + return(NULL) + } + if (is.function(it)) { + return(it()) + } + + nxt <- it[["next_variant"]] + if (!is.null(nxt)) { + if (is.function(nxt)) { + return(nxt()) + } + return(nxt) + } + + nxt <- it[["next"]] + if (!is.null(nxt)) { + if (is.function(nxt)) { + return(nxt()) + } + return(nxt) + } + + return(NULL) +} + +ts_variant_keys <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + ts <- tc$tree_sequence() + it <- ts_variants_iterator(ts) + keys <- character(0) + repeat { + v <- ts_next_variant(it) + if (is.null(v)) { + break + } + pos <- format(signif(as.numeric(v$position), 15), + scientific = FALSE, trim = TRUE) + keys <- c(keys, paste0(pos, "|", paste(as.integer(v$genotypes), collapse = ""))) + } + sort(keys) +} + +table_counts <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + ts <- tc$tree_sequence() + list( + num_sites = as.integer(tc$num_sites()), + num_mutations = as.integer(tc$num_mutations()), + num_nodes = as.integer(tc$num_nodes()), + num_edges = as.integer(tc$num_edges()), + num_trees = as.integer(ts_get(ts, "num_trees")) + ) +} + +node_times <- function(tc) { + n_nodes <- as.integer(tc$num_nodes()) + vapply(seq_len(n_nodes), function(i) { + as.numeric(tc$node_table_get_row(i - 1L)$time) + }, numeric(1)) +} + +test_that("simAnc + simMut staged workflow is reproducible for fixed seeds", { + args <- "8 5000 -t 1e-3 -r 1e-4 -s " + nChr <- 2L + seed <- as.integer(c(101, 202)) + mut_seed <- as.integer(c(555, 666)) + dTheta <- c(80, 80) + + anc_a <- AlphaSimR:::simAnc( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed, + usePhysicalPositions = FALSE, + Nref = NA_real_ + ) + anc_b <- AlphaSimR:::simAnc( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed, + usePhysicalPositions = FALSE, + Nref = NA_real_ + ) + + expect_identical(anc_a$stage, "simAnc") + expect_identical(anc_a$mutationMode, "none") + expect_identical(anc_a$useMacsMut, FALSE) + expect_equal(length(anc_a$tables), nChr) + + # simAnc is ancestry-only: no sites/mutations should be present yet. + for (chr in seq_len(nChr)) { + c0 <- table_counts(anc_a$tables[[chr]]) + expect_equal(c0$num_sites, 0L) + expect_equal(c0$num_mutations, 0L) + expect_gt(c0$num_trees, 0L) + expect_gt(c0$num_nodes, 0L) + expect_gt(c0$num_edges, 0L) + } + + mut_a <- AlphaSimR:::simMut(anc_a, dTheta = dTheta, seed = mut_seed) + mut_b <- AlphaSimR:::simMut(anc_b, dTheta = dTheta, seed = mut_seed) + + expect_identical(mut_a$stage, "simMut") + expect_identical(mut_a$mutationMode, "postTs") + expect_equal(as.integer(mut_a$mutationSeed), mut_seed) + + keys_a <- lapply(mut_a$tables, ts_variant_keys) + keys_b <- lapply(mut_b$tables, ts_variant_keys) + expect_identical(keys_a, keys_b) + + for (chr in seq_len(nChr)) { + c1 <- table_counts(mut_a$tables[[chr]]) + expect_gt(c1$num_mutations, 0L) + expect_equal(c1$num_sites, c1$num_mutations) + } +}) + +test_that("simMut with zero dTheta leaves ancestry tables unchanged", { + args <- "8 5000 -t 1e-3 -r 1e-4 -s " + anc <- AlphaSimR:::simAnc( + args = args, + nChr = 1L, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = as.integer(42), + usePhysicalPositions = FALSE, + Nref = NA_real_ + ) + + before <- table_counts(anc$tables[[1]]) + out <- AlphaSimR:::simMut(anc, dTheta = 0, seed = as.integer(99)) + after <- table_counts(out$tables[[1]]) + + expect_identical(before, after) + expect_equal(after$num_sites, 0L) + expect_equal(after$num_mutations, 0L) +}) + +test_that("post-TS mutations are placed within edge span and branch-time bounds", { + args <- "8 5000 -t 1e-3 -r 1e-4 -s " + anc <- AlphaSimR:::simAnc( + args = args, + nChr = 1L, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = as.integer(88), + usePhysicalPositions = TRUE, + Nref = NA_real_ + ) + + out <- AlphaSimR:::simMut(anc, dTheta = 150, seed = as.integer(77)) + tc <- RcppTskit::TableCollection$new(xptr = out$tables[[1]]) + + n_mut <- as.integer(tc$num_mutations()) + n_edge <- as.integer(tc$num_edges()) + n_node <- as.integer(tc$num_nodes()) + n_site <- as.integer(tc$num_sites()) + seq_len <- as.numeric(tc$sequence_length()) + + expect_gt(n_mut, 0L) + expect_equal(n_site, n_mut) + + edge_child <- integer(n_edge) + edge_parent <- integer(n_edge) + edge_left <- numeric(n_edge) + edge_right <- numeric(n_edge) + for (i in seq_len(n_edge)) { + e <- tc$edge_table_get_row(i - 1L) + edge_child[i] <- as.integer(e$child) + edge_parent[i] <- as.integer(e$parent) + edge_left[i] <- as.numeric(e$left) + edge_right[i] <- as.numeric(e$right) + } + + node_time <- numeric(n_node) + for (i in seq_len(n_node)) { + node_time[i] <- as.numeric(tc$node_table_get_row(i - 1L)$time) + } + + site_pos <- numeric(n_site) + for (i in seq_len(n_site)) { + site_pos[i] <- as.numeric(tc$site_table_get_row(i - 1L)$position) + } + + for (i in seq_len(n_mut)) { + m <- tc$mutation_table_get_row(i - 1L) + child <- as.integer(m$node) + site <- as.integer(m$site) + mut_time <- as.numeric(m$time) + pos <- site_pos[site + 1L] + + expect_true(pos >= 0) + expect_true(pos < seq_len) + + idx <- which(edge_child == child & edge_left <= pos & pos < edge_right) + expect_true(length(idx) > 0L) + + child_time <- node_time[child + 1L] + parent_time <- node_time[edge_parent[idx] + 1L] + expect_true(any(mut_time > child_time & mut_time < parent_time)) + } +}) + +test_that("Nref rescales node times and sets TS time_units to generations", { + args <- "8 5000 -t 1e-3 -r 1e-4 -s " + seed <- as.integer(12345) + nref <- 10000 + scale <- 4 * nref + + anc_unit <- AlphaSimR:::simAnc( + args = args, + nChr = 1L, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed, + usePhysicalPositions = FALSE, + Nref = NA_real_ + ) + anc_gen <- AlphaSimR:::simAnc( + args = args, + nChr = 1L, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed, + usePhysicalPositions = FALSE, + Nref = nref + ) + + tc_unit <- RcppTskit::TableCollection$new(xptr = anc_unit$tables[[1]]) + tc_gen <- RcppTskit::TableCollection$new(xptr = anc_gen$tables[[1]]) + + expect_equal(anc_unit$timeScale, 1) + expect_equal(anc_gen$timeScale, scale) + expect_identical(tc_unit$time_units(), "unknown") + expect_identical(tc_gen$time_units(), "generations") + + t_unit <- node_times(tc_unit) + t_gen <- node_times(tc_gen) + expect_equal(length(t_unit), length(t_gen)) + expect_true(isTRUE(all.equal(t_gen, t_unit * scale, tolerance = 1e-8))) + + c_unit <- table_counts(anc_unit$tables[[1]]) + c_gen <- table_counts(anc_gen$tables[[1]]) + expect_equal(c_unit$num_nodes, c_gen$num_nodes) + expect_equal(c_unit$num_edges, c_gen$num_edges) + expect_equal(c_unit$num_trees, c_gen$num_trees) +}) diff --git a/tests/testthat/test-macsts-useMacsMut.R b/tests/testthat/test-macsts-useMacsMut.R new file mode 100644 index 00000000..af9e15bb --- /dev/null +++ b/tests/testthat/test-macsts-useMacsMut.R @@ -0,0 +1,378 @@ +context("MaCSTS useMacsMut compatibility") + +to_int01_matrix <- function(x) { + matrix(as.integer(x), nrow = nrow(x), ncol = ncol(x), dimnames = dimnames(x)) +} + +ts_get <- function(ts, name) { + value <- ts[[name]] + if (is.function(value)) { + value() + } else { + value + } +} + +ts_variants_iterator <- function(ts) { + variants <- ts[["variants"]] + if (is.function(variants)) { + variants() + } else { + variants + } +} + +ts_next_variant <- function(it) { + if (is.null(it)) { + return(NULL) + } + if (is.function(it)) { + return(it()) + } + + nxt <- it[["next_variant"]] + if (!is.null(nxt)) { + if (is.function(nxt)) { + return(nxt()) + } + return(nxt) + } + + nxt <- it[["next"]] + if (!is.null(nxt)) { + if (is.function(nxt)) { + return(nxt()) + } + return(nxt) + } + + return(NULL) +} + +extract_macs_chr <- function(macs_out, chr = 1L, nThreads = 1L) { + pos <- as.numeric(macs_out$genMap[[chr]]) + n_sites <- length(pos) + if (n_sites == 0L) { + stop("zero sites produced; choose higher mutation settings for this test") + } + hap_raw <- AlphaSimR:::getHaplo( + geno = macs_out$geno[chr], + lociPerChr = as.integer(n_sites), + lociLoc = as.integer(seq_len(n_sites)), + nThreads = as.integer(nThreads) + ) + list(pos = pos, hap = to_int01_matrix(hap_raw)) +} + +extract_ts_chr <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + ts <- tc$tree_sequence() + n_samples <- as.integer(ts_get(ts, "num_samples")) + it <- ts_variants_iterator(ts) + pos <- numeric(0) + cols <- list() + repeat { + v <- ts_next_variant(it) + if (is.null(v)) { + break + } + pos <- c(pos, as.numeric(v$position)) + cols[[length(cols) + 1L]] <- as.integer(v$genotypes) + } + hap <- if (length(cols) == 0L) { + matrix(integer(0), nrow = n_samples, ncol = 0L) + } else { + do.call(cbind, cols) + } + list( + pos = pos, + hap = hap, + num_sites = as.integer(ts_get(ts, "num_sites")), + num_mutations = as.integer(ts_get(ts, "num_mutations")) + ) +} + +site_hap_keys <- function(pos, hap) { + if (length(pos) == 0L) { + return(character(0)) + } + p <- format(signif(pos, 15), scientific = FALSE, trim = TRUE) + vapply( + seq_len(ncol(hap)), + function(j) paste0(p[j], "|", paste(hap[, j], collapse = "")), + character(1) + ) +} + +compare_chr <- function(macs_chr, ts_chr) { + ord_m <- order(macs_chr$pos) + ord_t <- order(ts_chr$pos) + m_pos <- macs_chr$pos[ord_m] + t_pos <- ts_chr$pos[ord_t] + m_hap <- macs_chr$hap[, ord_m, drop = FALSE] + t_hap <- ts_chr$hap[, ord_t, drop = FALSE] + + same_nsites <- ncol(m_hap) == ncol(t_hap) + same_positions_strict <- isTRUE(all.equal(m_pos, t_pos, tolerance = 0)) + same_hap_strict <- identical(m_hap, t_hap) + + keys_m <- sort(site_hap_keys(macs_chr$pos, macs_chr$hap)) + keys_t <- sort(site_hap_keys(ts_chr$pos, ts_chr$hap)) + same_site_hap_multiset <- identical(keys_m, keys_t) + has_duplicate_positions <- any(duplicated(m_pos)) || any(duplicated(t_pos)) + + list( + same_nsites = same_nsites, + same_positions_strict = same_positions_strict, + same_hap_strict = same_hap_strict, + same_site_hap_multiset = same_site_hap_multiset, + has_duplicate_positions = has_duplicate_positions, + ts_num_sites = ts_chr$num_sites, + ts_num_mutations = ts_chr$num_mutations + ) +} + +run_case <- function(args, nChr, inbred, ploidy, seed, nThreads = 1L) { + seed_vec <- rep(as.integer(seed), as.integer(nChr)) + macs <- AlphaSimR:::MaCS( + args = args, + maxSites = rep(0L, as.integer(nChr)), + inbred = inbred, + ploidy = as.integer(ploidy), + nThreads = as.integer(nThreads), + seed = seed_vec + ) + ts_out <- AlphaSimR:::MaCSTS( + args = args, + nChr = as.integer(nChr), + inbred = inbred, + ploidy = as.integer(ploidy), + nThreads = as.integer(nThreads), + seed = seed_vec, + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ) + + out <- lapply(seq_len(as.integer(nChr)), function(chr) { + m <- extract_macs_chr(macs, chr = chr, nThreads = nThreads) + t <- extract_ts_chr(ts_out$tables[[chr]]) + compare_chr(m, t) + }) + out +} + +test_that("MaCSTS(useMacsMut=TRUE) matches MaCS across representative scenarios", { + scenarios <- list( + list( + name = "base_outbred_ploidy2", + args = "8 50000 -t 1e-3 -r 1e-4 -s ", + inbred = FALSE, + ploidy = 2L + ), + list( + name = "base_outbred_ploidy1", + args = "8 50000 -t 1e-3 -r 1e-4 -s ", + inbred = FALSE, + ploidy = 1L + ), + list( + name = "base_inbred_ploidy2", + args = "8 50000 -t 1e-3 -r 1e-4 -s ", + inbred = TRUE, + ploidy = 2L + ), + list( + name = "demography_eN", + args = "8 50000 -t 1e-3 -r 1e-4 -eN 0.2 2.0 -eN 0.9 0.5 -s ", + inbred = FALSE, + ploidy = 2L + ), + list( + name = "multipop_with_migration_change", + args = "8 50000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -eM 0.5 5e-3 -s ", + inbred = FALSE, + ploidy = 2L + ), + list( + name = "multipop_en_plus_join", + args = "8 50000 -t 1e-3 -r 1e-4 -I 2 4 4 1e-2 -en 0.2 2 0.5 -ej 1.0 2 1 -s ", + inbred = FALSE, + ploidy = 2L + ) + ) + + for (sc in scenarios) { + res <- run_case( + args = sc$args, + nChr = 1L, + inbred = sc$inbred, + ploidy = sc$ploidy, + seed = 12345L, + nThreads = 1L + )[[1]] + + expect_true(res$same_nsites, info = sc$name) + expect_true(res$same_site_hap_multiset, info = sc$name) + expect_true(res$same_positions_strict, info = sc$name) + # With duplicate positions, column order can differ while the site/haplotype + # multiset remains identical; strict matrix identity is too strong. + if (!isTRUE(res$has_duplicate_positions)) { + expect_true(res$same_hap_strict, info = sc$name) + } + expect_equal(res$ts_num_sites, res$ts_num_mutations, info = sc$name) + } +}) + +test_that("MaCSTS(useMacsMut=TRUE) is reproducible across chromosomes for fixed seeds", { + args <- "8 50000 -t 1e-3 -r 1e-4 -s " + nChr <- 3L + seed_vec <- as.integer(c(101, 202, 303)) + + out_a <- AlphaSimR:::MaCSTS( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed_vec, + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ) + out_b <- AlphaSimR:::MaCSTS( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed_vec, + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ) + out_c <- AlphaSimR:::MaCSTS( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed_vec + 1L, + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ) + + keys_from <- function(out) { + lapply(seq_len(nChr), function(chr) { + x <- extract_ts_chr(out$tables[[chr]]) + sort(site_hap_keys(x$pos, x$hap)) + }) + } + + keys_a <- keys_from(out_a) + keys_b <- keys_from(out_b) + keys_c <- keys_from(out_c) + + expect_identical(keys_a, keys_b) + # Different seeds should usually differ, but in rare runs can coincide. + if (!any(!vapply(seq_len(nChr), function(i) identical(keys_a[[i]], keys_c[[i]]), logical(1)))) { + skip("Different seed vector produced identical site/haplotype keys in this run") + } +}) + +test_that("usePhysicalPositions changes coordinate scale only", { + args <- "8 50000 -t 1e-3 -r 1e-4 -s " + nChr <- 1L + seed <- as.integer(777) + seq_len_bp <- as.numeric(strsplit(args, "[,[:space:]]+", perl = TRUE)[[1]][2]) + + out_unit <- AlphaSimR:::MaCSTS( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed, + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ) + out_bp <- AlphaSimR:::MaCSTS( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed, + usePhysicalPositions = TRUE, + useMacsMut = TRUE + ) + + chr_unit <- extract_ts_chr(out_unit$tables[[1]]) + chr_bp <- extract_ts_chr(out_bp$tables[[1]]) + + expect_true(all(chr_unit$pos >= 0 & chr_unit$pos <= 1)) + expect_true(all(chr_bp$pos >= 0 & chr_bp$pos <= seq_len_bp)) + + # Haplotypes should match exactly; positions should match after rescaling. + expect_identical(sort(site_hap_keys(chr_unit$pos, chr_unit$hap)), + sort(site_hap_keys(chr_bp$pos / seq_len_bp, chr_bp$hap))) + expect_true(isTRUE(all.equal(sort(chr_unit$pos), sort(chr_bp$pos / seq_len_bp), tolerance = 1e-12))) +}) + +test_that("MaCSTS validates key inputs", { + args <- "8 50000 -t 1e-3 -r 1e-4 -s " + + expect_error( + AlphaSimR:::MaCSTS( + args = args, + nChr = 0L, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = as.integer(1), + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ), + "nChr must be a positive integer" + ) + + expect_error( + AlphaSimR:::MaCSTS( + args = args, + nChr = 1L, + inbred = FALSE, + ploidy = 0L, + nThreads = 1L, + seed = as.integer(1), + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ), + "ploidy must be a positive integer" + ) + + expect_error( + AlphaSimR:::MaCSTS( + args = args, + nChr = 2L, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = as.integer(1), + usePhysicalPositions = FALSE, + useMacsMut = TRUE + ), + "seed length must match number of chromosomes" + ) + + expect_error( + AlphaSimR:::MaCSTS( + args = args, + nChr = 1L, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = as.integer(1), + usePhysicalPositions = FALSE, + useMacsMut = TRUE, + Nref = 0 + ), + "Nref must be positive when provided" + ) +}) diff --git a/tests/testthat/test-runMacsTS-sensitivity.R b/tests/testthat/test-runMacsTS-sensitivity.R new file mode 100644 index 00000000..251ced24 --- /dev/null +++ b/tests/testthat/test-runMacsTS-sensitivity.R @@ -0,0 +1,463 @@ +context("runMacsTS wrapper and parameter sensitivity") + +skip_if_not_installed("RcppTskit") + +tc_summary <- function(tc_xptr) { + AlphaSimR::rtsk_table_collection_summary2(tc_xptr) +} + +node_times <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + n_nodes <- as.integer(tc$num_nodes()) + vapply(seq_len(n_nodes), function(i) { + as.numeric(tc$node_table_get_row(i - 1L)$time) + }, numeric(1)) +} + +sample_node_count <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + n_nodes <- as.integer(tc$num_nodes()) + flags <- vapply(seq_len(n_nodes), function(i) { + as.integer(tc$node_table_get_row(i - 1L)$flags) + }, integer(1)) + sum(bitwAnd(flags, 1L) != 0L) +} + +site_position_range <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + n_sites <- as.integer(tc$num_sites()) + if (n_sites == 0L) { + return(c(min = NA_real_, max = NA_real_)) + } + pos <- vapply(seq_len(n_sites), function(i) { + as.numeric(tc$site_table_get_row(i - 1L)$position) + }, numeric(1)) + c(min = min(pos), max = max(pos)) +} + +parse_seq_len <- function(args) { + tokens <- strsplit(as.character(args), "[,[:space:]]+", perl = TRUE)[[1L]] + tokens <- tokens[nzchar(tokens)] + as.numeric(tokens[2L]) +} + +run_staged_from_wrapper <- function(out, inbred, ploidy, segSites, + nThreads = 1L, + usePhysicalPositions = FALSE, + expandInbredTs = FALSE, + siteSamplingSeed = 42L) { + nChr <- length(out$tables) + if (isTRUE(usePhysicalPositions)) { + stop("run_staged_from_wrapper helper currently supports usePhysicalPositions = FALSE only") + } + + anc <- AlphaSimR:::simAnc( + args = out$args, + nChr = nChr, + inbred = inbred, + ploidy = ploidy, + nThreads = nThreads, + seed = out$seed, + usePhysicalPositions = usePhysicalPositions, + Nref = NA_real_ + ) + + dThetaPost <- as.numeric(anc$dTheta) / as.numeric(anc$timeScale) + mutSeed <- if (!all(is.na(out$mutSeed))) { + as.integer(out$mutSeed) + } else { + as.integer(out$seed) + 104729L + } + runOut <- AlphaSimR:::simMut(anc, dTheta = dThetaPost, seed = mutSeed) + + if (isTRUE(expandInbredTs) && isTRUE(inbred) && ploidy > 1L) { + runOut <- AlphaSimR:::finalizeInbredTs(runOut, inbred = inbred, ploidy = ploidy) + } + + breaks <- rep(list(c(0, 1)), nChr) + rates <- rep(list(c(1)), nChr) + pop <- AlphaSimR:::asMapPop( + chr_info = list(tables = runOut$tables, breaks = breaks, rates = rates), + ploidy = ploidy, + inbred = inbred, + segSites = segSites, + site_sampling_seed = as.integer(siteSamplingSeed), + nThreads = as.integer(nThreads), + returnMeta = FALSE + ) + + list(tables = runOut$tables, pop = pop) +} + +expect_wrapper_staged_equal <- function(out, staged) { + expect_identical(out$pop@nLoci, staged$pop@nLoci) + for (chr in seq_along(out$tables)) { + expect_identical(out$pop@geno[[chr]], staged$pop@geno[[chr]]) + expect_true(isTRUE(all.equal(out$pop@genMap[[chr]], staged$pop@genMap[[chr]], tolerance = 0))) + + sw <- tc_summary(out$tables[[chr]]) + ss <- tc_summary(staged$tables[[chr]]) + expect_equal(sw$num_nodes, ss$num_nodes) + expect_equal(sw$num_edges, ss$num_edges) + expect_equal(sw$num_sites, ss$num_sites) + expect_equal(sw$num_mutations, ss$num_mutations) + } +} + +test_that("runMacsTS(postTs) wrapper matches staged workflow (outbred)", { + out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = 60, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + usePhysicalPositions = FALSE, + nThreads = 1L, + seed = as.integer(c(11, 22)), + mutSeed = as.integer(c(111, 222)), + siteSamplingSeed = 42L, + returnTs = TRUE + ) + + staged <- run_staged_from_wrapper( + out = out, + inbred = FALSE, + ploidy = 2L, + segSites = 60, + nThreads = 1L, + usePhysicalPositions = FALSE, + expandInbredTs = FALSE, + siteSamplingSeed = 42L + ) + + expect_wrapper_staged_equal(out, staged) +}) + +test_that("runMacsTS(postTs) wrapper matches staged workflow (inbred, ploidy > 1)", { + out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = 60, + inbred = TRUE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + usePhysicalPositions = FALSE, + expandInbredTs = TRUE, + nThreads = 1L, + seed = as.integer(c(11, 22)), + mutSeed = as.integer(c(111, 222)), + siteSamplingSeed = 42L, + returnTs = TRUE + ) + + staged <- run_staged_from_wrapper( + out = out, + inbred = TRUE, + ploidy = 2L, + segSites = 60, + nThreads = 1L, + usePhysicalPositions = FALSE, + expandInbredTs = TRUE, + siteSamplingSeed = 42L + ) + + expect_wrapper_staged_equal(out, staged) +}) + +test_that("mutationMode='none' returns ancestry-only TS", { + out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "none", + usePhysicalPositions = FALSE, + nThreads = 1L, + seed = as.integer(c(101, 202)), + returnTs = TRUE + ) + + expect_null(out$pop) + expect_identical(out$mutationMode, "none") + expect_true(all(is.na(out$mutSeed))) + + for (chr in seq_along(out$tables)) { + s <- tc_summary(out$tables[[chr]]) + expect_equal(s$num_sites, 0L) + expect_equal(s$num_mutations, 0L) + expect_gt(s$num_nodes, 0L) + expect_gt(s$num_edges, 0L) + } +}) + +test_that("usePhysicalPositions changes coordinate scale while keeping sampled output", { + common <- list( + nInd = 4, + nChr = 1, + segSites = 60, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + nThreads = 1L, + seed = as.integer(123), + mutSeed = as.integer(456), + siteSamplingSeed = 42L, + returnTs = TRUE + ) + out_unit <- do.call(AlphaSimR:::runMacsTS, c(common, list(usePhysicalPositions = FALSE))) + out_bp <- do.call(AlphaSimR:::runMacsTS, c(common, list(usePhysicalPositions = TRUE))) + + s_unit <- tc_summary(out_unit$tables[[1]]) + s_bp <- tc_summary(out_bp$tables[[1]]) + seq_len_bp <- parse_seq_len(out_bp$args) + + expect_equal(as.numeric(s_unit$sequence_length), 1.0, tolerance = 0) + expect_equal(as.numeric(s_bp$sequence_length), seq_len_bp, tolerance = 0) + expect_equal(s_unit$num_sites, s_bp$num_sites) + expect_equal(s_unit$num_mutations, s_bp$num_mutations) + + rng_unit <- site_position_range(out_unit$tables[[1]]) + rng_bp <- site_position_range(out_bp$tables[[1]]) + expect_true(rng_unit["min"] >= 0 && rng_unit["max"] < 1) + expect_true(rng_bp["min"] >= 0 && rng_bp["max"] < seq_len_bp) + + expect_identical(out_unit$pop@nLoci, out_bp$pop@nLoci) + expect_identical(out_unit$pop@geno[[1]], out_bp$pop@geno[[1]]) + expect_true(isTRUE(all.equal(out_unit$pop@genMap[[1]], out_bp$pop@genMap[[1]], tolerance = 1e-12))) +}) + +test_that("runMacsTSBridgeChrInfo reuses runMacsTS map metadata", { + out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = c(40L, 40L), + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + usePhysicalPositions = TRUE, + nThreads = 1L, + seed = as.integer(c(123, 456)), + mutSeed = as.integer(c(789, 987)), + siteSamplingSeed = 42L, + returnTs = TRUE + ) + out_dir <- tempfile("mac_bridge_chr_info_") + chr_info <- AlphaSimR:::runMacsTSBridgeChrInfo(out, out_dir = out_dir) + + pos_meta <- attr(out$pop, "tsForwardPosMeta", exact = TRUE) + + expect_length(chr_info, 2L) + expect_true(all(file.exists(vapply(chr_info, `[[`, character(1), "ts_path")))) + expect_equal(lapply(chr_info, `[[`, "breaks"), pos_meta$breaksList) + expect_equal(lapply(chr_info, `[[`, "rates"), pos_meta$ratesList) + expect_equal(vapply(chr_info, `[[`, integer(1), "segSites"), out$pop@nLoci) +}) + +test_that("runMacsTS converts MaCS -R hotspot file into breaks/rates metadata", { + hotspot_path <- tempfile("macs_hotspot_", fileext = ".txt") + writeLines("0.25 0.5 3", hotspot_path) + on.exit(unlink(hotspot_path, force = TRUE), add = TRUE) + + out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + segSites = 30L, + inbred = FALSE, + ploidy = 2L, + manualCommand = paste("1e5 -t 1e-3 -r 4e-6 -R", hotspot_path), + manualGenLen = 1, + mutationMode = "postTs", + usePhysicalPositions = FALSE, + nThreads = 1L, + seed = as.integer(321), + mutSeed = as.integer(654), + siteSamplingSeed = 42L, + returnTs = TRUE + ) + + pos_meta <- attr(out$pop, "tsForwardPosMeta", exact = TRUE) + expect_equal(pos_meta$breaksList[[1L]], c(0, 0.25, 0.5, 1)) + expect_equal(pos_meta$ratesList[[1L]], c(1, 3, 1)) +}) + +test_that("runMacs genMap conversion uses MaCS -R hotspot map", { + hotspot_path <- tempfile("macs_hotspot_", fileext = ".txt") + writeLines("0.25 0.5 3", hotspot_path) + on.exit(unlink(hotspot_path, force = TRUE), add = TRUE) + + macs_pos <- list(c(0.10, 0.30, 0.60, 0.90)) + manual_command <- paste("1e5 -t 1e-3 -r 4e-6 -R", hotspot_path) + out <- AlphaSimR:::.runMacsGenMapFromMacs( + macsGenMap = macs_pos, + genLen = 1, + manualCommand = manual_command + ) + + expected <- AlphaSimR:::rateMap2cumMorgan( + macs_pos[[1]], + breaks = c(0, 0.25, 0.5, 1), + rates = c(1, 3, 1) + ) + expected <- expected - expected[[1L]] + + expect_equal(unname(out[[1]]), expected, tolerance = 1e-12) + expect_identical(names(out[[1]]), paste(1, seq_along(macs_pos[[1]]), sep = "_")) +}) + +test_that("asMapPop requires breaks/rates for external tree input", { + ts_path <- testthat::test_path("..", "..", "dev", "testData", "msprime_chr0.trees") + skip_if(!file.exists(ts_path), "Missing test fixture dev/testData/msprime_chr0.trees") + + expect_error( + AlphaSimR:::asMapPop(chr_info = list(list(ts_path = ts_path, segSites = 10L))), + regexp = "breaks.*rates|rates.*breaks" + ) +}) + +test_that("Nref rescales TS times in runMacsTS ancestry-only mode", { + seed <- as.integer(42) + nref <- 10000 + scale <- 4 * nref + + out_unit <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "none", + usePhysicalPositions = FALSE, + Nref = NA_real_, + nThreads = 1L, + seed = seed, + returnTs = TRUE + ) + out_gen <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "none", + usePhysicalPositions = FALSE, + Nref = nref, + nThreads = 1L, + seed = seed, + returnTs = TRUE + ) + + expect_equal(out_unit$timeScale, 1) + expect_equal(out_gen$timeScale, scale) + + s_unit <- tc_summary(out_unit$tables[[1]]) + s_gen <- tc_summary(out_gen$tables[[1]]) + expect_identical(s_unit$time_units, "unknown") + expect_identical(s_gen$time_units, "generations") + expect_equal(s_unit$num_nodes, s_gen$num_nodes) + expect_equal(s_unit$num_edges, s_gen$num_edges) + expect_equal(s_unit$num_trees, s_gen$num_trees) + + t_unit <- node_times(out_unit$tables[[1]]) + t_gen <- node_times(out_gen$tables[[1]]) + expect_equal(length(t_unit), length(t_gen)) + expect_true(isTRUE(all.equal(t_gen, t_unit * scale, tolerance = 1e-8))) +}) + +test_that("expandInbredTs toggles inbred leaf expansion in TS", { + out_no_expand <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + inbred = TRUE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "none", + usePhysicalPositions = FALSE, + expandInbredTs = FALSE, + nThreads = 1L, + seed = as.integer(7), + returnTs = TRUE + ) + out_expand <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + inbred = TRUE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "none", + usePhysicalPositions = FALSE, + expandInbredTs = TRUE, + nThreads = 1L, + seed = as.integer(7), + returnTs = TRUE + ) + + s0 <- tc_summary(out_no_expand$tables[[1]]) + s1 <- tc_summary(out_expand$tables[[1]]) + expect_equal(s0$num_sites, 0L) + expect_equal(s1$num_sites, 0L) + expect_equal(s0$num_mutations, 0L) + expect_equal(s1$num_mutations, 0L) + expect_gt(s1$num_nodes, s0$num_nodes) + expect_gt(s1$num_edges, s0$num_edges) + + n_sample_0 <- sample_node_count(out_no_expand$tables[[1]]) + n_sample_1 <- sample_node_count(out_expand$tables[[1]]) + expect_equal(n_sample_0, 4L) + expect_equal(n_sample_1, 8L) +}) + +test_that("runMacTS compatibility aliases dispatch to runMacsTS", { + out_new <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "none", + usePhysicalPositions = FALSE, + nThreads = 1L, + seed = as.integer(11), + returnTs = TRUE + ) + out_old <- AlphaSimR:::runMacTS( + nInd = 4, + nChr = 1, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "none", + usePhysicalPositions = FALSE, + nThreads = 1L, + seed = as.integer(11), + returnTs = TRUE + ) + + expect_equal(tc_summary(out_old$tables[[1]])$num_nodes, + tc_summary(out_new$tables[[1]])$num_nodes) + expect_equal(tc_summary(out_old$tables[[1]])$num_edges, + tc_summary(out_new$tables[[1]])$num_edges) + + out_new_pop <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 1, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + nThreads = 1L, + seed = as.integer(11), + returnTs = TRUE + ) + tmp <- tempdir() + chr_info <- AlphaSimR:::runMacTSBridgeChrInfo(out_new_pop, out_dir = tmp) + expect_true(file.exists(chr_info[[1L]]$ts_path)) + expect_true(grepl("runMacTS_founder_chr0[.]trees$", + chr_info[[1L]]$ts_path)) + unlink(chr_info[[1L]]$ts_path, force = TRUE) +}) diff --git a/tests/testthat/test-tsForwardRecorder.R b/tests/testthat/test-tsForwardRecorder.R new file mode 100644 index 00000000..1494466a --- /dev/null +++ b/tests/testthat/test-tsForwardRecorder.R @@ -0,0 +1,766 @@ +context("TS forward recorder") + +skip_if_not_installed("RcppTskit") + +.ts_forward_test_chr_info <- function() { + ts_path <- testthat::test_path("..", "..", "dev", "testData", "msprime_chr0.trees") + skip_if(!file.exists(ts_path), "Missing test fixture dev/testData/msprime_chr0.trees") + list( + list( + ts_path = ts_path, + breaks = c(0, 1e6), + rates = c(1e-8), + segSites = 60L + ) + ) +} + +.ts_forward_test_setup <- function() { + chr_info <- .ts_forward_test_chr_info() + founder <- AlphaSimR:::asMapPop(chr_info = chr_info, inbred = FALSE, ploidy = 2L) + SP <- SimParam$new(founder) + SP$nThreads <- 1L + SP$setTrackRecGen(TRUE) + SP$quadProb <- 0 + pop0 <- newPop(founder, simParam = SP) + list(chr_info = chr_info, SP = SP, pop0 = pop0) +} + +.normalize_edge_df <- function(df) { + out <- data.frame( + chr = as.integer(df$chr), + child = as.integer(df$child), + parent = as.integer(df$parent), + left = as.numeric(df$left), + right = as.numeric(df$right), + stringsAsFactors = FALSE + ) + out <- out[out$right > out$left, , drop = FALSE] + if (nrow(out) == 0L) { + return(out) + } + ord <- order(out$chr, out$child, out$parent, out$left, out$right) + out <- out[ord, , drop = FALSE] + rownames(out) <- NULL + out +} + +.collect_forward_edges_for_children <- function(recorder, chr, child_iids) { + chrState <- recorder$chr[[chr]] + tc <- chrState$tc + n_edge <- as.integer(tc$num_edges()) + out <- vector("list", n_edge) + k <- 0L + + iid_keys <- ls(chrState$indMap, all.names = TRUE) + if (length(iid_keys) == 0L) { + return(data.frame(chr = integer(), child = integer(), parent = integer(), + left = numeric(), right = numeric(), stringsAsFactors = FALSE)) + } + ind_rows <- vapply(iid_keys, function(key) { + as.integer(get(key, envir = chrState$indMap, inherits = FALSE)) + }, integer(1)) + ind_row_to_iid <- setNames(as.integer(iid_keys), as.character(ind_rows)) + + for (i in seq_len(n_edge)) { + e <- tc$edge_table_get_row(i - 1L) + child_node <- as.integer(e$child) + parent_node <- as.integer(e$parent) + child_ind_row <- as.integer(tc$node_table_get_row(child_node)$individual) + parent_ind_row <- as.integer(tc$node_table_get_row(parent_node)$individual) + + child_iid <- ind_row_to_iid[as.character(child_ind_row)] + parent_iid <- ind_row_to_iid[as.character(parent_ind_row)] + if (length(child_iid) == 0L || length(parent_iid) == 0L || + is.na(child_iid) || is.na(parent_iid)) { + next + } + child_iid <- as.integer(child_iid) + if (!(child_iid %in% child_iids)) { + next + } + + k <- k + 1L + out[[k]] <- data.frame( + chr = as.integer(chr), + child = child_iid, + parent = as.integer(parent_iid), + left = as.numeric(e$left), + right = as.numeric(e$right), + stringsAsFactors = FALSE + ) + } + + if (k == 0L) { + return(data.frame(chr = integer(), child = integer(), parent = integer(), + left = numeric(), right = numeric(), stringsAsFactors = FALSE)) + } + do.call(rbind, out[seq_len(k)]) +} + +.collect_bridge_edges_for_children <- function(SP, sim_output, chr_info, child_iids) { + pos_list <- attr(sim_output[[1L]], "tsForwardPosMeta", exact = TRUE)$posList + bridge_list <- AlphaSimR:::bridgeCollectSegGenFromSimOutput( + SP, + sim_output, + chr_info = chr_info, + pos_list = pos_list + ) + if (length(bridge_list) == 0L) { + return(data.frame(chr = integer(), child = integer(), parent = integer(), + left = numeric(), right = numeric(), stringsAsFactors = FALSE)) + } + bridge_df <- do.call(rbind, bridge_list) + bridge_edges <- data.frame( + chr = as.integer(bridge_df$chr), + child = as.integer(bridge_df$childId), + parent = as.integer(bridge_df$parentId), + left = as.numeric(bridge_df$left), + right = as.numeric(bridge_df$right), + stringsAsFactors = FALSE + ) + bridge_edges <- bridge_edges[bridge_edges$child %in% child_iids, , drop = FALSE] + .normalize_edge_df(bridge_edges) +} + +.ts_forward_metadata_text <- function(x) { + if (is.raw(x)) { + return(rawToChar(x)) + } + paste0(as.character(x), collapse = "") +} + +test_that("tsForward recorder lifecycle init->append->finalize works", { + old_opts <- options(AlphaSimR.tsForwardKeepSeg = FALSE) + on.exit(options(old_opts), add = TRUE) + + chr_info <- .ts_forward_test_chr_info() + chr_info[[1L]]$breaks <- c(0, 1e6 / 3, 2e6 / 3, 1e6) + chr_info[[1L]]$rates <- c(5e-7, 5e-6, 5e-7) + founder <- AlphaSimR:::asMapPop(chr_info = chr_info, inbred = FALSE, ploidy = 2L) + SP <- SimParam$new(founder) + SP$nThreads <- 1L + SP$setTrackRecGen(TRUE) + SP$quadProb <- 0 + pop0 <- newPop(founder, simParam = SP) + + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + expect_error( + AlphaSimR:::tsForwardFinalizeFromSimParam(SP), + regexp = "No tsForwardRecorder attached to simParam" + ) + + expect_silent(AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0)) + expect_true(AlphaSimR:::tsForwardHasRecorder(SP)) + + crossPlan <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, crossPlan, nProgeny = 2, simParam = SP) + expect_true(is.null(pop1@misc$tsSegGen)) + + out <- AlphaSimR:::tsForwardFinalizeFromSimParam( + SP, + out_dir = tempdir(), + out_basename = paste0("ts_forward_lifecycle_", Sys.getpid()), + clear = TRUE + ) + expect_length(out, 1L) + expect_true(file.exists(out[[1]])) + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + expect_error( + AlphaSimR:::tsForwardFinalizeFromSimParam(SP), + regexp = "No tsForwardRecorder attached to simParam" + ) + unlink(out, force = TRUE) +}) + +test_that("metadata-on child nodes use AlphaSimR node metadata", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE, + AlphaSimR.tsForwardAttachMetadata = TRUE + ) + on.exit(options(old_opts), add = TRUE) + + expect_true(exists("tsForwardNodeTableAddRowsWithMetadata", where = asNamespace("AlphaSimR"))) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + + AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0) + pop1 <- makeCross(pop0, matrix(c(1, 2), ncol = 2, byrow = TRUE), nProgeny = 1, simParam = SP) + + rec <- attr(SP, "tsForwardRecorder", exact = TRUE) + child_key <- AlphaSimR:::.tsForwardNodeKey(pop1@iid[[1]], 1L) + child_node <- get(child_key, envir = rec$chr[[1]]$nodeMap, inherits = FALSE) + node_row <- rec$chr[[1]]$tc$node_table_get_row(as.integer(child_node)) + + expect_equal( + .ts_forward_metadata_text(node_row$metadata), + paste0("{\"alphaSimR\":{\"id\":\"", child_key, "\"}}") + ) +}) + +test_that("setTrackTs convenience method initializes and clears recorder", { + old_opts <- options(AlphaSimR.tsForwardKeepSeg = FALSE) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + expect_error( + SP$setTrackTs(TRUE), + regexp = "requires founderPop" + ) + + expect_silent(SP$setTrackTs(TRUE, founderPop = pop0)) + expect_true(SP$isTrackRecGen) + expect_true(AlphaSimR:::tsForwardHasRecorder(SP)) + + pop1 <- makeCross(pop0, matrix(c(1, 2), ncol = 2, byrow = TRUE), nProgeny = 2, simParam = SP) + expect_true(is.null(pop1@misc$tsSegGen)) + + out <- AlphaSimR:::tsForwardFinalizeFromSimParam( + SP, + out_dir = tempdir(), + out_basename = paste0("ts_forward_setTrackTs_", Sys.getpid()), + clear = TRUE + ) + expect_length(out, 1L) + expect_true(file.exists(out[[1]])) + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + + expect_silent(SP$setTrackTs(FALSE)) + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + + unlink(out, force = TRUE) +}) + +test_that("direct recorder path works with nThreads > 1", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + SP$nThreads <- 2L + expect_silent(AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0)) + + crossPlan <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, crossPlan, nProgeny = 2, simParam = SP, nThreads = 2L) + expect_true(is.null(pop1@misc$tsSegGen)) + expect_true(all(vapply(SP$recHistGen[pop1@iid], is.null, logical(1)))) + + recorder <- attr(SP, "tsForwardRecorder", exact = TRUE) + expect_true(inherits(recorder, "tsForwardRecorder")) + forward_edges <- .collect_forward_edges_for_children(recorder, chr = 1L, child_iids = pop1@iid) + forward_edges <- .normalize_edge_df(forward_edges) + expect_gt(nrow(forward_edges), 0L) + + out <- AlphaSimR:::tsForwardFinalizeFromSimParam( + SP, + out_dir = tempdir(), + out_basename = paste0("ts_forward_threads_", Sys.getpid()), + clear = TRUE + ) + expect_length(out, 1L) + expect_true(file.exists(out[[1]])) + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + unlink(out, force = TRUE) +}) + +test_that("forward recorder edges match recHistGen bridge edges for one generation", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + expect_silent(AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0)) + + crossPlan <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, crossPlan, nProgeny = 2, simParam = SP) + + recorder <- attr(SP, "tsForwardRecorder", exact = TRUE) + expect_true(inherits(recorder, "tsForwardRecorder")) + forward_edges <- .collect_forward_edges_for_children(recorder, chr = 1L, child_iids = pop1@iid) + forward_edges <- .normalize_edge_df(forward_edges) + expect_gt(nrow(forward_edges), 0L) + + bridge_edges <- .collect_bridge_edges_for_children( + SP = SP, + sim_output = list(pop0, pop1), + chr_info = chr_info, + child_iids = pop1@iid + ) + + expect_equal(nrow(forward_edges), nrow(bridge_edges)) + expect_equal(forward_edges[, c("chr", "child", "parent")], + bridge_edges[, c("chr", "child", "parent")]) + expect_equal(forward_edges$left, bridge_edges$left, tolerance = 1e-6) + expect_equal(forward_edges$right, bridge_edges$right, tolerance = 1e-6) +}) + +test_that("forward recorder uses chr_info rate map for non-constant coordinate conversion", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE + ) + on.exit(options(old_opts), add = TRUE) + + chr_info <- .ts_forward_test_chr_info() + chr_info[[1L]]$breaks <- c(0, 1e6 / 3, 2e6 / 3, 1e6) + chr_info[[1L]]$rates <- c(5e-7, 5e-6, 5e-7) + founder <- AlphaSimR:::asMapPop(chr_info = chr_info, inbred = FALSE, ploidy = 2L) + posMeta <- attr(founder, "tsForwardPosMeta", exact = TRUE) + expect_equal(posMeta$breaksList[[1L]], chr_info[[1L]]$breaks) + expect_equal(posMeta$ratesList[[1L]], chr_info[[1L]]$rates) + + SP <- SimParam$new(founder) + SP$nThreads <- 1L + SP$setTrackRecGen(TRUE) + SP$quadProb <- 0 + pop0 <- newPop(founder, simParam = SP) + AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0) + + crossPlan <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, crossPlan, nProgeny = 2, simParam = SP) + + recorder <- attr(SP, "tsForwardRecorder", exact = TRUE) + forward_edges <- .collect_forward_edges_for_children(recorder, chr = 1L, child_iids = pop1@iid) + forward_edges <- .normalize_edge_df(forward_edges) + expect_gt(nrow(forward_edges), 0L) + + bridge_edges <- .collect_bridge_edges_for_children( + SP = SP, + sim_output = list(pop0, pop1), + chr_info = chr_info, + child_iids = pop1@iid + ) + + expect_equal(nrow(forward_edges), nrow(bridge_edges)) + expect_equal(forward_edges[, c("chr", "child", "parent")], + bridge_edges[, c("chr", "child", "parent")]) + expect_equal(forward_edges$left, bridge_edges$left, tolerance = 1e-6) + expect_equal(forward_edges$right, bridge_edges$right, tolerance = 1e-6) +}) + +test_that("forward recorder edges match bridge edges across generations with nThreads > 1", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + SP$nThreads <- 2L + expect_silent(AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0)) + + cp <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, cp, nProgeny = 2, simParam = SP, nThreads = 2L) + pop2 <- makeCross(pop1, cp, nProgeny = 2, simParam = SP, nThreads = 2L) + pop3 <- makeCross(pop2, cp, nProgeny = 2, simParam = SP, nThreads = 2L) + + expect_true(is.null(pop1@misc$tsSegGen)) + expect_true(is.null(pop2@misc$tsSegGen)) + expect_true(is.null(pop3@misc$tsSegGen)) + + recorder <- attr(SP, "tsForwardRecorder", exact = TRUE) + expect_true(inherits(recorder, "tsForwardRecorder")) + + child_iids <- c(pop1@iid, pop2@iid, pop3@iid) + forward_edges <- .collect_forward_edges_for_children(recorder, chr = 1L, child_iids = child_iids) + forward_edges <- .normalize_edge_df(forward_edges) + expect_gt(nrow(forward_edges), 0L) + + bridge_edges <- .collect_bridge_edges_for_children( + SP = SP, + sim_output = list(pop0, pop1, pop2, pop3), + chr_info = chr_info, + child_iids = child_iids + ) + + expect_equal(nrow(forward_edges), nrow(bridge_edges)) + expect_equal(forward_edges[, c("chr", "child", "parent")], + bridge_edges[, c("chr", "child", "parent")]) + expect_equal(forward_edges$left, bridge_edges$left, tolerance = 1e-6) + expect_equal(forward_edges$right, bridge_edges$right, tolerance = 1e-6) +}) + +test_that("makeCross2 + self threaded direct recorder matches bridge edges", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + SP$nThreads <- 2L + expect_silent(AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0)) + + cp <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross2(pop0, pop0, cp, nProgeny = 2, simParam = SP, nThreads = 2L) + pop2 <- self(pop1, nProgeny = 1, keepParents = FALSE, simParam = SP, nThreads = 2L) + + expect_true(is.null(pop1@misc$tsSegGen)) + expect_true(is.null(pop2@misc$tsSegGen)) + + recorder <- attr(SP, "tsForwardRecorder", exact = TRUE) + expect_true(inherits(recorder, "tsForwardRecorder")) + + child_iids <- c(pop1@iid, pop2@iid) + forward_edges <- .collect_forward_edges_for_children(recorder, chr = 1L, child_iids = child_iids) + forward_edges <- .normalize_edge_df(forward_edges) + expect_gt(nrow(forward_edges), 0L) + + bridge_edges <- .collect_bridge_edges_for_children( + SP = SP, + sim_output = list(pop0, pop1, pop2), + chr_info = chr_info, + child_iids = child_iids + ) + + expect_equal(nrow(forward_edges), nrow(bridge_edges)) + expect_equal(forward_edges[, c("chr", "child", "parent")], + bridge_edges[, c("chr", "child", "parent")]) + expect_equal(forward_edges$left, bridge_edges$left, tolerance = 1e-6) + expect_equal(forward_edges$right, bridge_edges$right, tolerance = 1e-6) +}) + +test_that("without recorder, makeCross suppresses tsSegGen and recHistGen by default", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + crossPlan <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, crossPlan, nProgeny = 2, simParam = SP) + + expect_true(is.null(pop1@misc$tsSegGen)) + expect_true(length(pop1@iid) > 0L) + expect_true(all(vapply(SP$recHistGen[pop1@iid], is.null, logical(1)))) +}) + +test_that("without recorder, makeCross keeps recHistGen when explicitly requested", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + crossPlan <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, crossPlan, nProgeny = 2, simParam = SP) + + expect_true(is.null(pop1@misc$tsSegGen)) + expect_true(length(pop1@iid) > 0L) + expect_true(all(!vapply(SP$recHistGen[pop1@iid], is.null, logical(1)))) +}) + +test_that("raw tsSegGen append matches data.frame append", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = TRUE, + AlphaSimR.tsForwardKeepRecHistGen = TRUE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + crossPlan <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + nProgeny <- 2L + pop1 <- makeCross(pop0, crossPlan, nProgeny = nProgeny, simParam = SP) + seg_df <- pop1@misc$tsSegGen + expect_false(is.null(seg_df)) + expect_gt(nrow(seg_df), 0L) + + raw_seg <- as.matrix(seg_df[, c("childLocal", "chr", "hap", "parentSide", + "parentIndex", "parentHap", "leftGen", "rightGen")]) + crossPlanExp <- cbind( + rep(crossPlan[, 1], each = nProgeny), + rep(crossPlan[, 2], each = nProgeny) + ) + mother_iid <- pop0@iid[crossPlanExp[, 1]] + father_iid <- pop0@iid[crossPlanExp[, 2]] + + rec_df <- AlphaSimR:::tsForwardInit(founderPop = pop0) + rec_df <- AlphaSimR:::tsForwardAppendSeg(rec_df, seg_df, SP) + edges_df <- .normalize_edge_df(.collect_forward_edges_for_children(rec_df, chr = 1L, child_iids = pop1@iid)) + + rec_raw <- AlphaSimR:::tsForwardInit(founderPop = pop0) + rec_raw <- AlphaSimR:::tsForwardAppendSegGenRaw( + recorder = rec_raw, + tsSegGen = raw_seg, + childIid = pop1@iid, + motherIid = mother_iid, + fatherIid = father_iid, + femaleMap = SP$femaleMap, + maleMap = SP$maleMap, + simParam = SP + ) + edges_raw <- .normalize_edge_df(.collect_forward_edges_for_children(rec_raw, chr = 1L, child_iids = pop1@iid)) + + expect_equal(nrow(edges_raw), nrow(edges_df)) + expect_equal(edges_raw[, c("chr", "child", "parent")], edges_df[, c("chr", "child", "parent")]) + expect_equal(edges_raw$left, edges_df$left, tolerance = 1e-6) + expect_equal(edges_raw$right, edges_df$right, tolerance = 1e-6) +}) + +test_that("with recorder active and keepRecHistGen FALSE, recHistGen is suppressed", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0) + crossPlan <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, crossPlan, nProgeny = 2, simParam = SP) + + expect_true(is.null(pop1@misc$tsSegGen)) + expect_true(all(vapply(SP$recHistGen[pop1@iid], is.null, logical(1)))) +}) + +test_that("writeTreesFromSimParam defaults samples to last generation and updates sample flags", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0) + cp <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, cp, nProgeny = 2, simParam = SP) + pop2 <- makeCross(pop1, cp, nProgeny = 2, simParam = SP) + rec <- attr(SP, "tsForwardRecorder", exact = TRUE) + n_past_nodes <- length(AlphaSimR:::.tsForwardPastIndividualNodes(rec$chr[[1]]$tc)) + + out <- AlphaSimR:::tsForwardWriteTreesFromSimParam( + SP, + out_dir = tempdir(), + out_basename = paste0("ts_forward_samples_default_", Sys.getpid()), + simplify = FALSE, + clear = FALSE + ) + expect_length(out, 1L) + expect_true(file.exists(out[[1]])) + + ts <- RcppTskit::ts_load(out[[1]]) + expect_equal(length(ts$samples()), (pop0@nInd + pop2@nInd) * pop2@ploidy) + unlink(out, force = TRUE) +}) + +test_that("writeTreesFromSimParam accepts manual samples and simplify", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + chr_info <- st$chr_info + + AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0) + cp <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, cp, nProgeny = 2, simParam = SP) + + rec <- attr(SP, "tsForwardRecorder", exact = TRUE) + keys <- paste0(pop1@iid[[1]], "_", seq_len(pop1@ploidy)) + manual_samples <- as.integer(vapply(keys, function(k) { + get(k, envir = rec$chr[[1]]$nodeMap, inherits = FALSE) + }, integer(1))) + + out <- AlphaSimR:::tsForwardWriteTreesFromSimParam( + SP, + out_dir = tempdir(), + out_basename = paste0("ts_forward_samples_manual_", Sys.getpid()), + simplify = TRUE, + samples = manual_samples, + keep_existing_samples = FALSE, + clear = TRUE + ) + expect_length(out, 1L) + expect_true(file.exists(out[[1]])) + expect_false(AlphaSimR:::tsForwardHasRecorder(SP)) + + ts <- RcppTskit::ts_load(out[[1]]) + expect_equal(length(ts$samples()), length(manual_samples)) + unlink(out, force = TRUE) +}) + +test_that("forward simplify update_sample_flags defaults to false", { + expect_identical(formals(AlphaSimR:::tsForwardFinalize)$update_sample_flags, FALSE) + expect_identical(formals(AlphaSimR:::tsForwardFinalizeFromSimParam)$update_sample_flags, FALSE) + expect_identical(formals(AlphaSimR:::tsForwardWriteTreesFromSimParam)$update_sample_flags, FALSE) +}) + +test_that("default simplify samples keep imported past pedigree nodes", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + + AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0) + cp <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, cp, nProgeny = 2, simParam = SP) + pop2 <- makeCross(pop1, cp, nProgeny = 2, simParam = SP) + rec <- attr(SP, "tsForwardRecorder", exact = TRUE) + n_past_nodes <- length(AlphaSimR:::.tsForwardPastIndividualNodes(rec$chr[[1]]$tc)) + expect_gt(n_past_nodes, 0L) + + out <- AlphaSimR:::tsForwardWriteTreesFromSimParam( + SP, + out_dir = tempdir(), + out_basename = paste0("ts_forward_samples_negative_time_", Sys.getpid()), + simplify = TRUE, + keep_unary = TRUE, + clear = TRUE + ) + expect_length(out, 1L) + expect_true(file.exists(out[[1]])) + + ts <- RcppTskit::ts_load(out[[1]]) + tc <- ts$dump_tables() + n_node <- as.integer(tc$num_nodes()) + node_rows <- lapply(seq_len(n_node) - 1L, function(nid) { + tc$node_table_get_row(nid) + }) + node_times <- vapply(node_rows, function(x) as.numeric(x$time), numeric(1)) + node_ind <- vapply(node_rows, function(x) as.integer(x$individual), integer(1)) + + expect_gte(sum(node_times > 0 & node_ind != -1L), n_past_nodes) + expect_gte(sum(abs(node_times + 2) < 1e-8 & node_ind != -1L), pop2@nInd * pop2@ploidy) + unlink(out, force = TRUE) +}) + +test_that("simplify keeps original samples but not extra past nodes when requested", { + old_opts <- options( + AlphaSimR.tsForwardKeepSeg = FALSE, + AlphaSimR.tsForwardKeepRecHistGen = FALSE + ) + on.exit(options(old_opts), add = TRUE) + + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + + AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0) + cp <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, cp, nProgeny = 2, simParam = SP) + pop2 <- makeCross(pop1, cp, nProgeny = 2, simParam = SP) + rec <- attr(SP, "tsForwardRecorder", exact = TRUE) + n_past_nodes <- length(AlphaSimR:::.tsForwardPastIndividualNodes(rec$chr[[1]]$tc)) + + out <- AlphaSimR:::tsForwardWriteTreesFromSimParam( + SP, + out_dir = tempdir(), + out_basename = paste0("ts_forward_samples_replace_", Sys.getpid()), + simplify = TRUE, + keep_unary = TRUE, + keep_existing_samples = FALSE, + clear = TRUE + ) + expect_length(out, 1L) + expect_true(file.exists(out[[1]])) + + ts <- RcppTskit::ts_load(out[[1]]) + tc <- ts$dump_tables() + n_node <- as.integer(tc$num_nodes()) + node_rows <- lapply(seq_len(n_node) - 1L, function(nid) { + tc$node_table_get_row(nid) + }) + node_times <- vapply(node_rows, function(x) as.numeric(x$time), numeric(1)) + node_ind <- vapply(node_rows, function(x) as.integer(x$individual), integer(1)) + node_flags <- vapply(node_rows, function(x) as.integer(x$flags), integer(1)) + is_sample <- bitwAnd(node_flags, 1L) != 0L + + expect_lt(sum(node_times > 0 & node_ind != -1L), n_past_nodes) + expect_gte(sum(abs(node_times + 2) < 1e-8 & node_ind != -1L), pop2@nInd * pop2@ploidy) + expect_gte(sum(is_sample & node_times == 0 & node_ind != -1L), pop0@nInd * pop0@ploidy) + expect_equal(sum(is_sample & node_times > 0 & node_ind != -1L), 0L) + expect_equal(sum(is_sample & node_times < 0 & node_ind != -1L), 0L) + unlink(out, force = TRUE) +}) + +test_that("build tree-sequence objects then write all chromosomes", { + st <- .ts_forward_test_setup() + SP <- st$SP + pop0 <- st$pop0 + + AlphaSimR:::tsForwardInitOnSimParam(SP, founderPop = pop0) + cp <- matrix(c(1, 2), ncol = 2, byrow = TRUE) + pop1 <- makeCross(pop0, cp, nProgeny = 2, simParam = SP) + expect_true(is.null(pop1@misc$tsSegGen)) + + rec <- attr(SP, "tsForwardRecorder", exact = TRUE) + indTime <- AlphaSimR:::.tsForwardUpdateIndTimeCache(rec$indTime, SP$pedigree) + rec$indTime <- indTime + ts_list <- AlphaSimR:::tsForwardFinalize( + recorder = rec, + simplify = TRUE, + keep_unary = TRUE, + indTime = indTime, + update_samples = TRUE + ) + expect_length(ts_list, 1L) + expect_gt(length(ts_list[[1]]$samples()), 0L) + + out <- AlphaSimR:::tsForwardWriteTreeSequences( + ts_list = ts_list, + out_dir = tempdir(), + out_basename = paste0("ts_forward_build_write_", Sys.getpid()), + recorder = rec + ) + expect_length(out, 1L) + expect_true(file.exists(out[[1]])) + unlink(out, force = TRUE) +}) diff --git a/vignettes/articles/testMaCSTS4.Rmd b/vignettes/articles/testMaCSTS4.Rmd new file mode 100644 index 00000000..4e491aff --- /dev/null +++ b/vignettes/articles/testMaCSTS4.Rmd @@ -0,0 +1,367 @@ +--- +title: "test MaCSTS 4: wrapper/staged workflow overview" +output: html_document +date: "2026-06-10" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) +``` + +## General Notes + +This notebook summarizes the current TS workflow design and parameter effects, +based on `testMaCSTS1.Rmd`, `testMaCSTS2.Rmd`, and `testMaCSTS3.Rmd`. + +It starts from the two supported ways to run: + +1. high-level wrapper: `runMacsTS(...)` +2. staged low-level path (for developers and advanced users): `simAnc(...) -> simMut(...) -> finalizeInbredTs(...) -> asMapPop(...)` + +## 1) Two Ways To Run + +### A. High-level wrapper (`runMacsTS`) + +`runMacsTS` is the default user-facing entry point. It is designed to feel like +`runMacs/runMacs2` but with TS-aware internals and mode control. + +- Builds MaCS command from species/manual inputs +- Runs ancestry and mutation according to `mutationMode` +- Converts to `MapPop` (including optional `segSites` sampling) +- Optionally returns TS tables/metadata + +### B. Staged workflow (`simAnc` + `simMut` + ...) + +This path is for development/debugging and explicit control over each stage. + +- `simAnc`: ancestry-only TS from MaCS engine (`useMacsMut=FALSE`) +- `simMut`: post-TS mutation placement on edge table (if `mutationMode="postTs"`) +- `finalizeInbredTs`: optional inbred leaf expansion in TS (if `inbred=TRUE` and `ploidy>1`) +- `asMapPop`: convert TS to `MapPop` (sampling/filtering + map construction) + +## 2) Function Relationship + +```{r relationship-diagram, results='asis'} +cat(" +runMacsTS() + ├─ command builder (species/manual) + ├─ mutationMode = 'macs' -> MaCSTS(..., useMacsMut=TRUE, expandInbredSamples=FALSE) + ├─ mutationMode = 'postTs'-> simAnc(...) -> simMut(...) + ├─ mutationMode = 'none' -> simAnc(...) only (TS-only unless user mutates later) + ├─ optional finalizeInbredTs(...) + └─ asMapPop(...) -> MapPop + +Lower layers: + simAnc() -> MaCSTS(... useMacsMut=FALSE ...) + simMut() -> tsMutateTableCollection(...) per chromosome + finalizeInbredTs() -> tsFinalizeInbredTableCollection(...) per chromosome + MaCSTS() -> C++ simulator + TS recorder +") +``` + +## 3) Core Parameters And Their Effects + +```{r param-table} +param_effects <- data.frame( + parameter = c( + "mutationMode", + "useMacsMut (MaCSTS)", + "usePhysicalPositions", + "Nref", + "segSites", + "inbred + ploidy", + "expandInbredTs", + "seed", + "mutSeed", + "nThreads" + ), + where_used = c( + "runMacsTS", + "MaCSTS", + "MaCSTS/asMapPop", + "MaCSTS (timeScale)", + "asMapPop", + "MaCSTS/asMapPop/finalizeInbredTs", + "runMacsTS/finalizeInbredTs", + "simAnc/MaCSTS ancestry RNG", + "simMut post-TS RNG", + "MaCS chromosomes + asMapPop worker" + ), + main_effect = c( + "Selects mutation path: macs vs postTs vs none", + "Adds MaCS-style mutation during ancestry if TRUE", + "TS coordinates in bp (TRUE) or [0,1] (FALSE)", + "Rescales node/mutation times; sets time_units to generations", + "Caps number of retained variants per chromosome in conversion", + "Controls sample interpretation and output haplotype structure", + "If TRUE with inbred/ploidy>1, duplicates TS sample leaves", + "Determines ancestry reproducibility", + "Determines post-TS mutation reproducibility", + "Parallelism level when available" + ), + stringsAsFactors = FALSE +) +knitr::kable(param_effects) +``` + +## Helpers to Compare Two Ways To Run + +```{r comparison-helpers} +tc_counts <- function(tc_xptr) { + tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) + data.frame( + num_nodes = as.integer(tc$num_nodes()), + num_edges = as.integer(tc$num_edges()), + num_sites = as.integer(tc$num_sites()), + num_mutations = as.integer(tc$num_mutations()) + ) +} + +collect_ts_counts <- function(tables, method) { + do.call(rbind, lapply(seq_along(tables), function(chr) { + cbind(chr = chr, method = method, tc_counts(tables[[chr]])) + })) +} + +compare_wrapper_vs_staged <- function(out, staged) { + if (!requireNamespace("RcppTskit", quietly = TRUE)) { + stop("RcppTskit is required for TS checks.") + } + if (is.null(out$pop) || is.null(out$tables)) { + stop("out must contain both $pop and $tables") + } + if (is.null(staged$pop) || is.null(staged$tables)) { + stop("staged must contain both $pop and $tables") + } + + ts_counts_wrap <- collect_ts_counts(out$tables, method = "wrapper") + ts_counts_stage <- collect_ts_counts(staged$tables, method = "staged") + ts_counts <- rbind(ts_counts_wrap, ts_counts_stage) + + nChr <- length(out$pop@geno) + same_geno <- vapply(seq_len(nChr), function(chr) { + identical(out$pop@geno[[chr]], staged$pop@geno[[chr]]) + }, logical(1)) + same_genMap <- vapply(seq_len(nChr), function(chr) { + isTRUE(all.equal(out$pop@genMap[[chr]], staged$pop@genMap[[chr]], tolerance = 0)) + }, logical(1)) + same_ts_counts <- identical( + ts_counts_wrap[, c("num_nodes", "num_edges", "num_sites", "num_mutations")], + ts_counts_stage[, c("num_nodes", "num_edges", "num_sites", "num_mutations")] + ) + + checks <- data.frame( + metric = c("nLoci", "geno_all_chr", "genMap_all_chr", "ts_table_counts"), + equal = c( + identical(out$pop@nLoci, staged$pop@nLoci), + all(same_geno), + all(same_genMap), + same_ts_counts + ), + stringsAsFactors = FALSE + ) + + list(ts_counts = ts_counts, checks = checks) +} + +print_wrapper_vs_staged <- function(cmp) { + print(cmp$ts_counts) + print(cmp$checks) + invisible(cmp) +} +``` + +## Minimal Usage Examples + +### A. High-level wrapper mode + +```{r ex-runMacsTS} +library(AlphaSimR) +devtools::load_all() +set.seed(1) +out <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = 60, + inbred = FALSE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", # or "macs" / "none" + usePhysicalPositions = FALSE, + nThreads = 1L, + returnTs = TRUE +) + +# runMacsTS returns: +# out$pop -> MapPop +# out$tables -> TS table collections (if returnTs=TRUE) +``` + +### B. Staged mode + +```{r ex-staged} +library(AlphaSimR) + +# use the same args and seeds as high-level wrapper mode +args <- out$args +nChr <- 2L +seed_chr <- out$seed + +anc <- AlphaSimR:::simAnc( + args = args, + nChr = nChr, + inbred = FALSE, + ploidy = 2L, + nThreads = 1L, + seed = seed_chr, + usePhysicalPositions = FALSE, + Nref = NA_real_ +) + +mut <- AlphaSimR:::simMut(anc) # uses anc$dTheta and derived mutation seeds by default + +# Optional for inbred/ploidy expansion in TS: +# mut <- AlphaSimR:::finalizeInbredTs(mut, inbred = TRUE, ploidy = 2L) + +pop <- AlphaSimR:::asMapPop( + chr_info = list( + tables = mut$tables, + breaks = list(c(0, 1)), + rates = list(c(1)) + ), + ploidy = 2L, + inbred = FALSE, + segSites = 60 +) +``` + +## Validation + +### Wrapper vs staged equivalence + +```{r wrapper-vs-staged-equivalence} +# Reuse objects from the previous ection: +# - out : runMacsTS(...) result +# - mut : simMut(...) result from staged path +# - pop : asMapPop(...) result from staged path + +stopifnot(exists("out"), exists("mut"), exists("pop")) +cmp <- compare_wrapper_vs_staged( + out = out, + staged = list( + tables = mut$tables, + pop = pop + ) +) +print_wrapper_vs_staged(cmp) +``` + +### Wrapper vs staged (inbred=TRUE, ploidy>1) + +```{r wrapper-vs-staged-inbred} +# Example: inbred TRUE with ploidy 2 +set.seed(1) +out_inbred <- AlphaSimR:::runMacsTS( + nInd = 4, + nChr = 2, + segSites = 60, + inbred = TRUE, + ploidy = 2L, + species = "GENERIC", + mutationMode = "postTs", + usePhysicalPositions = TRUE, + expandInbredTs = TRUE, + nThreads = 1L, + returnTs = TRUE, + Nref = 10000 +) + +anc_inbred <- AlphaSimR:::simAnc( + args = out_inbred$args, + nChr = 2L, + inbred = TRUE, + ploidy = 2L, + nThreads = 1L, + seed = out_inbred$seed, + usePhysicalPositions = TRUE, + #Nref = NA_real_, + Nref = 10000 +) +mut_inbred <- AlphaSimR:::simMut(anc_inbred) +fin_inbred <- AlphaSimR:::finalizeInbredTs(mut_inbred, inbred = TRUE, ploidy = 2L) + +pop_inbred <- AlphaSimR:::asMapPop( + chr_info = list( + tables = fin_inbred$tables, + breaks = rep(list(c(0, 1)), 2L), + rates = rep(list(c(1)), 2L) + ), + ploidy = 2L, + inbred = TRUE, + segSites = 60, + site_sampling_seed = 42L, + nThreads = 1L +) + +cmp_inbred <- compare_wrapper_vs_staged( + out = out_inbred, + staged = list( + tables = fin_inbred$tables, + pop = pop_inbred + ) +) +print_wrapper_vs_staged(cmp_inbred) +``` + +Output a ts as an example and check it in Python: +```{r export-inbred-ts} +tables_src <- if (exists("fin_inbred")) { + fin_inbred$tables +} else if (exists("out_inbred")) { + out_inbred$tables +} else { + stop("Need fin_inbred or out_inbred in environment. Run chunk 5.1b first.") +} +# chr1 +tc_xptr <- tables_src[[1]] +tc <- RcppTskit::TableCollection$new(xptr = tc_xptr) +ts <- tc$tree_sequence() +ts$write('testData/inbred_test.trees') +``` + +```{r py-setup} +library(reticulate) +# Use your own path here! +use_python('/usr/bin/python3', required = TRUE) +``` + + +```{python} +import numpy as np +import tskit +ts_inbred = tskit.load('testData/inbred_test.trees') +ts_inbred.samples() + +print(ts_inbred.first().draw_text()) +from IPython.display import display +svg_size = (800, 250) +svg_string = ts_inbred.first().draw_svg( + size=svg_size, time_scale="rank", omit_sites=True, + y_axis=True, y_label=" " # optional: show a time scale on the left +) +with open("tmp_tree.svg", "w") as f: + f.write(svg_string) +print(ts_inbred.tables.nodes[2612:2620]) +print(ts_inbred.tables.nodes[0:4]) + +g_matrix = ts_inbred.genotype_matrix() +for hap in range(0, len(g_matrix[0]), 2): + print(hap, hap+1) + print(np.array_equal(g_matrix[:, hap], g_matrix[:, hap+1])) + +``` +Sampled nodes are duplicated as expected for inbred/ploidy expansion, from nodes 0-3. Each pair of hap (from the same individual) have same alleles. + + +### Parameter sensitivity checks +In tests/testthat/test-runMacsTS-sensitivity.R