Merge pull request #54 from EvolEcolGroup/yml_order

.yml organisation

R/gen_tibble_vcf.R

@@ -5,11 +5,16 @@ gen_tibble_vcf <- function(x, ..., parser = "cpp",
                            missing_alleles = c("0","."),
                            backingfile = NULL, quiet = FALSE) {
   parser <- match.arg(parser, c("vcfR", "cpp"))
+
+  if(.Platform$OS.type=="windows"){
+    parser == "vcfR"
+  }
+
   if (parser == "cpp"){
-    rds_path <- vcf_to_fbm_cpp(x,
-                                backingfile = backingfile,
-                                chunk_size = chunk_size,
-                                quiet = quiet)
+      rds_path <- vcf_to_fbm_cpp(x,
+                                 backingfile = backingfile,
+                                 chunk_size = chunk_size,
+                                 quiet = quiet)
   } else {
     rds_path <- vcf_to_fbm_vcfR(x,
                                 backingfile = backingfile,

_pkgdown.yml

@@ -35,10 +35,6 @@ reference:
     desc: "Functions operating across loci."
     contents:
         - starts_with("loci_")
-  - title: "Individual"
-    desc: "Functions operating across individuals."
-    contents:
-        - starts_with("indiv_")
   - title: "Merging"
     desc: "Functions for merging gen_tibble objects."
     contents:
@@ -52,6 +48,10 @@ reference:
         - gt_has_imputed
         - gt_uses_imputed
         - gt_set_imputed
+  - title: "Individual"
+    desc: "Functions operating across individuals."
+    contents:
+        - starts_with("indiv_")
   - title: "Population"
     desc: "Functions operating on a gen_tibble grouped by population."
     contents:
@@ -97,19 +97,16 @@ reference:
         - tidy.q_matrix
         - augment.q_matrix
         - autoplot.q_matrix
+        - distruct_colours
+        - scale_fill_distruct
+        - theme_distruct
   - title: "Other analyses"
     desc: "Functions for other analyses within R."
     contents:
         - gt_extract_f2
         - gt_roh_window
         - gt_pcadapt
         - autoplot.gt_pcadapt
-  - title: "Plotting"
-    desc: "Functions for plotting with distruct."
-    contents:
-        - distruct_colours
-        - scale_fill_distruct
-        - theme_distruct
   - title: "bigSNP"
     desc: "Functions for operating directly on a bigSNp object."
     contents:

data-raw/gt_as_vcf.R

@@ -81,9 +81,3 @@ gt_as_vcf <- function(x, file = NULL, chunk_size = NULL, overwrite = TRUE){
   }
 
 }
-
-# TODO for tests
-# read pop_a_vcf
-# rewrite it as a vcf
-# re-read it and check that we got back what we started with
-

tests/testthat/test_gen_tibble.R

@@ -194,7 +194,6 @@ test_that("gen_tibble from files",{
   expect_true(all.equal(show_genotypes(pop_a_vcf_gt2),show_genotypes(pop_a_vcf_gt)))
   expect_true(all.equal(show_loci(pop_a_vcf_gt2),show_loci(pop_a_vcf_gt)))
   expect_true(is.integer(show_loci(pop_a_vcf_gt)$chr_int))
-  # @TODO we should add similar tests for pop b, which has missing data
 
   # check our cpp parser
   pop_a_vcf_fast_gt <- gen_tibble(vcf_path, quiet=TRUE,backingfile = tempfile(), parser="cpp")
@@ -243,7 +242,19 @@ test_that("gen_tibble from files with missingness",{
                               chunk_size = 2)
   expect_true(all.equal(show_genotypes(pop_b_vcf_gt2),show_genotypes(pop_b_vcf_gt)))
   expect_true(all.equal(show_loci(pop_b_vcf_gt2),show_loci(pop_b_vcf_gt)))
+  expect_true(is.integer(show_loci(pop_b_vcf_gt2)$chr_int))
 
+  # check our cpp parser
+  pop_b_vcf_fast_gt <- gen_tibble(vcf_path, quiet=TRUE,backingfile = tempfile(), parser="cpp")
+  expect_true(all.equal(show_genotypes(pop_b_gt),show_genotypes(pop_b_vcf_fast_gt)))
+  # check loci table against the vcfR parser
+  expect_true(all.equal(show_loci(pop_b_vcf_gt), show_loci(pop_b_vcf_fast_gt)))
+  # reload it in chunks
+  pop_b_vcf_fast_gt2 <- gen_tibble(vcf_path, quiet=TRUE, backingfile = tempfile(),
+                                   chunk_size = 2, parser="cpp")
+  expect_true(all.equal(show_genotypes(pop_b_vcf_fast_gt2),show_genotypes(pop_b_vcf_fast_gt)))
+  expect_true(all.equal(show_loci(pop_b_vcf_gt), show_loci(pop_b_vcf_fast_gt)))
+  expect_true(is.integer(show_loci(pop_b_vcf_fast_gt)$chr_int))
 })
 
 test_that("gentibble with packedancestry",{

tests/testthat/test_gt_as_vcf.R

@@ -29,3 +29,17 @@ test_that("test we can write and read a vcf",{
   #check gt_as_plink converts the NA missing allele to 0
   expect_true(is.na(show_loci(test_gt2)$allele_alt[3]))
 })
+
+test_that("test reading and writing is equivalent",{
+  # read in .vcf
+  vcf_path <- system.file("extdata/pop_a.vcf", package = "tidypopgen")
+  pop_a_vcf <- gen_tibble(vcf_path, quiet=TRUE,backingfile = tempfile(), parser="vcfR")
+  # write it out again
+  file <- paste0(tempfile(),".vcf")
+  write_vcf_path <- gt_as_vcf(pop_a_vcf, file = file)
+  # reread
+  pop_a_vcf_rewrite <- gen_tibble(write_vcf_path, quiet=TRUE,backingfile = tempfile(), parser="vcfR")
+  # because of the different backing file info, we cannot use identical on the whole object
+  expect_true(identical(show_genotypes(pop_a_vcf), show_genotypes(pop_a_vcf_rewrite)))
+  expect_true(identical(show_loci(pop_a_vcf), show_loci(pop_a_vcf_rewrite)))
+})