Nothing
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))
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.