Merge pull request #235 from grunwaldlab/fix-234

update denominator for bitwise.ia to be int64_t

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: poppr
 Type: Package
 Title: Genetic Analysis of Populations with Mixed Reproduction
-Version: 2.8.7
+Version: 2.8.7.99-41
 Authors@R: c(person(c("Zhian", "N."), "Kamvar", role = c("cre", "aut"),
     email = "zkamvar@gmail.com", comment = c(ORCID = "0000-0003-1458-7108")),
     person(c("Javier", "F."), "Tabima", role = "aut",

NEWS.md

@@ -25,6 +25,8 @@ BUG FIX
 
 * `genind2genalex()` no longer converts diploid sequence data to zeros on export
   This fixes #231 (@zkamvar, #233).
+* `bitwise.ia()` will no longer have integer overflows early on Windows
+  (@zkamvar, #235)
 
 poppr 2.8.7
 ===========

src/bitwise_distance.c

@@ -35,6 +35,7 @@
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
 
 #include <stdio.h>
+#include <stdint.h>
 #include <Rinternals.h>
 #include <R_ext/Utils.h>
 #include <Rdefines.h>
@@ -832,8 +833,8 @@ SEXP association_index_haploid(SEXP genlight, SEXP missing, SEXP requested_threa
   double* vars; // Variance at each locus
   double* M;  // Sum of distances at each locus
   double* M2; // Sum of squared distances at each locus
-  long int D;   // Sum of distances between each sample
-  long int D2;  // Sum of squared distances between each sample
+  int64_t D;   // Sum of distances between each sample
+  int64_t D2;  // Sum of squared distances between each sample
   double Vo; // Observed variance
   double Ve; // Expected variance
   double Nc2;  // num_gens choose 2
@@ -1207,8 +1208,8 @@ SEXP association_index_diploid(SEXP genlight, SEXP missing, SEXP differences_onl
   double* vars; // Variance at each locus
   double* M;  // Sum of distances at each locus
   double* M2; // Sum of squared distances at each locus
-  long int D;   // Sum of distances between each sample
-  long int D2;  // Sum of squared distances between each sample
+  int64_t D;   // Sum of distances between each sample
+  int64_t D2;  // Sum of squared distances between each sample
   double Vo; // Observed variance
   double Ve; // Expected variance
   double Nc2;  // num_gens choose 2

tests/testthat/test-bitwise.R

@@ -27,7 +27,7 @@ test_that("bitwise.dist can do euclidean", {
 })
 
 test_that("bitwise.dist can do euclidean with lots of missing data", {
-  skip_on_cran()
+  # skip_on_cran()
   set.seed(999)
   mat2[sample(length(mat2), 10)] <- NA
   mat2.gl <- new("genlight", mat2, parallel = FALSE)
@@ -36,7 +36,7 @@ test_that("bitwise.dist can do euclidean with lots of missing data", {
 })
 
 test_that("bitwise.dist can actually handle genind objects", {
-  skip_on_cran()
+  # skip_on_cran()
   data("partial_clone", package = "poppr")
   pdist <- diss.dist(partial_clone, percent = TRUE)
   expect_equivalent(pdist, bitwise.dist(partial_clone))
@@ -45,7 +45,7 @@ test_that("bitwise.dist can actually handle genind objects", {
 
 test_that("bitwise.dist produces reasonable results for diploids", {
 
-  skip_on_cran()
+  # skip_on_cran()
   dat <- list(c(2,2,2,2,2,2,2,2,2,0),
               c(1,1,1,0,0,0,0,0,0,2),
               c(2,2,2,2,2,2,2,2,2,2),
@@ -98,7 +98,7 @@ test_that("bitwise.dist produces reasonable results for diploids", {
 })
 
 test_that("bitwise.ia produce reasonable results for haploids", {
-  skip_on_cran()
+  # skip_on_cran()
   dat <- list(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
               c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
               c(1, 1, NA, NA, NA, NA, NA, NA, NA, NA))
@@ -126,7 +126,7 @@ test_that("bitwise.ia produce reasonable results for haploids", {
 context("bitwise.ia cromulence")
 
 test_that("bitwise.ia can use both missing-match and missing-nomatch ", {
-  skip_on_cran()
+  # skip_on_cran()
   dat <- list(c(2,2,2,2,2,2,2,2,2,0),
               c(1,1,1,0,0,0,0,0,0,2),
               c(2,2,2,2,2,2,2,2,2,2),
@@ -155,4 +155,4 @@ test_that("bitwise.ia can use both missing-match and missing-nomatch ", {
            )
   res <- poppr:::ia_from_d_and_D(dlist, np)
   expect_equal(res[[2]], bitwise.ia(z, missing_match = FALSE))
-})
+})

tests/testthat/test-import.R

@@ -176,6 +176,7 @@ test_that("improperly-formatted data causes an error", {
   msg <- "^.+?6 individuals.+?5 rows.+?Please inspect "
   tcmsg  <- paste0(msg, "textConnection\\(bad_genalex\\).+?$")
   expect_error(read.genalex(textConnection(bad_genalex), sep = "\t"), tcmsg)
+  skip_on_os("windows")
   f <- tempfile()
   writeLines(bad_genalex, f)
   fmsg <- paste0(msg, f, ".+?$")
@@ -217,7 +218,7 @@ context("Data export tests")
 test_that("not specifying a file for genind2genalex will generate a tempfile", {
   skip_on_cran()
   expect_warning(f <- genind2genalex(monpop, quiet = TRUE), "temporary file")
-  expect_match(f, "^/.+?file.+\\.csv$")
+  expect_match(f, "^.+?file.+\\.csv$")
   expect_is(read.genalex(f), "genclone")
 })
 
@@ -426,6 +427,7 @@ test_that("genalex data can be imported with a region column", {
 
 test_that("genalex can import geographic information", {
 	skip_on_cran()
+  skip_on_os("windows")
 	data("Pram", package = "poppr")
 	filepram <- tempfile()
 	sourpram <- tempfile()

tests/testthat/test-values.R

@@ -338,7 +338,7 @@ test_that("pair.ia can do sampling", {
 })
 
 test_that("bitwise.ia can handle large samples", {
-  skip_on_cran()
+  # skip_on_cran()
   set.seed(999)
   x <- glSim(n.ind = 200, n.snp.nonstruc = 2e3, ploidy = 2, parallel = FALSE)
   position(x) <- sort(sample(1e4, 2e3))