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' #) #} #