# ========================================================================= # Shared Mock HPA File Factory Generator # ========================================================================= write_mock_hpa <- function(missing_marker = FALSE) { # Reconstruct structural HPA layout variant generated by HaploCharmer hpa_headers <- c( "#HAPLOTYPE\tCHROM\tSTART\tEND\tSEQUENCE\tFORMAT\tInd1\tInd2", # Phase Set Block 1 (Chr1) - Haplotype 1 paste0("Chr1_1000_1004_hap1\tChr1\t1000\t1004\tATCG\tGT:DP:AD\t", if(missing_marker) ".:.:." else "1:20:15", "\t0:30:0"), # Phase Set Block 1 (Chr1) - Haplotype 2 paste0("Chr1_1000_1004_hap2\tChr1\t1000\t1004\tGGGG\tGT:DP:AD\t", if(missing_marker) ".:.:." else "1:20:5", "\t1:30:30"), # Phase Set Block 2 (Chr1) - Haplotype 1 "Chr1_2000_2004_hap1\tChr1\t2000\t2004\tATAT\tGT:DP:AD\t1:20:15\t0:30:0", # Phase Set Block 2 (Chr1) - Haplotype 2 "Chr1_2000_2004_hap2\tChr1\t2000\t2004\tGTGT\tGT:DP:AD\t1:20:5\t1:30:30", # Phase Set Block 3 (Chr2) "Chr2_1000_1004_hap1\tChr2\t1000\t1004\tCCCC\tGT:DP:AD\t1:30:25\t0:10:0", # Phase Set Block 3 (Chr2) "Chr2_1000_1004_hap2\tChr2\t1000\t1004\tCTCC\tGT:DP:AD\t1:30:5\t0:10:0", # Phase Set Block 3 (Chr2) "Chr2_1000_1004_hap3\tChr2\t1000\t1004\tCCTC\tGT:DP:AD\t0:30:0\t1:10:10", # Phase Set Block 4 (Chr2) "Chr2_5000_5004_hap1\tChr2\t5000\t5004\tCCAA\tGT:DP:AD\t1:15:15\t1:40:40" ) tmp_file <- tempfile(fileext = ".hpa") writeLines(hpa_headers, tmp_file) return(tmp_file) } # ========================================================================= # 1. Structural Sanity & Layout Transformations # ========================================================================= test_that("ReadHPA cleanly parses haplotype formats and resolves phase structures", { hpa_path <- write_mock_hpa(missing_marker = FALSE) on.exit(unlink(hpa_path)) res <- ReadHPA(File = hpa_path, MaxMarkerMissing = 1.0, MaxIndMissing = 1.0, Verbose = FALSE, NbThreads = 1) # Assert matching component structures expect_type(res, "list") expect_named(res, c("Geno", "MarkerInfo", "GeneticMap")) # Verify formatting strings transformations inside separate blocks expect_true("PS" %in% colnames(res$MarkerInfo)) expect_equal(res$MarkerInfo$PS[1], "Chr1_1000_1004") }) # ========================================================================= # 2. Dynamic Missing Variant Aggregation # ========================================================================= test_that("ReadHPA filters missing haplotype elements without breaking internal matrices arrays", { hpa_path <- write_mock_hpa(missing_marker = TRUE) on.exit(unlink(hpa_path)) res <- ReadHPA(File = hpa_path, MaxMarkerMissing = 0.10, MaxIndMissing = 1.0, Verbose = FALSE, NbThreads = 1) # Validate that metadata trackers drop filtered records concurrently expect_equal(length(res$Geno), 2) expect_false("Chr1_1000_1004" %in% res$MarkerInfo$PS) expect_false("Chr2_5000_5004" %in% res$MarkerInfo$PS) }) # ========================================================================= # 3. Singleton Grouping Distance Invariance (The NaN Trap Verification) # ========================================================================= test_that("Genetic Map translation runs seamlessly over single-block chromosomes", { hpa_path <- write_mock_hpa(missing_marker = FALSE) on.exit(unlink(hpa_path)) res <- ReadHPA(File = hpa_path, MaxMarkerMissing = 1.0, MaxIndMissing = 1.0, Verbose = FALSE, NbThreads = 1) # Isolate standalone Chromosome 2 distance values chr2_record <- res$GeneticMap[res$GeneticMap$Chromosome == "Chr2", ] # Distance calculations must resolve to 0 instead of returning NaN values expect_equal(nrow(chr2_record), 1) expect_false(is.nan(chr2_record$Distance)) expect_equal(chr2_record$Distance, 0) }) # ========================================================================= # 4. Error Checking Assertions & Console Suppression # ========================================================================= test_that("ReadHPA enforces target field checks and keeps execution quiet", { # Test invalid file paths intercept handles cleanly expect_error(ReadHPA(File = "empty_void.hpa", Verbose = FALSE), regexp = "No file was found") hpa_path <- write_mock_hpa(missing_marker = FALSE) on.exit(unlink(hpa_path)) # Test invalid FORMAT variable validation expect_error( ReadHPA(File = hpa_path, TotalDepthField = "TD", Verbose = FALSE), regexp = "was not found in FORMAT field" ) # Verify zero leaking output streams when verbose option flag matches FALSE expect_silent(ReadHPA(File = hpa_path, Verbose = FALSE)) })