context("calculateMixture") ################################################################################ # CHANGE LOG # 22.03.2019: Changed deprecated 'matches' to 'expect_match'. # 31.07.2014: First version. # # library(testthat) # test_dir("inst/tests/") # test_file("tests/testthat/test-calculateMixture.r") # test_dir("tests/testthat") test_that("calculateMixture", { # Create reference profiles and mixtures. # Created using: dump("major", file="") major <- structure( list( Sample.Name = c( "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major", "major" ), Marker = c( "AMEL", "D3S1358", "D3S1358", "TH01", "D21S11", "D21S11", "D18S51", "D18S51", "D10S1248", "D10S1248", "D1S1656", "D1S1656", "D2S1338", "D16S539", "D16S539", "D22S1045", "vWA", "D8S1179", "D8S1179", "FGA", "D2S441", "D2S441", "D12S391", "D12S391", "D19S433", "SE33", "SE33" ), Allele = c( "X", "14", "15", "8", "25.2", "28", "12", "15", "14", "15", "16", "16.1", "20", "11", "12", "11", "17", "11", "13", "21", "11.3", "14", "21", "23", "13", "18", "20" ) ), .Names = c("Sample.Name", "Marker", "Allele"), row.names = c(NA, 27L), class = "data.frame" ) minor <- structure( list( Sample.Name = c( "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor", "minor" ), Marker = c( "AMEL", "AMEL", "D3S1358", "D3S1358", "TH01", "TH01", "D21S11", "D21S11", "D18S51", "D18S51", "D10S1248", "D1S1656", "D1S1656", "D2S1338", "D2S1338", "D16S539", "D16S539", "D22S1045", "D22S1045", "vWA", "D8S1179", "D8S1179", "FGA", "D2S441", "D12S391", "D12S391", "D19S433", "SE33", "SE33" ), Allele = c( "X", "Y", "16", "18", "8", "9.3", "25.2", "28", "15", "17", "15", "13", "16", "19", "20", "9", "10", "16", "17", "19", "8", "10", "25", "14", "19", "22", "13", "17", "28.2" ) ), .Names = c("Sample.Name", "Marker", "Allele"), class = "data.frame", row.names = c(NA, 29L) ) mixture <- structure( list( Sample.Name = c( "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_1", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2", "major_minor_2" ), Marker = c( "AMEL", "AMEL", "D3S1358", "D3S1358", "D3S1358", "D3S1358", "TH01", "TH01", "D21S11", "D21S11", "D18S51", "D18S51", "D18S51", "D10S1248", "D10S1248", "D1S1656", "D1S1656", "D1S1656", "D2S1338", "D2S1338", "D16S539", "D16S539", "D16S539", "D16S539", "D22S1045", "D22S1045", "D22S1045", "vWA", "vWA", "D8S1179", "D8S1179", "D8S1179", "D8S1179", "FGA", "FGA", "D2S441", "D2S441", "D12S391", "D12S391", "D12S391", "D12S391", "D19S433", "SE33", "SE33", "SE33", "SE33", "AMEL", "AMEL", "D3S1358", "D3S1358", "D3S1358", "D3S1358", "TH01", "D21S11", "D21S11", "D21S11", "D18S51", "D18S51", "D10S1248", "D10S1248", "D1S1656", "D1S1656", "D1S1656", "D1S1656", "D2S1338", "D2S1338", "D16S539", "D16S539", "D16S539", "D16S539", "D22S1045", "D22S1045", "D22S1045", "vWA", "vWA", "D8S1179", "D8S1179", "D8S1179", "FGA", "FGA", "D2S441", "D2S441", "D12S391", "D12S391", "D12S391", "D12S391", "D19S433", "D19S433", "SE33", "SE33", "SE33" ), Allele = c( "X", "Y", "14", "15", "16", "18", "8", "9.3", "25.2", "28", "12", "15", "17", "14", "15", "13", "16", "16.1", "19", "20", "9", "10", "11", "12", "11", "16", "17", "17", "19", "8", "10", "11", "13", "21", "25", "11.3", "14", "19", "21", "22", "23", "13", "17", "18", "20", "28.2", "OL", "X", "14", "15", "16", "18", "8", "25.2", "28", "29", "12", "15", "14", "15", "13", "16", "16.1", "OL", "19", "20", "9", "10", "11", "12", "11", "16", "17", "17", "19", "10", "11", "13", "21", "22", "11.3", "14", "19", "21", "22", "23", "13", "14", "17", "18", "20" ), Height = c( "7533", "1503", "4500", "4200", "1000", "1100", "9300", "1200", "4100", "3800", "1700", "3300", "1500", "3000", "7000", "1300", "5600", "3800", "1200", "8500", "1600", "1600", "3500", "3400", "8600", "1200", "900", "8200", "1900", "1200", "1400", "5000", "4600", "7800", "2100", "6000", "8000", "900", "3400", "1200", "3800", "12000", "1000", "4000", "4100", "1100", "215", "7533", "4500", "4200", "1000", "1100", "9300", "4100", "3800", "340", "1700", "3300", "3000", "7000", "1300", "5600", "3800", "1662", "1200", "8500", "1600", "1600", "3500", "3400", "8600", "1200", "900", "8200", "1900", "1400", "5000", "4600", "7800", "250", "6000", "8000", "900", "3400", "1200", "3800", "12000", "100", "1000", "4000", "4100" ), Style = c( "AA:AB", "AA:AB", "AB:CD", "AB:CD", "AB:CD", "AB:CD", "AA:AB", "AA:AB", "AB:AB", "AB:AB", "AB:AC", "AB:AC", "AB:AC", "AB:AA", "AB:AA", "AB:AC", "AB:AC", "AB:AC", "AB:AA", "AB:AA", "AB:CD", "AB:CD", "AB:CD", "AB:CD", "AA:BC", "AA:BC", "AA:BC", "AA:BB", "AA:BB", "AB:CD", "AB:CD", "AB:CD", "AB:CD", "AA:BB", "AA:BB", "AA:AB", "AA:AB", "AB:CD", "AB:CD", "AB:CD", "AB:CD", "AA:AA", "AB:CD", "AB:CD", "AB:CD", "AB:CD", "OL", "AA:A!B", "AB:CD", "AB:CD", "AB:CD", "AB:CD", "AA:A!B", "AB:AB", "AB:AB", "Dropin", "AB:A!C", "AB:A!C", "AB:AA", "AB:AA", "AB:AC", "AB:AC", "AB:AC", "OL", "AB:AA", "AB:AA", "AB:CD", "AB:CD", "AB:CD", "AB:CD", "AA:BC", "AA:BC", "AA:BC", "AA:BB", "AA:BB", "AB:C!D", "AB:C!D", "AB:C!D", "AA:!B!B", "Dropin", "AA:AB", "AA:AB", "AB:CD", "AB:CD", "AB:CD", "AB:CD", "AA:AA", "Dropin", "AB:C!D", "AB:C!D", "AB:C!D" ), Major.minor = c( "MAJOR/MAJOR/minor", "minor", "MAJOR", "MAJOR", "minor", "minor", "MAJOR/MAJOR/minor", "minor", "MAJOR/minor", "MAJOR/minor", "MAJOR", "MAJOR/minor", "minor", "MAJOR", "MAJOR/minor/minor", "minor", "MAJOR/minor", "MAJOR", "minor", "MAJOR/MAJOR/minor", "minor", "minor", "MAJOR", "MAJOR", "MAJOR/MAJOR", "minor", "minor", "MAJOR/MAJOR", "minor/minor", "minor", "minor", "MAJOR", "MAJOR", "MAJOR/MAJOR", "minor/minor", "MAJOR", "MAJOR/minor/minor", "minor", "MAJOR", "minor", "MAJOR", "MAJOR/MAJOR/minor/minor", "minor", "MAJOR", "MAJOR", "minor", NA, "MAJOR/MAJOR/minor", "MAJOR", "MAJOR", "minor", "minor", "MAJOR/MAJOR/minor", "MAJOR/minor", "MAJOR/minor", NA, "MAJOR", "MAJOR/minor", "MAJOR", "MAJOR/minor/minor", "minor", "MAJOR/minor", "MAJOR", NA, "minor", "MAJOR/MAJOR/minor", "minor", "minor", "MAJOR", "MAJOR", "MAJOR/MAJOR", "minor", "minor", "MAJOR/MAJOR", "minor/minor", "minor", "MAJOR", "MAJOR", "MAJOR/MAJOR", NA, "MAJOR", "MAJOR/minor/minor", "minor", "MAJOR", "minor", "MAJOR", "MAJOR/MAJOR/minor/minor", NA, "minor", "MAJOR", "MAJOR" ) ), .Names = c( "Sample.Name", "Marker", "Allele", "Height", "Style", "Major.minor" ), class = "data.frame", row.names = c(NA, 91L) ) # TEST 01 ------------------------------------------------------------------- # Remove off-ladder alleles, ignore drop-outs. # Analyse dataframe. res <- calculateMixture( data = mixture, ref1 = major, ref2 = minor, ol.rm = TRUE, ignore.dropout = TRUE ) # Check return class. expect_match(class(res), class(data.frame())) # Check that expected columns exist. expect_false(is.null(res$Sample.Name)) expect_false(is.null(res$Marker)) expect_false(is.null(res$Style)) expect_false(is.null(res$Mx)) expect_false(is.null(res$Average)) expect_false(is.null(res$Difference)) expect_false(is.null(res$Observed)) expect_false(is.null(res$Expected)) expect_false(is.null(res$Profile)) expect_false(is.null(res$Dropin)) # Check for NA's. expect_false(any(is.na(res$Sample.Name))) expect_false(any(is.na(res$Marker))) expect_false(any(is.na(res$Style))) expect_true(any(is.na(res$Mx))) expect_false(any(is.na(res$Average))) expect_true(any(is.na(res$Difference))) expect_false(any(is.na(res$Observed))) expect_false(any(is.na(res$Expected))) expect_false(any(is.na(res$Profile))) expect_false(any(is.na(res$Dropin))) # Check result: sample name. expect_that( unique(res$Sample.Name), equals(c("major_minor_1", "major_minor_2")) ) # Check result: average Mx. expect_that( round(unique(res$Average), 4), equals(c(0.2552, 0.1603)) ) # Check result: profile. expect_that( round(unique(res$Profile), 2), equals(c(100.00, 68.42)) ) # Check result: Mx. expect_that(res$Mx[1], equals((2 * 1503) / (1503 + 7533))) expect_that(res$Mx[2], equals((1000 + 1100) / (1000 + 1100 + 4500 + 4200))) expect_that(res$Mx[3], equals((2 * 1200) / (1200 + 9300))) expect_that(res$Mx[4], equals(as.numeric(NA))) expect_that(res$Mx[5], equals((1500) / (1500 + 1700))) expect_that(res$Mx[6], equals((7000 - 3000) / (7000 + 3000))) expect_that(res$Mx[7], equals(1300 / (1300 + 3800))) expect_that(res$Mx[8], equals((2 * 1200) / (1200 + 8500))) expect_that(res$Mx[9], equals((1600 + 1600) / (1600 + 1600 + 3500 + 3400))) expect_that(res$Mx[10], equals((1200 + 900) / (1200 + 900 + 8600))) expect_that(res$Mx[11], equals(1900 / (1900 + 8200))) expect_that(res$Mx[12], equals((1200 + 1400) / (1200 + 1400 + 5000 + 4600))) expect_that(res$Mx[13], equals(2100 / (2100 + 7800))) expect_that(res$Mx[14], equals((8000 - 6000) / (8000 + 6000))) expect_that(res$Mx[15], equals((900 + 1200) / (900 + 1200 + 3400 + 3800))) expect_that(res$Mx[16], equals(as.numeric(NA))) expect_that(res$Mx[17], equals((1000 + 1100) / (1000 + 1100 + 4000 + 4100))) expect_that(res$Mx[18], equals(0 / 7533)) expect_that(res$Mx[19], equals((1000 + 1100) / (1000 + 1100 + 4500 + 4200))) expect_that(res$Mx[20], equals(0 / 9300)) expect_that(res$Mx[21], equals(as.numeric(NA))) expect_that(res$Mx[22], equals(0 / 1700)) expect_that(res$Mx[23], equals((7000 - 3000) / (7000 + 3000))) expect_that(res$Mx[24], equals(1300 / (1300 + 3800))) expect_that(res$Mx[25], equals((2 * 1200) / (1200 + 8500))) expect_that(res$Mx[26], equals((1600 + 1600) / (1600 + 1600 + 3500 + 3400))) expect_that(res$Mx[27], equals((1200 + 900) / (1200 + 900 + 8600))) expect_that(res$Mx[28], equals(1900 / (1900 + 8200))) expect_that(res$Mx[29], equals(1400 / (1400 + 5000 + 4600))) expect_that(res$Mx[30], equals(0 / 7800)) expect_that(res$Mx[31], equals((8000 - 6000) / (8000 + 6000))) expect_that(res$Mx[32], equals((900 + 1200) / (900 + 1200 + 3400 + 3800))) expect_that(res$Mx[33], equals(as.numeric(NA))) expect_that(res$Mx[34], equals(1000 / (1000 + 4000 + 4100))) # Check result: Style. expect_that(res$Style[1], equals("AB:AA")) expect_that(res$Style[2], equals("AB:CD")) expect_that(res$Style[3], equals("AB:AA")) expect_that(res$Style[4], equals("AB:AB")) expect_that(res$Style[5], equals("AB:AC")) expect_that(res$Style[6], equals("AA:AB")) expect_that(res$Style[7], equals("AB:AC")) expect_that(res$Style[8], equals("AB:AA")) expect_that(res$Style[9], equals("AB:CD")) expect_that(res$Style[10], equals("AB:CC")) expect_that(res$Style[11], equals("AA:BB")) expect_that(res$Style[12], equals("AB:CD")) expect_that(res$Style[13], equals("AA:BB")) expect_that(res$Style[14], equals("AA:AB")) expect_that(res$Style[15], equals("AB:CD")) expect_that(res$Style[16], equals("AA:AA")) expect_that(res$Style[17], equals("AB:CD")) expect_that(res$Style[18], equals("AB:AA")) expect_that(res$Style[19], equals("AB:CD")) expect_that(res$Style[20], equals("AB:AA")) expect_that(res$Style[21], equals("AB:AB")) expect_that(res$Style[22], equals("AB:AC")) expect_that(res$Style[23], equals("AA:AB")) expect_that(res$Style[24], equals("AB:AC")) expect_that(res$Style[25], equals("AB:AA")) expect_that(res$Style[26], equals("AB:CD")) expect_that(res$Style[27], equals("AB:CC")) expect_that(res$Style[28], equals("AA:BB")) expect_that(res$Style[29], equals("AB:CD")) expect_that(res$Style[30], equals("AA:BB")) expect_that(res$Style[31], equals("AA:AB")) expect_that(res$Style[32], equals("AB:CD")) expect_that(res$Style[33], equals("AA:AA")) expect_that(res$Style[34], equals("AB:CD")) # Check result: Observed. expect_that( res$Observed[res$Sample.Name == "major_minor_1"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) expect_that( res$Observed[res$Sample.Name == "major_minor_2"], equals(c(0, 2, 0, 0, 0, 0, 1, 1, 2, 2, 1, 1, 0, 0, 2, 0, 1)) ) # Check result: Expected. expect_that( res$Expected[res$Sample.Name == "major_minor_1"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) expect_that( res$Expected[res$Sample.Name == "major_minor_2"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) # Check result: Dropin. expect_that( res$Dropin[res$Sample.Name == "major_minor_1"], equals(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) ) expect_that( res$Dropin[res$Sample.Name == "major_minor_2"], equals(c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0)) ) # TEST 02 ------------------------------------------------------------------- # Count OL as dropin, ignore drop-outs. # Analyse dataframe. res <- calculateMixture( data = mixture, ref1 = major, ref2 = minor, ol.rm = FALSE, ignore.dropout = TRUE ) # Check return class. expect_match(class(res), class(data.frame())) # Check that expected columns exist. expect_false(is.null(res$Sample.Name)) expect_false(is.null(res$Marker)) expect_false(is.null(res$Style)) expect_false(is.null(res$Mx)) expect_false(is.null(res$Average)) expect_false(is.null(res$Difference)) expect_false(is.null(res$Observed)) expect_false(is.null(res$Expected)) expect_false(is.null(res$Profile)) expect_false(is.null(res$Dropin)) # Check for NA's. expect_false(any(is.na(res$Sample.Name))) expect_false(any(is.na(res$Marker))) expect_false(any(is.na(res$Style))) expect_true(any(is.na(res$Mx))) expect_false(any(is.na(res$Average))) expect_true(any(is.na(res$Difference))) expect_false(any(is.na(res$Observed))) expect_false(any(is.na(res$Expected))) expect_false(any(is.na(res$Profile))) expect_false(any(is.na(res$Dropin))) # Check result: sample name. expect_that( unique(res$Sample.Name), equals(c("major_minor_1", "major_minor_2")) ) # Check result: average Mx. expect_that( round(unique(res$Average), 4), equals(c(0.2552, 0.1603)) ) # Check result: profile. expect_that( round(unique(res$Profile), 2), equals(c(100.00, 68.42)) ) # Check result: Mx. expect_that(res$Mx[1], equals((2 * 1503) / (1503 + 7533))) expect_that(res$Mx[2], equals((1000 + 1100) / (1000 + 1100 + 4500 + 4200))) expect_that(res$Mx[3], equals((2 * 1200) / (1200 + 9300))) expect_that(res$Mx[4], equals(as.numeric(NA))) expect_that(res$Mx[5], equals((1500) / (1500 + 1700))) expect_that(res$Mx[6], equals((7000 - 3000) / (7000 + 3000))) expect_that(res$Mx[7], equals(1300 / (1300 + 3800))) expect_that(res$Mx[8], equals((2 * 1200) / (1200 + 8500))) expect_that(res$Mx[9], equals((1600 + 1600) / (1600 + 1600 + 3500 + 3400))) expect_that(res$Mx[10], equals((1200 + 900) / (1200 + 900 + 8600))) expect_that(res$Mx[11], equals(1900 / (1900 + 8200))) expect_that(res$Mx[12], equals((1200 + 1400) / (1200 + 1400 + 5000 + 4600))) expect_that(res$Mx[13], equals(2100 / (2100 + 7800))) expect_that(res$Mx[14], equals((8000 - 6000) / (8000 + 6000))) expect_that(res$Mx[15], equals((900 + 1200) / (900 + 1200 + 3400 + 3800))) expect_that(res$Mx[16], equals(as.numeric(NA))) expect_that(res$Mx[17], equals((1000 + 1100) / (1000 + 1100 + 4000 + 4100))) expect_that(res$Mx[18], equals(0 / 7533)) expect_that(res$Mx[19], equals((1000 + 1100) / (1000 + 1100 + 4500 + 4200))) expect_that(res$Mx[20], equals(0 / 9300)) expect_that(res$Mx[21], equals(as.numeric(NA))) expect_that(res$Mx[22], equals(0 / 1700)) expect_that(res$Mx[23], equals((7000 - 3000) / (7000 + 3000))) expect_that(res$Mx[24], equals(1300 / (1300 + 3800))) expect_that(res$Mx[25], equals((2 * 1200) / (1200 + 8500))) expect_that(res$Mx[26], equals((1600 + 1600) / (1600 + 1600 + 3500 + 3400))) expect_that(res$Mx[27], equals((1200 + 900) / (1200 + 900 + 8600))) expect_that(res$Mx[28], equals(1900 / (1900 + 8200))) expect_that(res$Mx[29], equals(1400 / (1400 + 5000 + 4600))) expect_that(res$Mx[30], equals(0 / 7800)) expect_that(res$Mx[31], equals((8000 - 6000) / (8000 + 6000))) expect_that(res$Mx[32], equals((900 + 1200) / (900 + 1200 + 3400 + 3800))) expect_that(res$Mx[33], equals(as.numeric(NA))) expect_that(res$Mx[34], equals(1000 / (1000 + 4000 + 4100))) # Check result: Style. expect_that(res$Style[1], equals("AB:AA")) expect_that(res$Style[2], equals("AB:CD")) expect_that(res$Style[3], equals("AB:AA")) expect_that(res$Style[4], equals("AB:AB")) expect_that(res$Style[5], equals("AB:AC")) expect_that(res$Style[6], equals("AA:AB")) expect_that(res$Style[7], equals("AB:AC")) expect_that(res$Style[8], equals("AB:AA")) expect_that(res$Style[9], equals("AB:CD")) expect_that(res$Style[10], equals("AB:CC")) expect_that(res$Style[11], equals("AA:BB")) expect_that(res$Style[12], equals("AB:CD")) expect_that(res$Style[13], equals("AA:BB")) expect_that(res$Style[14], equals("AA:AB")) expect_that(res$Style[15], equals("AB:CD")) expect_that(res$Style[16], equals("AA:AA")) expect_that(res$Style[17], equals("AB:CD")) expect_that(res$Style[18], equals("AB:AA")) expect_that(res$Style[19], equals("AB:CD")) expect_that(res$Style[20], equals("AB:AA")) expect_that(res$Style[21], equals("AB:AB")) expect_that(res$Style[22], equals("AB:AC")) expect_that(res$Style[23], equals("AA:AB")) expect_that(res$Style[24], equals("AB:AC")) expect_that(res$Style[25], equals("AB:AA")) expect_that(res$Style[26], equals("AB:CD")) expect_that(res$Style[27], equals("AB:CC")) expect_that(res$Style[28], equals("AA:BB")) expect_that(res$Style[29], equals("AB:CD")) expect_that(res$Style[30], equals("AA:BB")) expect_that(res$Style[31], equals("AA:AB")) expect_that(res$Style[32], equals("AB:CD")) expect_that(res$Style[33], equals("AA:AA")) expect_that(res$Style[34], equals("AB:CD")) # Check result: Observed. expect_that( res$Observed[res$Sample.Name == "major_minor_1"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) expect_that( res$Observed[res$Sample.Name == "major_minor_2"], equals(c(0, 2, 0, 0, 0, 0, 1, 1, 2, 2, 1, 1, 0, 0, 2, 0, 1)) ) # Check result: Expected. expect_that( res$Expected[res$Sample.Name == "major_minor_1"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) expect_that( res$Expected[res$Sample.Name == "major_minor_2"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) # Check result: Dropin. expect_that( res$Dropin[res$Sample.Name == "major_minor_1"], equals(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) ) expect_that( res$Dropin[res$Sample.Name == "major_minor_2"], equals(c(1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0)) ) # TEST 03 ------------------------------------------------------------------- # Remove off-ladder alleles, do not use drop-outs. # Analyse dataframe. res <- calculateMixture( data = mixture, ref1 = major, ref2 = minor, ol.rm = TRUE, ignore.dropout = FALSE ) # Check return class. expect_match(class(res), class(data.frame())) # Check that expected columns exist. expect_false(is.null(res$Sample.Name)) expect_false(is.null(res$Marker)) expect_false(is.null(res$Style)) expect_false(is.null(res$Mx)) expect_false(is.null(res$Average)) expect_false(is.null(res$Difference)) expect_false(is.null(res$Observed)) expect_false(is.null(res$Expected)) expect_false(is.null(res$Profile)) expect_false(is.null(res$Dropin)) # Check for NA's. expect_false(any(is.na(res$Sample.Name))) expect_false(any(is.na(res$Marker))) expect_false(any(is.na(res$Style))) expect_true(any(is.na(res$Mx))) expect_false(any(is.na(res$Average))) expect_true(any(is.na(res$Difference))) expect_false(any(is.na(res$Observed))) expect_false(any(is.na(res$Expected))) expect_false(any(is.na(res$Profile))) expect_false(any(is.na(res$Dropin))) # Check result: sample name. expect_that( unique(res$Sample.Name), equals(c("major_minor_1", "major_minor_2")) ) # Check result: average Mx. expect_that( round(unique(res$Average), 4), equals(c(0.2552, 0.2407)) ) # Check result: profile. expect_that( round(unique(res$Profile), 2), equals(c(100.00, 68.42)) ) # Check result: Mx. expect_that(res$Mx[1], equals((2 * 1503) / (1503 + 7533))) expect_that(res$Mx[2], equals((1000 + 1100) / (1000 + 1100 + 4500 + 4200))) expect_that(res$Mx[3], equals((2 * 1200) / (1200 + 9300))) expect_that(res$Mx[4], equals(as.numeric(NA))) expect_that(res$Mx[5], equals((1500) / (1500 + 1700))) expect_that(res$Mx[6], equals((7000 - 3000) / (7000 + 3000))) expect_that(res$Mx[7], equals(1300 / (1300 + 3800))) expect_that(res$Mx[8], equals((2 * 1200) / (1200 + 8500))) expect_that(res$Mx[9], equals((1600 + 1600) / (1600 + 1600 + 3500 + 3400))) expect_that(res$Mx[10], equals((1200 + 900) / (1200 + 900 + 8600))) expect_that(res$Mx[11], equals(1900 / (1900 + 8200))) expect_that(res$Mx[12], equals((1200 + 1400) / (1200 + 1400 + 5000 + 4600))) expect_that(res$Mx[13], equals(2100 / (2100 + 7800))) expect_that(res$Mx[14], equals((8000 - 6000) / (8000 + 6000))) expect_that(res$Mx[15], equals((900 + 1200) / (900 + 1200 + 3400 + 3800))) expect_that(res$Mx[16], equals(as.numeric(NA))) expect_that(res$Mx[17], equals((1000 + 1100) / (1000 + 1100 + 4000 + 4100))) expect_that(res$Mx[18], equals(as.numeric(NA))) expect_that(res$Mx[19], equals((1000 + 1100) / (1000 + 1100 + 4500 + 4200))) expect_that(res$Mx[20], equals(as.numeric(NA))) expect_that(res$Mx[21], equals(as.numeric(NA))) expect_that(res$Mx[22], equals(as.numeric(NA))) expect_that(res$Mx[23], equals((7000 - 3000) / (7000 + 3000))) expect_that(res$Mx[24], equals(1300 / (1300 + 3800))) expect_that(res$Mx[25], equals((2 * 1200) / (1200 + 8500))) expect_that(res$Mx[26], equals((1600 + 1600) / (1600 + 1600 + 3500 + 3400))) expect_that(res$Mx[27], equals((1200 + 900) / (1200 + 900 + 8600))) expect_that(res$Mx[28], equals(1900 / (1900 + 8200))) expect_that(res$Mx[29], equals(as.numeric(NA))) expect_that(res$Mx[30], equals(as.numeric(NA))) expect_that(res$Mx[31], equals((8000 - 6000) / (8000 + 6000))) expect_that(res$Mx[32], equals((900 + 1200) / (900 + 1200 + 3400 + 3800))) expect_that(res$Mx[33], equals(as.numeric(NA))) expect_that(res$Mx[34], equals(as.numeric(NA))) # Check result: Style. expect_that(res$Style[1], equals("AB:AA")) expect_that(res$Style[2], equals("AB:CD")) expect_that(res$Style[3], equals("AB:AA")) expect_that(res$Style[4], equals("AB:AB")) expect_that(res$Style[5], equals("AB:AC")) expect_that(res$Style[6], equals("AA:AB")) expect_that(res$Style[7], equals("AB:AC")) expect_that(res$Style[8], equals("AB:AA")) expect_that(res$Style[9], equals("AB:CD")) expect_that(res$Style[10], equals("AB:CC")) expect_that(res$Style[11], equals("AA:BB")) expect_that(res$Style[12], equals("AB:CD")) expect_that(res$Style[13], equals("AA:BB")) expect_that(res$Style[14], equals("AA:AB")) expect_that(res$Style[15], equals("AB:CD")) expect_that(res$Style[16], equals("AA:AA")) expect_that(res$Style[17], equals("AB:CD")) expect_that(res$Style[18], equals("Dropout")) expect_that(res$Style[19], equals("AB:CD")) expect_that(res$Style[20], equals("Dropout")) expect_that(res$Style[21], equals("AB:AB")) expect_that(res$Style[22], equals("Dropout")) expect_that(res$Style[23], equals("AA:AB")) expect_that(res$Style[24], equals("AB:AC")) expect_that(res$Style[25], equals("AB:AA")) expect_that(res$Style[26], equals("AB:CD")) expect_that(res$Style[27], equals("AB:CC")) expect_that(res$Style[28], equals("AA:BB")) expect_that(res$Style[29], equals("Dropout")) expect_that(res$Style[30], equals("Dropout")) expect_that(res$Style[31], equals("AA:AB")) expect_that(res$Style[32], equals("AB:CD")) expect_that(res$Style[33], equals("AA:AA")) expect_that(res$Style[34], equals("Dropout")) # Check result: Observed. expect_that( res$Observed[res$Sample.Name == "major_minor_1"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) expect_that( res$Observed[res$Sample.Name == "major_minor_2"], equals(c(0, 2, 0, 0, 0, 0, 1, 1, 2, 2, 1, 1, 0, 0, 2, 0, 1)) ) # Check result: Expected. expect_that( res$Expected[res$Sample.Name == "major_minor_1"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) expect_that( res$Expected[res$Sample.Name == "major_minor_2"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) # Check result: Dropin. expect_that( res$Dropin[res$Sample.Name == "major_minor_1"], equals(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) ) expect_that( res$Dropin[res$Sample.Name == "major_minor_2"], equals(c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0)) ) # TEST 04 ------------------------------------------------------------------- # Count OL as dropin, do not use drop-outs. # Analyse dataframe. res <- calculateMixture( data = mixture, ref1 = major, ref2 = minor, ol.rm = FALSE, ignore.dropout = FALSE ) # Check return class. expect_match(class(res), class(data.frame())) # Check that expected columns exist. expect_false(is.null(res$Sample.Name)) expect_false(is.null(res$Marker)) expect_false(is.null(res$Style)) expect_false(is.null(res$Mx)) expect_false(is.null(res$Average)) expect_false(is.null(res$Difference)) expect_false(is.null(res$Observed)) expect_false(is.null(res$Expected)) expect_false(is.null(res$Profile)) expect_false(is.null(res$Dropin)) # Check for NA's. expect_false(any(is.na(res$Sample.Name))) expect_false(any(is.na(res$Marker))) expect_false(any(is.na(res$Style))) expect_true(any(is.na(res$Mx))) expect_false(any(is.na(res$Average))) expect_true(any(is.na(res$Difference))) expect_false(any(is.na(res$Observed))) expect_false(any(is.na(res$Expected))) expect_false(any(is.na(res$Profile))) expect_false(any(is.na(res$Dropin))) # Check result: sample name. expect_that( unique(res$Sample.Name), equals(c("major_minor_1", "major_minor_2")) ) # Check result: average Mx. expect_that( round(unique(res$Average), 4), equals(c(0.2552, 0.2407)) ) # Check result: profile. expect_that( round(unique(res$Profile), 2), equals(c(100.00, 68.42)) ) # Check result: Mx. expect_that(res$Mx[1], equals((2 * 1503) / (1503 + 7533))) expect_that(res$Mx[2], equals((1000 + 1100) / (1000 + 1100 + 4500 + 4200))) expect_that(res$Mx[3], equals((2 * 1200) / (1200 + 9300))) expect_that(res$Mx[4], equals(as.numeric(NA))) expect_that(res$Mx[5], equals((1500) / (1500 + 1700))) expect_that(res$Mx[6], equals((7000 - 3000) / (7000 + 3000))) expect_that(res$Mx[7], equals(1300 / (1300 + 3800))) expect_that(res$Mx[8], equals((2 * 1200) / (1200 + 8500))) expect_that(res$Mx[9], equals((1600 + 1600) / (1600 + 1600 + 3500 + 3400))) expect_that(res$Mx[10], equals((1200 + 900) / (1200 + 900 + 8600))) expect_that(res$Mx[11], equals(1900 / (1900 + 8200))) expect_that(res$Mx[12], equals((1200 + 1400) / (1200 + 1400 + 5000 + 4600))) expect_that(res$Mx[13], equals(2100 / (2100 + 7800))) expect_that(res$Mx[14], equals((8000 - 6000) / (8000 + 6000))) expect_that(res$Mx[15], equals((900 + 1200) / (900 + 1200 + 3400 + 3800))) expect_that(res$Mx[16], equals(as.numeric(NA))) expect_that(res$Mx[17], equals((1000 + 1100) / (1000 + 1100 + 4000 + 4100))) expect_that(res$Mx[18], equals(as.numeric(NA))) expect_that(res$Mx[19], equals((1000 + 1100) / (1000 + 1100 + 4500 + 4200))) expect_that(res$Mx[20], equals(as.numeric(NA))) expect_that(res$Mx[21], equals(as.numeric(NA))) expect_that(res$Mx[22], equals(as.numeric(NA))) expect_that(res$Mx[23], equals((7000 - 3000) / (7000 + 3000))) expect_that(res$Mx[24], equals(1300 / (1300 + 3800))) expect_that(res$Mx[25], equals((2 * 1200) / (1200 + 8500))) expect_that(res$Mx[26], equals((1600 + 1600) / (1600 + 1600 + 3500 + 3400))) expect_that(res$Mx[27], equals((1200 + 900) / (1200 + 900 + 8600))) expect_that(res$Mx[28], equals(1900 / (1900 + 8200))) expect_that(res$Mx[29], equals(as.numeric(NA))) expect_that(res$Mx[30], equals(as.numeric(NA))) expect_that(res$Mx[31], equals((8000 - 6000) / (8000 + 6000))) expect_that(res$Mx[32], equals((900 + 1200) / (900 + 1200 + 3400 + 3800))) expect_that(res$Mx[33], equals(as.numeric(NA))) expect_that(res$Mx[34], equals(as.numeric(NA))) # Check result: Style. expect_that(res$Style[1], equals("AB:AA")) expect_that(res$Style[2], equals("AB:CD")) expect_that(res$Style[3], equals("AB:AA")) expect_that(res$Style[4], equals("AB:AB")) expect_that(res$Style[5], equals("AB:AC")) expect_that(res$Style[6], equals("AA:AB")) expect_that(res$Style[7], equals("AB:AC")) expect_that(res$Style[8], equals("AB:AA")) expect_that(res$Style[9], equals("AB:CD")) expect_that(res$Style[10], equals("AB:CC")) expect_that(res$Style[11], equals("AA:BB")) expect_that(res$Style[12], equals("AB:CD")) expect_that(res$Style[13], equals("AA:BB")) expect_that(res$Style[14], equals("AA:AB")) expect_that(res$Style[15], equals("AB:CD")) expect_that(res$Style[16], equals("AA:AA")) expect_that(res$Style[17], equals("AB:CD")) expect_that(res$Style[18], equals("Dropout")) expect_that(res$Style[19], equals("AB:CD")) expect_that(res$Style[20], equals("Dropout")) expect_that(res$Style[21], equals("AB:AB")) expect_that(res$Style[22], equals("Dropout")) expect_that(res$Style[23], equals("AA:AB")) expect_that(res$Style[24], equals("AB:AC")) expect_that(res$Style[25], equals("AB:AA")) expect_that(res$Style[26], equals("AB:CD")) expect_that(res$Style[27], equals("AB:CC")) expect_that(res$Style[28], equals("AA:BB")) expect_that(res$Style[29], equals("Dropout")) expect_that(res$Style[30], equals("Dropout")) expect_that(res$Style[31], equals("AA:AB")) expect_that(res$Style[32], equals("AB:CD")) expect_that(res$Style[33], equals("AA:AA")) expect_that(res$Style[34], equals("Dropout")) # Check result: Observed. expect_that( res$Observed[res$Sample.Name == "major_minor_1"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) expect_that( res$Observed[res$Sample.Name == "major_minor_2"], equals(c(0, 2, 0, 0, 0, 0, 1, 1, 2, 2, 1, 1, 0, 0, 2, 0, 1)) ) # Check result: Expected. expect_that( res$Expected[res$Sample.Name == "major_minor_1"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) expect_that( res$Expected[res$Sample.Name == "major_minor_2"], equals(c(1, 2, 1, 0, 1, 0, 1, 1, 2, 2, 1, 2, 1, 0, 2, 0, 2)) ) # Check result: Dropin. expect_that( res$Dropin[res$Sample.Name == "major_minor_1"], equals(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) ) expect_that( res$Dropin[res$Sample.Name == "major_minor_2"], equals(c(1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0)) ) })