Restyled files

Ran through styler::style_dir() in the R and tests directories in preparation for #23.
This commit is contained in:
Waldir Leoncio 2021-11-10 14:02:35 +01:00
parent a9c7211465
commit fca9caa731
101 changed files with 3856 additions and 3869 deletions

View file

@ -1,249 +1,249 @@
context("Admixture analysis")
test_that("learn*partition behaves like on Matlab", {
# Test data
p1 <- c(0, .5, 1, 1.5)
p2 <- c(seq(0, .5, .1), 1, 1, 1, 2)
p3 <- c(.1, .1, .1, .5, .5, .5, 1, 1, 1)
p4 <- c(.7, 1, 1, 1)
# Test data
p1 <- c(0, .5, 1, 1.5)
p2 <- c(seq(0, .5, .1), 1, 1, 1, 2)
p3 <- c(.1, .1, .1, .5, .5, .5, 1, 1, 1)
p4 <- c(.7, 1, 1, 1)
# Testing learn_simple_partition
expect_equal(
object = learn_simple_partition(p1, 2),
expected = matrix(c(1, 1, 2, 2))
)
expect_equal(
object = learn_simple_partition(p2, 2),
expected = matrix(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2))
)
expect_equal(
object = learn_simple_partition(p3, .5),
expected = matrix(c(1, 1, 1, 2, 2, 2, 3, 3, 3))
)
expect_equal(
object = learn_simple_partition(p4, 5),
expected = matrix(c(1, 1, 1, 1))
)
expect_equal(
object = learn_simple_partition(p4, .1),
expected = matrix(c(1, 2, 2, 2))
)
# Testing learn_simple_partition
expect_equal(
object = learn_simple_partition(p1, 2),
expected = matrix(c(1, 1, 2, 2))
)
expect_equal(
object = learn_simple_partition(p2, 2),
expected = matrix(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2))
)
expect_equal(
object = learn_simple_partition(p3, .5),
expected = matrix(c(1, 1, 1, 2, 2, 2, 3, 3, 3))
)
expect_equal(
object = learn_simple_partition(p4, 5),
expected = matrix(c(1, 1, 1, 1))
)
expect_equal(
object = learn_simple_partition(p4, .1),
expected = matrix(c(1, 2, 2, 2))
)
# Testing learn_partition_modified
expect_equal(
object = learn_partition_modified(p4),
expected = matrix(c(1, 2, 2, 2))
)
# Testing learn_partition_modified
expect_equal(
object = learn_partition_modified(p4),
expected = matrix(c(1, 2, 2, 2))
)
})
test_that("type convertions behave like on Matlab", {
expect_equal(ownNum2Str(1), "1")
expect_equal(ownNum2Str(-123456789), "-123456789")
expect_equal(ownNum2Str(0), "0")
expect_error(ownNum2Str("a"))
expect_equal(proportion2str(1), "1.00")
expect_equal(proportion2str(0), "0.00")
expect_equal(proportion2str(0.4), "0.40")
expect_equal(proportion2str(0.89), "0.89")
expect_equal(proportion2str(-0.4), "0.0-40") # also bugged in original
# TODO: fix after release, as long as it doesn't break anything else
expect_equal(ownNum2Str(1), "1")
expect_equal(ownNum2Str(-123456789), "-123456789")
expect_equal(ownNum2Str(0), "0")
expect_error(ownNum2Str("a"))
expect_equal(proportion2str(1), "1.00")
expect_equal(proportion2str(0), "0.00")
expect_equal(proportion2str(0.4), "0.40")
expect_equal(proportion2str(0.89), "0.89")
expect_equal(proportion2str(-0.4), "0.0-40") # also bugged in original
# TODO: fix after release, as long as it doesn't break anything else
})
test_that("computeRows behaves like on Matlab", {
# Matrices
X <- matrix(1:9, 3, byrow = TRUE)
Y <- matrix(9:1, 3, byrow = TRUE)
Z <- matrix(c(-8, 2, -4, 0), byrow = TRUE)
expect_equal(
object = computeRows(1, X, 3),
expected = matrix(c(1, 4, 7))
)
expect_equal(
object = computeRows(2, X, 3),
expected = matrix(c(1, 2, 7, 8, 13, 14))
)
expect_equal(
object = computeRows(10, X, 3),
expected = matrix(c(1:10, 31:40, 61:70))
)
expect_equal(
object = computeRows(100, X, 3),
expected = matrix(c(1:100, 301:400, 601:700))
)
expect_equal(
object = computeRows(1, Y, 3),
expected = matrix(c(9, 6, 3))
)
expect_equal(
object = computeRows(2, Y, 3),
expected = matrix(c(17, 18, 11, 12, 5, 6))
)
expect_equal(
object = computeRows(10, Y, 3),
expected = matrix(c(81:90, 51:60, 21:30))
)
expect_equal(
object = computeRows(1, Z, 0),
expected = matrix(, 1, 0)
)
expect_equal(
object = computeRows(1, Z, 5),
expected = matrix(rep(-8, 5))
)
expect_equal(
object = computeRows(2, Z, 1),
expected = matrix(rep(c(-17, -16), 1))
)
expect_equal(
object = computeRows(2, Z, 3),
expected = matrix(rep(c(-17, -16), 3))
)
expect_equal(
object = computeRows(3, Z, 1),
expected = matrix(rep(-26:-24, 1))
)
expect_equal(
object = computeRows(3, Z, 10),
expected = matrix(rep(-26:-24, 10))
)
# Matrices
X <- matrix(1:9, 3, byrow = TRUE)
Y <- matrix(9:1, 3, byrow = TRUE)
Z <- matrix(c(-8, 2, -4, 0), byrow = TRUE)
expect_equal(
object = computeRows(1, X, 3),
expected = matrix(c(1, 4, 7))
)
expect_equal(
object = computeRows(2, X, 3),
expected = matrix(c(1, 2, 7, 8, 13, 14))
)
expect_equal(
object = computeRows(10, X, 3),
expected = matrix(c(1:10, 31:40, 61:70))
)
expect_equal(
object = computeRows(100, X, 3),
expected = matrix(c(1:100, 301:400, 601:700))
)
expect_equal(
object = computeRows(1, Y, 3),
expected = matrix(c(9, 6, 3))
)
expect_equal(
object = computeRows(2, Y, 3),
expected = matrix(c(17, 18, 11, 12, 5, 6))
)
expect_equal(
object = computeRows(10, Y, 3),
expected = matrix(c(81:90, 51:60, 21:30))
)
expect_equal(
object = computeRows(1, Z, 0),
expected = matrix(, 1, 0)
)
expect_equal(
object = computeRows(1, Z, 5),
expected = matrix(rep(-8, 5))
)
expect_equal(
object = computeRows(2, Z, 1),
expected = matrix(rep(c(-17, -16), 1))
)
expect_equal(
object = computeRows(2, Z, 3),
expected = matrix(rep(c(-17, -16), 3))
)
expect_equal(
object = computeRows(3, Z, 1),
expected = matrix(rep(-26:-24, 1))
)
expect_equal(
object = computeRows(3, Z, 10),
expected = matrix(rep(-26:-24, 10))
)
})
test_that("computeIndLogml works like on Matlab", {
expect_equivalent(computeIndLogml(10, 1), 2.3026, tol = .0001)
expect_equivalent(computeIndLogml(0, 1), -Inf)
expect_equivalent(computeIndLogml(1, 0), -Inf)
expect_equivalent(computeIndLogml(0, 0), -Inf)
expect_equivalent(computeIndLogml(-pi, -8), 3.2242, tol = .0001)
expect_equivalent(computeIndLogml(2:3, 2), 2.3026, tol = .0001)
expect_equivalent(computeIndLogml(matrix(8:5, 2), 100), 14.316, tol = .001)
expect_equivalent(
object = computeIndLogml(matrix(8:5, 2), matrix(c(1, 3), 1)),
expected = 6.4118,
tol = .001
)
expect_equivalent(
object = computeIndLogml(matrix(8:5, 1), matrix(c(1, 3), 1)),
expected = 12.9717,
tol = .001
)
expect_equivalent(
object = computeIndLogml(c(8, 1), c(-1.6, 5)),
expected = complex(real = 6.4739, imaginary = pi),
tol = .001
)
expect_equivalent(computeIndLogml(10, 1), 2.3026, tol = .0001)
expect_equivalent(computeIndLogml(0, 1), -Inf)
expect_equivalent(computeIndLogml(1, 0), -Inf)
expect_equivalent(computeIndLogml(0, 0), -Inf)
expect_equivalent(computeIndLogml(-pi, -8), 3.2242, tol = .0001)
expect_equivalent(computeIndLogml(2:3, 2), 2.3026, tol = .0001)
expect_equivalent(computeIndLogml(matrix(8:5, 2), 100), 14.316, tol = .001)
expect_equivalent(
object = computeIndLogml(matrix(8:5, 2), matrix(c(1, 3), 1)),
expected = 6.4118,
tol = .001
)
expect_equivalent(
object = computeIndLogml(matrix(8:5, 1), matrix(c(1, 3), 1)),
expected = 12.9717,
tol = .001
)
expect_equivalent(
object = computeIndLogml(c(8, 1), c(-1.6, 5)),
expected = complex(real = 6.4739, imaginary = pi),
tol = .001
)
})
test_that("suoritaMuutos works like on Matlab", {
mx1 <- c(10, 5, 8)
mx2 <- matrix(c(10, 9, 5, 8, 8, -7), 2)
expect_equal(suoritaMuutos(10, 3, 1), 10)
expect_equal(suoritaMuutos(mx1, 3, 1), c(10, 5, 8))
expect_equal(suoritaMuutos(mx1, 3, 2), c(7, 8, 8))
expect_equal(suoritaMuutos(mx1, 3, 3), c(7, 5, 11))
expect_equal(suoritaMuutos(mx1, 2, 3), c(8, 5, 10))
expect_equal(suoritaMuutos(mx1, -7, 3), c(17, 5, 1))
expect_equal(suoritaMuutos(mx2, 0, 5), mx2)
expect_equal(suoritaMuutos(mx2, 0, 5), mx2)
expect_equal(suoritaMuutos(mx2, -3, 6), matrix(c(13, 9, 5, 8, 8, -10), 2))
mx1 <- c(10, 5, 8)
mx2 <- matrix(c(10, 9, 5, 8, 8, -7), 2)
expect_equal(suoritaMuutos(10, 3, 1), 10)
expect_equal(suoritaMuutos(mx1, 3, 1), c(10, 5, 8))
expect_equal(suoritaMuutos(mx1, 3, 2), c(7, 8, 8))
expect_equal(suoritaMuutos(mx1, 3, 3), c(7, 5, 11))
expect_equal(suoritaMuutos(mx1, 2, 3), c(8, 5, 10))
expect_equal(suoritaMuutos(mx1, -7, 3), c(17, 5, 1))
expect_equal(suoritaMuutos(mx2, 0, 5), mx2)
expect_equal(suoritaMuutos(mx2, 0, 5), mx2)
expect_equal(suoritaMuutos(mx2, -3, 6), matrix(c(13, 9, 5, 8, 8, -10), 2))
})
test_that("laskeMuutokset4 works like on Matlab", {
mx1 <- t(c(.4, 7))
expect_equivalent(
object = laskeMuutokset4(2, mx1, c(8, 2), 3),
expected = t(c(0, .3742)),
tol = .0001
)
mx1 <- t(c(.4, 7))
expect_equivalent(
object = laskeMuutokset4(2, mx1, c(8, 2), 3),
expected = t(c(0, .3742)),
tol = .0001
)
})
test_that("etsiParas works like on Matlab", {
mx1 <- t(c(.4, 7))
expect_equal(etsiParas(2, mx1, c(8, 1), 8), c(.4, 7, 8))
expect_equivalent(etsiParas(2, mx1, c(8, 1), 1), c(-1.6, 9, 3.1864), .0001)
expect_equivalent(
object = etsiParas(5, mx1, c(8, 1), -pi),
expected = c(-4.6, 12, 3.8111),
tol = .001
)
expect_equivalent(
object = etsiParas(-.5, mx1, c(-1, 0), -10),
expected = c(7.4, 0, complex(real = 1.8563, imaginary = 3.1416)),
tol = .0001
)
mx1 <- t(c(.4, 7))
expect_equal(etsiParas(2, mx1, c(8, 1), 8), c(.4, 7, 8))
expect_equivalent(etsiParas(2, mx1, c(8, 1), 1), c(-1.6, 9, 3.1864), .0001)
expect_equivalent(
object = etsiParas(5, mx1, c(8, 1), -pi),
expected = c(-4.6, 12, 3.8111),
tol = .001
)
expect_equivalent(
object = etsiParas(-.5, mx1, c(-1, 0), -10),
expected = c(7.4, 0, complex(real = 1.8563, imaginary = 3.1416)),
tol = .0001
)
})
test_that("computePersonalAllFreqs works like on Matlab", {
expect_equal(computePersonalAllFreqs(1, 1:4, c(15, 5, 10, 40), 1), 15)
mx <- matrix(c(15, 10, 5, 40), 2)
expect_equal(computePersonalAllFreqs(1, 1:4, mx, 1), c(15, 40))
expect_equal(computePersonalAllFreqs(1, 1:3, mx, 1), c(15, 40))
expect_equal(computePersonalAllFreqs(1, 1:2, mx, 1), c(15, 40))
expect_equal(computePersonalAllFreqs(1, 1:4, c(15, 5, 10, 40), 1), 15)
mx <- matrix(c(15, 10, 5, 40), 2)
expect_equal(computePersonalAllFreqs(1, 1:4, mx, 1), c(15, 40))
expect_equal(computePersonalAllFreqs(1, 1:3, mx, 1), c(15, 40))
expect_equal(computePersonalAllFreqs(1, 1:2, mx, 1), c(15, 40))
})
test_that("simuloiAlleeli works like on Matlab", {
sk <- 2
vk <- 1:3
ra <- array(1:12, c(2, 2, 3))
mx1 <- matrix(c(3, 5, 0, 9), 2)
mx2 <- matrix(c(3, 5, 0, 9, 5, 8), 2)
expect_equal(simuloiAlleeli(sk, 1, 1), 1)
expect_equal(simuloiAlleeli(vk, 1, 2), 1)
expect_equal(simuloiAlleeli(ra, 2, 1), 1)
expect_equal(simuloiAlleeli(mx1, 1, 2), 2)
expect_equal(simuloiAlleeli(mx2, 1, 3), 1)
sk <- 2
vk <- 1:3
ra <- array(1:12, c(2, 2, 3))
mx1 <- matrix(c(3, 5, 0, 9), 2)
mx2 <- matrix(c(3, 5, 0, 9, 5, 8), 2)
expect_equal(simuloiAlleeli(sk, 1, 1), 1)
expect_equal(simuloiAlleeli(vk, 1, 2), 1)
expect_equal(simuloiAlleeli(ra, 2, 1), 1)
expect_equal(simuloiAlleeli(mx1, 1, 2), 2)
expect_equal(simuloiAlleeli(mx2, 1, 3), 1)
})
test_that("simulateIndividuals works like on Matlab", {
set.seed(2)
expect_equal(
object = simulateIndividuals(1, 3, 2, 0, .2),
expected = matrix(c(1, -999, 1), ncol = 1)
)
expect_equal(
object = simulateIndividuals(5, 3, 1:3, 4, 0),
expected = matrix(rep(-999, 15 * 3), 15)
)
expect_equal(
object = simulateIndividuals(3, 3, 2, 1, 1),
expected = matrix(rep(1, 9), 9)
)
set.seed(2)
expect_equal(
object = sum(simulateIndividuals(3, 3, 2, 1, .5) == 1),
expected = 6
)
set.seed(2)
expect_equal(
object = simulateIndividuals(1, 3, 2, 0, .2),
expected = matrix(c(1, -999, 1), ncol = 1)
)
expect_equal(
object = simulateIndividuals(5, 3, 1:3, 4, 0),
expected = matrix(rep(-999, 15 * 3), 15)
)
expect_equal(
object = simulateIndividuals(3, 3, 2, 1, 1),
expected = matrix(rep(1, 9), 9)
)
set.seed(2)
expect_equal(
object = sum(simulateIndividuals(3, 3, 2, 1, .5) == 1),
expected = 6
)
})
test_that("simulateAllFreqs works as expected", {
empty_mt <- matrix(NA, 0, 0)
expect_equivalent(suppressWarnings(simulateAllFreqs(3)), empty_mt)
expect_equivalent(suppressWarnings(simulateAllFreqs(3:5)), empty_mt)
expect_equivalent(
object = suppressWarnings(simulateAllFreqs(matrix(1:4, 2))),
expected = empty_mt
)
empty_mt <- matrix(NA, 0, 0)
expect_equivalent(suppressWarnings(simulateAllFreqs(3)), empty_mt)
expect_equivalent(suppressWarnings(simulateAllFreqs(3:5)), empty_mt)
expect_equivalent(
object = suppressWarnings(simulateAllFreqs(matrix(1:4, 2))),
expected = empty_mt
)
})
test_that("computeAllFreqs2 works as expected", {
expect_equivalent(computeAllFreqs2(10), matrix(NA, 0, 0))
expect_equivalent(computeAllFreqs2(10), matrix(NA, 0, 0))
})
test_that("poistaLiianPienet works as expected", {
expect_equal(poistaLiianPienet(100, matrix(1:4, 2), 0), 100)
expect_equal(poistaLiianPienet(100, matrix(1:4, 2), -5), 100)
expect_equal(poistaLiianPienet(100, matrix(1:4, 2), 0), 100)
expect_equal(poistaLiianPienet(100, matrix(1:4, 2), -5), 100)
})
test_that("noIndex works properly", {
abcd_vec <- letters[1:4]
abcd_mat <- matrix(abcd_vec, 2)
abcdef_mat <- matrix(letters[1:6], 2)
efg_vec <- letters[5:7]
expect_equal(noIndex(abcd_vec, 1:6), abcd_vec)
expect_equal(noIndex(abcd_vec, 1:3), abcd_vec[-4])
expect_equal(noIndex(abcd_vec, 1:2), abcd_vec)
expect_equal(noIndex(abcd_vec, efg_vec), abcd_vec[-4])
expect_equal(noIndex(abcd_mat, 1), abcd_mat[, 1])
expect_equal(noIndex(abcd_mat, 2), abcd_mat[, 1])
expect_equal(noIndex(abcdef_mat, 1:2), abcdef_mat[, 1:2])
expect_equal(noIndex(abcdef_mat, abcd_mat), abcdef_mat[, 1:2])
})
abcd_vec <- letters[1:4]
abcd_mat <- matrix(abcd_vec, 2)
abcdef_mat <- matrix(letters[1:6], 2)
efg_vec <- letters[5:7]
expect_equal(noIndex(abcd_vec, 1:6), abcd_vec)
expect_equal(noIndex(abcd_vec, 1:3), abcd_vec[-4])
expect_equal(noIndex(abcd_vec, 1:2), abcd_vec)
expect_equal(noIndex(abcd_vec, efg_vec), abcd_vec[-4])
expect_equal(noIndex(abcd_mat, 1), abcd_mat[, 1])
expect_equal(noIndex(abcd_mat, 2), abcd_mat[, 1])
expect_equal(noIndex(abcdef_mat, 1:2), abcdef_mat[, 1:2])
expect_equal(noIndex(abcdef_mat, abcd_mat), abcdef_mat[, 1:2])
})

View file

@ -1,245 +1,245 @@
context("Basic Matlab functions")
test_that("rand works properly", {
expect_equal(dim(rand()), c(1, 1))
expect_equal(dim(rand(1, 2)), c(1, 2))
expect_equal(dim(rand(3, 2)), c(3, 2))
expect_equal(dim(rand()), c(1, 1))
expect_equal(dim(rand(1, 2)), c(1, 2))
expect_equal(dim(rand(3, 2)), c(3, 2))
})
test_that("repmat works properly", {
mx0 <- c(1:4) # when converted to matrix, results in a column vector
mx1 <- matrix(5:8)
mx2 <- matrix(0:-3, 2)
expect_error(repmat(mx0))
expect_equal(repmat(mx0, 1), t(as.matrix(mx0)))
expect_equal(
object = repmat(mx0, 2),
expected = unname(cbind(rbind(mx0, mx0), rbind(mx0, mx0)))
)
expect_equal(
object = repmat(mx1, 2),
expected = unname(cbind(rbind(mx1, mx1), rbind(mx1, mx1)))
)
expect_equal(
object = repmat(mx2, c(2, 3)),
expected = cbind(rbind(mx2, mx2), rbind(mx2, mx2), rbind(mx2, mx2))
)
expect_equal(
object = repmat(mx2, c(4, 1)),
expected = rbind(mx2, mx2, mx2, mx2)
)
expect_equal(
object = repmat(mx2, c(1, 1, 2)),
expected = array(mx2, c(2, 2, 2))
)
expect_equal(repmat(1:2, 3), matrix(rep(1:2, 9), 3, 6, byrow=TRUE))
expect_equal(repmat(10, c(3, 2)), matrix(10, 3, 2))
mx0 <- c(1:4) # when converted to matrix, results in a column vector
mx1 <- matrix(5:8)
mx2 <- matrix(0:-3, 2)
expect_error(repmat(mx0))
expect_equal(repmat(mx0, 1), t(as.matrix(mx0)))
expect_equal(
object = repmat(mx0, 2),
expected = unname(cbind(rbind(mx0, mx0), rbind(mx0, mx0)))
)
expect_equal(
object = repmat(mx1, 2),
expected = unname(cbind(rbind(mx1, mx1), rbind(mx1, mx1)))
)
expect_equal(
object = repmat(mx2, c(2, 3)),
expected = cbind(rbind(mx2, mx2), rbind(mx2, mx2), rbind(mx2, mx2))
)
expect_equal(
object = repmat(mx2, c(4, 1)),
expected = rbind(mx2, mx2, mx2, mx2)
)
expect_equal(
object = repmat(mx2, c(1, 1, 2)),
expected = array(mx2, c(2, 2, 2))
)
expect_equal(repmat(1:2, 3), matrix(rep(1:2, 9), 3, 6, byrow = TRUE))
expect_equal(repmat(10, c(3, 2)), matrix(10, 3, 2))
})
test_that("zeros and ones work as expected", {
expect_equal(zeros(1), matrix(0, 1))
expect_equal(zeros(2), matrix(0, 2, 2))
expect_equal(zeros(2, 1), matrix(0, 2, 1))
expect_equal(zeros(1, 10), matrix(0, 1, 10))
expect_equal(zeros(3, 2, 4), array(0, c(3, 2, 4)))
expect_equal(ones(8), matrix(1, 8, 8))
expect_equal(ones(5, 2), matrix(1, 5, 2))
expect_equal(ones(2, 100), matrix(1, 2, 100))
expect_equal(ones(3, 2, 4, 2), array(1, c(3, 2, 4, 2)))
expect_equal(zeros(1), matrix(0, 1))
expect_equal(zeros(2), matrix(0, 2, 2))
expect_equal(zeros(2, 1), matrix(0, 2, 1))
expect_equal(zeros(1, 10), matrix(0, 1, 10))
expect_equal(zeros(3, 2, 4), array(0, c(3, 2, 4)))
expect_equal(ones(8), matrix(1, 8, 8))
expect_equal(ones(5, 2), matrix(1, 5, 2))
expect_equal(ones(2, 100), matrix(1, 2, 100))
expect_equal(ones(3, 2, 4, 2), array(1, c(3, 2, 4, 2)))
})
test_that("times works as expected", {
expect_equal(times(9, 6), as.matrix(54))
expect_equal(times(9, c(.8, 9)), as.matrix(c(7.2, 81)))
expect_equal(times(c(.8, 9), 5), as.matrix(c(4, 45)))
expect_equal(times(matrix(1:4, 2), 5), matrix(c(5, 10, 15, 20), 2))
expect_equal(times(5, matrix(1:4, 2)), matrix(c(5, 10, 15, 20), 2))
expect_equal(times(matrix(1:4, 2), c(10, 3)), matrix(c(10, 6, 30, 12), 2))
expect_equal(
object = times(matrix(1:4, 2), matrix(c(10, 3), 1)),
expected = matrix(c(10, 20, 9, 12), 2)
)
expect_equal(times(c(10, 3), matrix(1:4, 2)), matrix(c(10, 6, 30, 12), 2))
expect_equal(
object = times(matrix(c(10, -5, 3, 9), 2), matrix(1:4, 2)),
expected = matrix(c(10, -10, 9, 36), 2)
)
expect_equal(
object = times(matrix(c(-1.6, 5), 1), c(8, 1)),
expected = matrix(c(-12.8, -1.6, 40, 5), 2)
)
expect_equal(times(9, 6), as.matrix(54))
expect_equal(times(9, c(.8, 9)), as.matrix(c(7.2, 81)))
expect_equal(times(c(.8, 9), 5), as.matrix(c(4, 45)))
expect_equal(times(matrix(1:4, 2), 5), matrix(c(5, 10, 15, 20), 2))
expect_equal(times(5, matrix(1:4, 2)), matrix(c(5, 10, 15, 20), 2))
expect_equal(times(matrix(1:4, 2), c(10, 3)), matrix(c(10, 6, 30, 12), 2))
expect_equal(
object = times(matrix(1:4, 2), matrix(c(10, 3), 1)),
expected = matrix(c(10, 20, 9, 12), 2)
)
expect_equal(times(c(10, 3), matrix(1:4, 2)), matrix(c(10, 6, 30, 12), 2))
expect_equal(
object = times(matrix(c(10, -5, 3, 9), 2), matrix(1:4, 2)),
expected = matrix(c(10, -10, 9, 36), 2)
)
expect_equal(
object = times(matrix(c(-1.6, 5), 1), c(8, 1)),
expected = matrix(c(-12.8, -1.6, 40, 5), 2)
)
})
test_that("colon works as expected (hee hee)", {
expect_equal(colon(1, 4), 1:4)
expect_length(colon(4, 1), 0)
expect_equal(colon(1, 4), 1:4)
expect_length(colon(4, 1), 0)
})
test_that("size works as on MATLAB", {
sk <- 10
vk <- 1:4
mx <- matrix(1:6, 2)
ra <- array(1:24, c(2, 3, 4))
expect_equal(size(sk), 1)
expect_equal(size(vk), c(1, 4))
expect_equal(size(mx), c(2, 3))
expect_equal(size(ra), c(2, 3, 4))
expect_equal(size(sk, 199), 1)
expect_equal(size(vk, 199), 1)
expect_equal(size(mx, 199), 1)
expect_equal(size(ra, 199), 1)
expect_equal(size(vk, 2), 4)
expect_equal(size(mx, 2), 3)
expect_equal(size(ra, 2), 3)
expect_equal(size(ra, 3), 4)
sk <- 10
vk <- 1:4
mx <- matrix(1:6, 2)
ra <- array(1:24, c(2, 3, 4))
expect_equal(size(sk), 1)
expect_equal(size(vk), c(1, 4))
expect_equal(size(mx), c(2, 3))
expect_equal(size(ra), c(2, 3, 4))
expect_equal(size(sk, 199), 1)
expect_equal(size(vk, 199), 1)
expect_equal(size(mx, 199), 1)
expect_equal(size(ra, 199), 1)
expect_equal(size(vk, 2), 4)
expect_equal(size(mx, 2), 3)
expect_equal(size(ra, 2), 3)
expect_equal(size(ra, 3), 4)
})
test_that("reshape reshapes properly", {
mx <- matrix(1:4, 2)
ra <- array(1:12, c(2, 3, 2))
expect_equal(reshape(mx, c(1, 4)), matrix(1:4, 1))
expect_equal(reshape(mx, c(2, 2)), mx)
expect_equal(reshape(mx, c(1, 1, 4)), array(mx, c(1, 1, 4)))
expect_error(reshape(mx, c(1, 2, 3)))
expect_error(reshape(ra, c(1, 2, 3)))
expect_equal(reshape(ra, c(3, 2, 2)), array(ra, c(3, 2, 2)))
mx <- matrix(1:4, 2)
ra <- array(1:12, c(2, 3, 2))
expect_equal(reshape(mx, c(1, 4)), matrix(1:4, 1))
expect_equal(reshape(mx, c(2, 2)), mx)
expect_equal(reshape(mx, c(1, 1, 4)), array(mx, c(1, 1, 4)))
expect_error(reshape(mx, c(1, 2, 3)))
expect_error(reshape(ra, c(1, 2, 3)))
expect_equal(reshape(ra, c(3, 2, 2)), array(ra, c(3, 2, 2)))
})
test_that("isfield works as on Matlab", {
S <- list()
S$x <- rnorm(100)
S$y <- sin(S$x)
S$title <- "y = sin(x)"
expect_true(isfield(S, "title"))
expect_equivalent(
object = isfield(S, c("x", "y", "z", "title", "error")),
expected = c(TRUE, TRUE, FALSE, TRUE, FALSE)
)
S <- list()
S$x <- rnorm(100)
S$y <- sin(S$x)
S$title <- "y = sin(x)"
expect_true(isfield(S, "title"))
expect_equivalent(
object = isfield(S, c("x", "y", "z", "title", "error")),
expected = c(TRUE, TRUE, FALSE, TRUE, FALSE)
)
})
test_that("strcmp works as expected", {
yes <- 'Yes'
no <- 'No'
ja <- 'Yes'
expect_false(strcmp(yes, no))
expect_true(strcmp(yes, ja))
s1 <- 'upon'
s2 <- matrix(c('Once', 'upon', 'a', 'time'), 2, byrow=TRUE)
s3 <- c('Once', 'upon', 'a', 'time')
s4 <- matrix(c("A", "bc", "def", "G"), 2, byrow=TRUE)
s5 <- matrix(c("B", "c", "def", "G"), 2, byrow=TRUE)
expect_equal(strcmp(s1, s2), matrix(c(FALSE, FALSE, TRUE, FALSE), 2))
expect_equivalent(strcmp(s1, s3), c(FALSE, TRUE, FALSE, FALSE))
expect_error(strcmp(s2, s3))
expect_equal(strcmp(s4, s5), matrix(c(FALSE, TRUE, FALSE, TRUE), 2))
yes <- "Yes"
no <- "No"
ja <- "Yes"
expect_false(strcmp(yes, no))
expect_true(strcmp(yes, ja))
s1 <- "upon"
s2 <- matrix(c("Once", "upon", "a", "time"), 2, byrow = TRUE)
s3 <- c("Once", "upon", "a", "time")
s4 <- matrix(c("A", "bc", "def", "G"), 2, byrow = TRUE)
s5 <- matrix(c("B", "c", "def", "G"), 2, byrow = TRUE)
expect_equal(strcmp(s1, s2), matrix(c(FALSE, FALSE, TRUE, FALSE), 2))
expect_equivalent(strcmp(s1, s3), c(FALSE, TRUE, FALSE, FALSE))
expect_error(strcmp(s2, s3))
expect_equal(strcmp(s4, s5), matrix(c(FALSE, TRUE, FALSE, TRUE), 2))
})
test_that("isempty works as expected", {
A <- array(dim=c(0, 2, 2))
B <- matrix(rep(NA, 4), 2)
C <- matrix(rep(0, 4), 2)
cat1 <- as.factor(c(NA, NA))
cat2 <- as.factor(c())
str1 <- matrix(rep("", 3))
expect_true(isempty(A))
expect_false(isempty(B))
expect_false(isempty(C))
expect_false(isempty(cat1))
expect_true(isempty(cat2))
expect_false(isempty(str1))
A <- array(dim = c(0, 2, 2))
B <- matrix(rep(NA, 4), 2)
C <- matrix(rep(0, 4), 2)
cat1 <- as.factor(c(NA, NA))
cat2 <- as.factor(c())
str1 <- matrix(rep("", 3))
expect_true(isempty(A))
expect_false(isempty(B))
expect_false(isempty(C))
expect_false(isempty(cat1))
expect_true(isempty(cat2))
expect_false(isempty(str1))
})
test_that("find works as expected", {
X <- matrix(c(1, 0, 2, 0, 1, 1, 0, 0, 4), 3, byrow=TRUE)
Y <- seq(1, 19, 2)
expect_equal(find(X), c(1, 5, 7, 8, 9))
expect_equal(find(!X), c(2, 3, 4, 6))
expect_equal(find(Y == 13), 7)
X <- matrix(c(1, 0, 2, 0, 1, 1, 0, 0, 4), 3, byrow = TRUE)
Y <- seq(1, 19, 2)
expect_equal(find(X), c(1, 5, 7, 8, 9))
expect_equal(find(!X), c(2, 3, 4, 6))
expect_equal(find(Y == 13), 7)
})
test_that("sortrows works as expected", {
mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4)
expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4))
expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4))
expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ])
mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4)
expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4))
expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4))
expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ])
})
test_that("cell works as expected", {
expect_equivalent(cell(0), array(0, dim = c(0, 0)))
expect_equivalent(cell(1), array(0, dim = c(1, 1)))
expect_equivalent(cell(2), array(0, dim = c(2, 2)))
expect_equivalent(cell(3, 4), array(0, dim = c(3, 4)))
expect_equivalent(cell(5, 7, 6), array(0, dim = c(5, 7, 6)))
expect_equivalent(cell(0), array(0, dim = c(0, 0)))
expect_equivalent(cell(1), array(0, dim = c(1, 1)))
expect_equivalent(cell(2), array(0, dim = c(2, 2)))
expect_equivalent(cell(3, 4), array(0, dim = c(3, 4)))
expect_equivalent(cell(5, 7, 6), array(0, dim = c(5, 7, 6)))
})
test_that("blanks works as expected", {
expect_warning(blanks(-1))
expect_equal(suppressWarnings(blanks(-1)), "")
expect_equal(blanks(0), "")
expect_equal(blanks(1), " ")
expect_equal(blanks(10), " ")
expect_warning(blanks(-1))
expect_equal(suppressWarnings(blanks(-1)), "")
expect_equal(blanks(0), "")
expect_equal(blanks(1), " ")
expect_equal(blanks(10), " ")
})
test_that("squeeze works as expected", {
A <- array(dim = c(2, 1, 2))
A[, , 1] <- c(1, 2)
A[, , 2] <- c(3, 4)
expect_equal(squeeze(A), matrix(1:4, 2))
A <- array(0, dim = c(1, 1, 3))
A[, , 1:3] <- 1:3
expect_equal(squeeze(A), matrix(1:3, 3))
A <- array(dim = c(2, 1, 2))
A[, , 1] <- c(1, 2)
A[, , 2] <- c(3, 4)
expect_equal(squeeze(A), matrix(1:4, 2))
A <- array(0, dim = c(1, 1, 3))
A[, , 1:3] <- 1:3
expect_equal(squeeze(A), matrix(1:3, 3))
})
test_that("fix works as expected", {
X <- matrix(c(-1.9, -3.4, 1.6, 2.5, -4.5, 4.5), 3, byrow=TRUE)
Y <- matrix(c(-1, -3, 1, 2, -4, 4), 3, byrow=TRUE)
expect_identical(fix(X), Y)
X <- matrix(c(-1.9, -3.4, 1.6, 2.5, -4.5, 4.5), 3, byrow = TRUE)
Y <- matrix(c(-1, -3, 1, 2, -4, 4), 3, byrow = TRUE)
expect_identical(fix(X), Y)
})
test_that("isspace works as expected", {
chr <- '123 Main St.'
X <- '\t a b\tcde f'
expect_identical(isspace(chr), c(0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0))
expect_identical(isspace(X), c(1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0))
chr <- "123 Main St."
X <- "\t a b\tcde f"
expect_identical(isspace(chr), c(0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0))
expect_identical(isspace(X), c(1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0))
})
test_that("nargin works correctly", {
addme <- function(a, b) {
if (nargin() == 2) {
c <- a + b
} else if (nargin() == 1) {
c <- a + a
} else {
c <- 0
}
return(c)
}
expect_equal(addme(13, 42), 55)
expect_equal(addme(13), 26)
expect_equal(addme(), 0)
addme <- function(a, b) {
if (nargin() == 2) {
c <- a + b
} else if (nargin() == 1) {
c <- a + a
} else {
c <- 0
}
return(c)
}
expect_equal(addme(13, 42), 55)
expect_equal(addme(13), 26)
expect_equal(addme(), 0)
})
test_that("setdiff works as expected", {
A <- c(3, 6, 2, 1, 5, 1, 1)
B <- c(2, 4, 6)
C <- c(1, 3, 5)
expect_equal(setdiff_MATLAB(A, B), C)
A <- data.frame(
Var1 = 1:5,
Var2 = LETTERS[1:5],
Var3 = c(FALSE, TRUE, FALSE, TRUE, FALSE)
)
B <- data.frame(
Var1 = seq(1, 9, by = 2),
Var2 = LETTERS[seq(1, 9, by = 2)],
Var3 = rep(FALSE, 5)
)
C <- data.frame(
Var1 = c(2, 4),
Var2 = c('B', 'D'),
Var3 = c(TRUE, TRUE)
)
row.names(C) <- c(2L, 4L)
expect_equal(setdiff_MATLAB(A, B), C) # TODO: implement for data frames
# TODO: add more examples from https://se.mathworks.com/help/matlab/ref/double.setdiff.html;jsessionid=0d8d42582d4d299b8224403899f1
})
A <- c(3, 6, 2, 1, 5, 1, 1)
B <- c(2, 4, 6)
C <- c(1, 3, 5)
expect_equal(setdiff_MATLAB(A, B), C)
A <- data.frame(
Var1 = 1:5,
Var2 = LETTERS[1:5],
Var3 = c(FALSE, TRUE, FALSE, TRUE, FALSE)
)
B <- data.frame(
Var1 = seq(1, 9, by = 2),
Var2 = LETTERS[seq(1, 9, by = 2)],
Var3 = rep(FALSE, 5)
)
C <- data.frame(
Var1 = c(2, 4),
Var2 = c("B", "D"),
Var3 = c(TRUE, TRUE)
)
row.names(C) <- c(2L, 4L)
expect_equal(setdiff_MATLAB(A, B), C) # TODO: implement for data frames
# TODO: add more examples from https://se.mathworks.com/help/matlab/ref/double.setdiff.html;jsessionid=0d8d42582d4d299b8224403899f1
})

View file

@ -2,73 +2,73 @@ context("Auxiliary functions to greedyMix")
# Defining the relative path to current inst -----------------------------------
if (interactive()) {
path_inst <- "../../inst/ext"
path_inst <- "../../inst/ext"
} else {
path_inst <- system.file("ext", "", package="rBAPS")
path_inst <- system.file("ext", "", package = "rBAPS")
}
# Reading datasets -------------------------------------------------------------
baps_diploid <- read.delim(
file = paste(path_inst, "BAPS_format_clustering_diploid.txt", sep="/"),
sep = " ",
header = FALSE
file = paste(path_inst, "BAPS_format_clustering_diploid.txt", sep = "/"),
sep = " ",
header = FALSE
)
test_that("handleData works as expected", {
data_obs <- handleData(baps_diploid)$newData
data_exp <- matrix(
c(
-9, 1, 2, 1, 1, 1, 2, 1, 2, 2, 1,
-9, 1, 1, 2, 2, 2, 1, 1, 1, 2, 1,
3, 2, 2, 3, 2, -9, 3, 1, 2, 1, 2,
2, 1, 2, 1, 2, -9, 1, 1, 1, 1, 2,
3, 1, 1, 1, 2, 1, 1, 2, -9, 1, 3,
3, 1, 2, 1, 1, 1, 2, 1, -9, 2, 3,
1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 4,
3, 2, 2, 3, 2, 2, 3, 1, 2, 1, 4,
2, 1, 2, 1, -9, 1, 1, 1, 1, 1, 5,
3, 1, 1, 1, -9, 1, 1, 2, 1, 1, 5
),
nrow = 10, byrow = TRUE
)
colnames(data_exp) <- colnames(data_obs)
expect_equal(data_obs, data_exp)
data_obs <- handleData(baps_diploid)$newData
data_exp <- matrix(
c(
-9, 1, 2, 1, 1, 1, 2, 1, 2, 2, 1,
-9, 1, 1, 2, 2, 2, 1, 1, 1, 2, 1,
3, 2, 2, 3, 2, -9, 3, 1, 2, 1, 2,
2, 1, 2, 1, 2, -9, 1, 1, 1, 1, 2,
3, 1, 1, 1, 2, 1, 1, 2, -9, 1, 3,
3, 1, 2, 1, 1, 1, 2, 1, -9, 2, 3,
1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 4,
3, 2, 2, 3, 2, 2, 3, 1, 2, 1, 4,
2, 1, 2, 1, -9, 1, 1, 1, 1, 1, 5,
3, 1, 1, 1, -9, 1, 1, 2, 1, 1, 5
),
nrow = 10, byrow = TRUE
)
colnames(data_exp) <- colnames(data_obs)
expect_equal(data_obs, data_exp)
})
context("Opening files on greedyMix")
df_fasta <- greedyMix(
data = file.path(path_inst, "FASTA_clustering_haploid.fasta"),
format = "FASTA"
data = file.path(path_inst, "FASTA_clustering_haploid.fasta"),
format = "FASTA"
)
df_vcf <- greedyMix(
data = file.path(path_inst, "vcf_example.vcf"),
format = "VCF",
verbose = FALSE
data = file.path(path_inst, "vcf_example.vcf"),
format = "VCF",
verbose = FALSE
)
df_bam <- greedyMix(
data = file.path(path_inst, "bam_example.bam"),
format = "BAM",
data = file.path(path_inst, "bam_example.bam"),
format = "BAM",
)
# TODO #19: add example reading Genpop
test_that("Files are imported correctly", {
expect_equal(dim(df_fasta), c(5, 99))
expect_equal(dim(df_vcf), c(variants = 2, fix_cols = 8, gt_cols = 3))
expect_error(
greedyMix(
data = paste(path_inst, "sam_example.sam", sep="/"),
format = "SAM",
)
)
expect_equal(length(df_bam[[1]]), 13)
expect_equal(dim(df_fasta), c(5, 99))
expect_equal(dim(df_vcf), c(variants = 2, fix_cols = 8, gt_cols = 3))
expect_error(
greedyMix(
data = paste(path_inst, "sam_example.sam", sep = "/"),
format = "SAM",
)
)
expect_equal(length(df_bam[[1]]), 13)
})
context("Linkage")
test_that("Linkages are properly calculated", {
Y <- c(0.5, 0.3, 0.6, 0.3, 0.3, 0.2, 0.3, 0.3, 0.3, 0.5)
expect_equal(
object = linkage(Y),
expected = matrix(c(2, 1, 7, 8, 4, 3, 5, 6, .2, .3, .3, .6), ncol=3)
)
Y <- c(0.5, 0.3, 0.6, 0.3, 0.3, 0.2, 0.3, 0.3, 0.3, 0.5)
expect_equal(
object = linkage(Y),
expected = matrix(c(2, 1, 7, 8, 4, 3, 5, 6, .2, .3, .3, .6), ncol = 3)
)
})