tests/testthat/test-src.R

In TBRDist: Rearrangement Distances Between Unrooted Phylogenetic Trees

context("uspr bundled tests")

Tree <- function (text) ape::read.tree(text = text);
Test <- function (t1, t2, exact, min, max, f1, f2,
                  r, r1, r2,
                  spr, replugTest = FALSE) {
  expect_equivalent(c(exact, min, max, f1, f2),
                    unlist(TBRDist(t1, t2, maf = TRUE,
                                   exact = TRUE, approximate = TRUE)))
  if (replugTest) {
    expect_equivalent(list(r, r1, r2), ReplugDist(t1, t2, maf = TRUE))
  } else {
    expect_equivalent(r, ReplugDist(t1, t2, maf = FALSE))
  }
  if (!is.na(spr)) expect_equivalent(spr, USPRDist(t1, t2))
}

test_that("neighbour_test", {
  t1 <- Tree("(0,1,(2,3));")
  t2 <- Tree("(0,(1,3),2);")
  Test(t1, t2, exact = 1, min = 1, max = 3,
       f1 = "(0,3,1); 2;", f2 = "(0,3,1); 2;",
       r = 1, r1 = "(0,2,3); (*,1);", r2 = "(0,2,3); (*,1);",
       spr = 1, TRUE)
})

test_that("normalize_test", {
  t1 <- Tree("(0,1,((2,5),(3,4)));")
  t2 <- Tree("(0,1,((2,5),(3,4)));")
  Test(t1, t2, 0, 0 , 0,
       f1 = "((0,1),(3,4),(2,5));", f2 = "((0,1),(3,4),(2,5));",
       r = 0, r1 = "((0,1),(3,4),(2,5));", r2 = "((0,1),(3,4),(2,5));",
       spr = NA)
})

test_that("replug_example_1", {
  t1 <- Tree("(a1,a2,(a3,(b1,(b2,(b3,(c1,(c2,c3)))))));")
  t2 <- Tree("(a1,a2,(a3,(((b1,(c1,(c2,c3))),b2),b3)));")
  Test(t1, t2, 2, 1 , 3,
       f1 = "(a1,a2,a3); b1; (b2,((c2,c3),c1),b3);", f2 = "(a1,a2,a3); b1; (b3,b2,((c2,c3),c1));",
       r = 2, r1 = "((a1,a2),(b2,b3),a3); (*,b1); ((*,c1),c2,c3);", r2 = "((a1,a2),(b2,b3),a3); (*,b1); ((*,c1),c2,c3);",
       spr = 2)
})
test_that("replug_example_1_reordered", {
  t1 <- Tree("(a1,a2,(a3,(b1,(b2,(b3,(c1,(c2,c3)))))));")
  t2 <- Tree("(a1,a2,(a3,(((b1,(c1,(c2,c3))),b2),b3)));")
  Test(t1, t2, 2, 1 , 3,
       f1 = "(a1,a2,a3); b1; (b2,((c2,c3),c1),b3);", f2 = "(a1,a2,a3); b1; (b3,b2,((c2,c3),c1));",
       r = 2, r1 = "((a1,a2),(b2,b3),a3); (*,b1); ((*,c1),c2,c3);", r2 = "((a1,a2),(b2,b3),a3); (*,b1); ((*,c1),c2,c3);",
       spr = 2)
})

test_that("replug_example_2", {
  t1 <- Tree("(a1,a2,(a3,(a4,(b1,(b2,(b3,(b4,(c1,(c2,(c3,c4))))))))));")
  t2 <- Tree("(a1,a2,(a3,(a4,((((b1,(c1,(c2,(c3,c4)))),b2),b3),b4))));")
  Test(t1, t2, 2, 1 , 3,
       f1 = "((a1,a2),a3,a4); (b1,b2,(b3,b4)); (c1,(c3,c4),c2);", f2 = "((a1,a2),a3,a4); ((b4,b3),b1,b2); (c1,(c3,c4),c2);",
       r = 2, r1 = "((a1,a2),a3,a4); (*,(b2,((*,b4),b3)),b1); (c1,(c3,c4),c2);", r2 = "((a1,a2),a3,a4); (*,(b2,((*,b4),b3)),b1); (c1,(c3,c4),c2);",
       spr = 2)
})


test_that("replug_example_3", {
  t1 <- Tree("(a1,a2,(a3,(a4,(b1,(b2,(b3,(b4,(c1,(c2,(c3,c4))))))))));")
  t2 <- Tree("(a1,(a2,(a3,a4)),(((b1,b2),(b3,(c1,(c2,(c3,c4))))),b4));")
  Test(t1, t2, 2, 2 , 6,
       f1 = "((a1,a2),a3,a4); (b1,b2); (b3,(((c3,c4),c2),c1),b4);", f2 = "((a1,a2),a3,a4); (b4,(((c3,c4),c2),c1),b3); (b1,b2);",
       r = 3, r1 = "((a1,a2),a3,a4); (b1,b2,(b3,b4)); ((*,c1),(c3,c4),c2);", r2 = "((a1,a2),a3,a4); (b1,b2,(b3,b4)); ((*,c1),(c3,c4),c2);",
       spr = 3)
})

test_that("replug_example_4", {
  t1 <- Tree("(a1,a2,(a3,(a4,(b1,(b2,(b3,b4))))));")
  t2 <- Tree("(a1,(a2,(a3,a4)),(((b1,b2),b3),b4));")
  Test(t1, t2, 1, 1 , 3,
       f1 = "((a1,a2),a3,a4); (b1,b2,(b3,b4));", f2 = "((a1,a2),a3,a4); ((b4,b3),b1,b2);",
       r = 2, r1 = "((a1,a2),a3,a4); (b1,b2,(b3,b4));", r2 = "((a1,a2),a3,a4); (b1,b2,(b3,b4));",
       spr = 2)
})


test_that("trees_10_1", {
  t1 <- Tree("(1,((2,(3,4)),5),((6,7),(8,(9,10))));")
  t2 <- Tree("(1,2,(3,(4,((5,6),(7,((8,9),10))))));")
  Test(t1, t2, 3, 3 , 8,
       f1 = "(1,(3,4),2); 5; ((7,6),9,8); 10;", f2 = "(1,(3,4),2); ((7,6),9,8); 5; 10;",
       r = 4, r1 = "(*,1); (*,4); ((5,(3,2)),(9,10),7); (*,6); (*,8);", r2 = "(*,1); (*,4); ((5,(3,2)),(9,10),7); (*,6); (*,8);",
       spr = 4)
})


test_that("trees_10_2", {
  t1 <- Tree("(0,((3,((4,(5,6)),(7,8))),9),(1,2));")
  t2 <- Tree("(0,((((3,4),(5,6)),(7,(8,9))),2),1);")
  Test(t1, t2, 3, 2 , 6,
       f1 = "(0,1,2); (8,7); 9; (3,4,(5,6));", f2 = "(0,1,2); ((5,6),4,3); (7,8); 9;",
       r = 3, r1 = "(0,1,2); (*,3); (*,9); ((*,((5,6),4)),7,8);", r2 = "(0,1,2); (*,3); (*,9); ((*,((5,6),4)),7,8);",
       spr = 3)
})


test_that("trees_10_3", {
  t1 <- Tree("(1,(2,(3,4)),(5,(((6,7),8),(9,10))));")
  t2 <- Tree("(1,(2,((3,4),5)),((6,7),((8,9),10)));")
  Test(t1, t2, 2, 2 , 6,
       f1 = "((1,((3,4),2)),(6,7),(9,10)); 5; 8;", f2 = "((1,((3,4),2)),(9,10),(6,7)); 5; 8;",
       r = 2, r1 = "((1,((3,4),2)),(6,7),(9,10)); (*,5); (*,8);", r2 = "((1,((3,4),2)),(6,7),(9,10)); (*,5); (*,8);",
       spr = 2)
})


test_that("trees_10_4", {
  t1 <- Tree("(1,2,(3,((4,(5,(6,7))),((8,9),10))));")
  t2 <- Tree("(1,2,(((3,(4,5)),6),((7,(8,9)),10)));")
  Test(t1, t2, 3, 2 , 6,
       f1 = "(1,((8,9),10),2); 3; 7; (4,5,6);", f2 = "(1,((8,9),10),2); 3; 7; (6,5,4);",
       r = 3, r1 = "(1,((4,6),((8,9),10)),2); (*,3); (*,7); (*,5);", r2 = "(1,((4,6),((8,9),10)),2); (*,3); (*,7); (*,5);",
       spr = 3)
})


test_that("trees1", {
  t1 <- Tree("(0,1,(2,(3,4)));")
  t2 <- Tree("(0,1,(2,(3,4)));")
  Test(t1, t2, 0, 0 , 0,
       f1 = "((0,1),(3,4),2);", f2 = "((0,1),(3,4),2);",
       r = 0, r1 = "((0,1),(3,4),2);", r2 = "((0,1),(3,4),2);",
       spr = NA)
})


test_that("trees2", {
  t1 <- Tree("(0,1,(2,(3,4)));")
  t2 <- Tree("(0,(1,(3,4)),2);")
  Test(t1, t2, 1, 1 , 3,
       f1 = "(0,(3,4),1); 2;", f2 = "(0,(3,4),1); 2;",
       r = 1, r1 = "(0,(3,4),2); (*,1);", r2 = "(0,(3,4),2); (*,1);",
       spr = 1)
})


test_that("trees3", {
  t1 <- Tree("(0,1,(2,(3,(4,5))));")
  t2 <- Tree("(0,((1,5),(3,4)),2);")
  Test(t1, t2, 2, 1 , 3,
       f1 = "(0,2); 1; (3,4,5);", f2 = "(0,2); 1; (5,4,3);",
       r = 2, r1 = "(0,(3,5),2); (*,1); (*,4);", r2 = "(0,(3,5),2); (*,1); (*,4);",
       spr = 2)
})


test_that("trees4", {
  t1 <- Tree("(0,(1,5),(2,(3,4)));")
  t2 <- Tree("(0,1,(((5,4),3),2));")
  Test(t1, t2, 1, 1 , 3,
       f1 = "((0,1),(3,4),2); 5;", f2 = "((0,1),(3,4),2); 5;",
       r = 1, r1 = "((0,1),(3,4),2); (*,5);", r2 = "((0,1),(3,4),2); (*,5);",
       spr = 1)
})


test_that("trees5", {
  t1 <- Tree("(0,1,(2,(3,4)));")
  t2 <- Tree("(0,(1,(3,4)),2);")
  Test(t1, t2, 1, 1 , 3,
       f1 = "(0,(3,4),1); 2;", f2 = "(0,(3,4),1); 2;",
       r = 1, r1 = "(0,(3,4),2); (*,1);", r2 = "(0,(3,4),2); (*,1);",
       spr = 1)
})


test_that("trees6", {
  t1 <- Tree("(0,1,(2,(3,(4,5))));")
  t2 <- Tree("(0,(1,(3,4)),(2,5));")
  Test(t1, t2, 2, 2 , 5,
       f1 = "(0,(3,4),1); 2; 5;", f2 = "(0,(3,4),1); 5; 2;",
       r = 2, r1 = "(0,(3,4),2); (*,1); (*,5);", r2 = "(0,(3,4),2); (*,1); (*,5);",
       spr = 2)
})


test_that("trees7", {
  t1 <- Tree("(0,1,(2,(3,(4,(5,(6,7))))));")
  t2 <- Tree("(0,(1,((3,7),(4,6))),(2,5));")
  Test(t1, t2, 3, 2, 6,
       f1 = "(0,((4,6),3),1); 2; 5; 7;", f2 = "(0,((4,6),3),1); 5; 2; 7;",
       r = 3, r1 = "(0,((4,6),3),2); (*,1); (*,7); (*,5);", r2 = "(0,((4,6),3),2); (*,1); (*,7); (*,5);",
       spr = 3)
})


test_that("tricky1", {
  t1 <- Tree("(1,2,(3,((((4,5),(6,7)),(8,9)),(((((10,(11,12)),13),14),(((15,16),(17,18)),19)),20))));")
  t2 <- Tree("(1,((((2,7),3),((((10,((11,12),(17,18))),13),14),20)),((8,9),19)),(((4,5),6),(15,16)));")
  Test(t1, t2, 5, 4, 12,
       f1 = "1; (2,3,((((((11,12),10),13),14),20),((8,9),((4,5),6)))); 7; 19; (15,16); (17,18);", f2 = "1; ((((8,9),((4,5),6)),(((((11,12),10),13),14),20)),2,3); 7; 19; (15,16); (17,18);",
       r = 5, r1 = "(*,1); (2,3,((((((11,12),10),13),14),20),((8,9),((4,5),6)))); (*,7); (*,19); (*,15,16); (*,17,18);", r2 = "(*,1); (2,3,((((((11,12),10),13),14),20),((8,9),((4,5),6)))); (*,7); (*,19); (*,15,16); (*,17,18);",
       spr = 5)
})


test_that("tricky2", {
  t1 <- Tree("(1,2,(((3,4),(5,((6,7),(8,(((9,10),11),(12,(13,14))))))),(15,(16,((17,(18,19)),20)))));")
  t2 <- Tree("(1,(2,(((((((4,13),(((6,18),19),17)),16),15),20),7),(5,(((9,10),11),(12,14))))),(3,8));")
  Test(t1, t2, 7, 5, 14,
       f1 = "(((((1,2),(((12,14),((9,10),11)),5)),15),16),(18,19),17); 4; 6; 13; 8; 3; 7; 20;", f2 = "(((((1,2),(((12,14),((9,10),11)),5)),15),16),(18,19),17); 3; 4; 6; 13; 8; 7; 20;",
       r = 7, r1 = "(((((1,2),(((12,14),((9,10),11)),5)),15),16),(18,19),17); (*,4); (*,6); (*,13); (*,8); (*,3); (*,7); (*,20);", r2 = "(((((1,2),(((12,14),((9,10),11)),5)),15),16),(18,19),17); (*,4); (*,6); (*,13); (*,8); (*,3); (*,7); (*,20);",
       spr = 7)
})


# Generate tests from tests
#root <- "c:/research/r/uspr/src/uspr/test_trees/"
#ChopLeft <- function (x, n) substr(x, n + 1L, nchar(x))
#files <- list.files(root, '.test$', full.names = FALSE)
#fil <- files[length(files)]
#for (fil in files[-(1:7)]) {
#lin <- readLines(paste0(root, fil))
#testName <- substr(fil, 1, nchar(fil) - 5)
#message('test_that("', testName, '", {\n',
#        '  t1 <- Tree("', ChopLeft(lin[1], 4), '")\n',
#        '  t2 <- Tree("', ChopLeft(lin[2], 4), '")\n',
#        '  Test(t1, t2, ', ChopLeft(lin[5], 8), ', ', substr(lin[3], 8, 9),
#        ', ', ChopLeft(lin[3], nchar(lin[3]) - 2L), ',\n       f1 = "',
#        ChopLeft(lin[6], 4), '", f2 = "', ChopLeft(lin[7], 4),
#        '",\n       r = ', ChopLeft(lin[9], 6),
#        ', r1 = "', ChopLeft(lin[10], 4), '", r2 = "', ChopLeft(lin[10], 4),
#        '",\n       spr = ', ChopLeft(lin[13], 9), ')',
#        '\n})\n\n'
#)
#}
#