tests/testthat/test-utility_func.R

In mappoly: Genetic Linkage Maps in Autopolyploids

context("Utility functions")
test_that("test several utility functions", {
  x1<-plot_mrk_info(tetra.solcap, 1)
  x2<-plot_mrk_info(tetra.solcap, "solcap_snp_c2_41437")
  x3<-plot_mrk_info(tetra.solcap.geno.dist, 1)
  x4<-plot_mrk_info(tetra.solcap.geno.dist, "solcap_snp_c2_41437")
  expect_is(x1, "list")
  expect_is(x2, "list")
  expect_is(x3, "list")
  expect_is(x4, "list")
  expect_equal(get_LOD(solcap.err.map[[1]]),0)
  tpt<-est_pairwise_rf(make_seq_mappoly(tetra.solcap, 1:30))
  x1<-make_seq_mappoly(tetra.solcap, 1:20)
  x2<-make_seq_mappoly(tetra.solcap, 21:40)
  x1<-as.numeric(check_if_rf_is_possible(x1))
  x2<-as.numeric(check_if_rf_is_possible(x2))
  expect_equal(as.numeric(crossprod(x1,x2)), 14)
  M<-rf_list_to_matrix(tpt, shared.alleles = TRUE)
  expect_equal(round(sum(get_rf_from_mat(M$rec.mat), na.rm = TRUE), 6), 3.913633)
  expect_equal(get_w_m(6), 15)
  expect_error(get_w_m(0))
  expect_error(get_w_m(3))
  rm<-rev_map(maps.hexafake[[1]])
  expect_equal(sum(rm$maps[[1]]$seq.rf), sum(maps.hexafake[[1]]$maps[[1]]$seq.rf), tolerance = 10e-5)
  a1<-sample_data(tetra.solcap.geno.dist, n = 20, type = "marker")
  a2<-sample_data(a1, n = 20, type = "individual")
  plot(a2)
  a3<-dist_prob_to_class(a2$geno)
  expect_equal(prod(dim(a3$geno.dose)), nrow(a3$geno))
  #w1<-export_data_to_polymapR(hexafake)
  #expect_equal(dim(w1) , c(1500, 302))
  #expect_equal(sum(w1), 461530)
  #w2<-export_data_to_polymapR(tetra.solcap)
  #expect_equal(dim(w2) , c(3679, 162))
  #expect_equal(sum(w2, na.rm = TRUE), 1058080)
  expect_equal(round(mf_h(20),6), 0.16484)
  expect_equal(round(mf_k(20),6), 0.189974)
  expect_equal(round(mf_m(20),6), 0.2)
  expect_equal(round(imf_h(.15),2), 17.83)
  expect_equal(round(imf_k(.15),2), 15.48)
  expect_equal(round(imf_m(.15),2), 15)
  expect_null(plot_compare_haplotypes(ploidy = 6, 
                          hom.allele.p1 = maps.hexafake[[1]]$maps[[1]]$seq.ph$P[1:10],
                          hom.allele.q1 = maps.hexafake[[1]]$maps[[1]]$seq.ph$Q[1:10],
                          hom.allele.p2 = maps.hexafake[[1]]$maps[[1]]$seq.ph$P[1:10],
                          hom.allele.q2 = maps.hexafake[[1]]$maps[[1]]$seq.ph$Q[1:10]))
  a <- print_mrk(input.data = hexafake, mrks = "M_1")
  expect_true(is.list(a))
  expect_equal(sum(unlist(a)), expected = 304)
  expect_equal(sum(perm_pars(1:5)), 900)
  expect_equal(sum(perm_tot(1:5)), 1800)
  a<-sample_data(tetra.solcap.geno.dist, n=30, type = "marker")
  a<-sample_data(a, n=30)
  w<-update_missing(a, prob.thres = .7)
  expect_is(w, "mappoly.data")
  w2 <- get_genomic_order(make_seq_mappoly(hexafake, "all"))
  w3 <- as.numeric(crossprod(w2$ord$seq.pos)/10e17)
  expect_is(plot(w2), "ggplot")
  expect_equal(w3, 0.4952, tolerance = 1e-3)
  ##test drop
  w4<-get_submap(solcap.dose.map[[1]], 1:10, reestimate.rf = FALSE)
  s4<-make_seq_mappoly(w4)
  tpt2<-est_pairwise_rf(s4)
  M2<-rf_list_to_matrix(tpt2, shared.alleles = TRUE)
  a1 <- drop_marker(w4, 5)
  a2 <- drop_marker(w4, "solcap_snp_c1_10930")
  expect_equal(a1,a2, tolerance = 1e-3)
  ##test add
  a3 <- drop_marker(w4, 1)
  a4 <- add_marker(a3, "solcap_snp_c2_51460", 0, M2, verbose = FALSE)
  w4<-reest_rf(w4, tol = 10e-5)
  a4<-reest_rf(a4, tol = 10e-5)
  expect_equal(w4, a4, tolerance = 1e-3)
  a3 <- drop_marker(w4, 5)
  a4 <- add_marker(a3, "solcap_snp_c1_10930", 4, M2, verbose = FALSE)
  w4<-reest_rf(w4, tol = 10e-5)
  a4<-reest_rf(a4, tol = 10e-5)
  expect_equal(w4, a4, tolerance = 1e-3)
  a3 <- drop_marker(w4, 10)
  a4 <- add_marker(a3, "solcap_snp_c2_36643", 9, M2, verbose = FALSE)
  w4<-reest_rf(w4, tol = 10e-5)
  a4<-reest_rf(a4, tol = 10e-5)
  expect_equal(w4, a4, tolerance = 1e-3)
  ##merge data
  b<-merge_datasets(hexafake, hexafake.geno.dist)
  expect_equivalent(mean(as.matrix(b$geno.dose)), 1.078817, tol = 1e-3)
  ##update map
  map<-update_map(solcap.dose.map[[1]])
  expect_equal(length(map$maps[[1]]$seq.num) - length(solcap.dose.map[[1]]$maps[[1]]$seq.num), 20)
})