Fix readgenalex numeric inds

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: poppr
 Type: Package
 Title: Genetic Analysis of Populations with Mixed Reproduction
-Version: 2.8.2
-Date: 2019-03-10
+Version: 2.8.2.99-3
+Date: 2019-04-29
 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

@@ -1,3 +1,14 @@
+poppr 2.8.2.99
+===========
+
+BUG FIX
+=======
+
+* `read.genalex()` now correctly parses strata when the user imports data that
+  contains duplicated data AND has some individuals named as integers less than
+  the number of samples in the data (prepended by zeroes) 
+  (See https://github.com/grunwaldlab/poppr/pull/202).
+
 poppr 2.8.2
 ===========
 

R/file_handling.r

@@ -426,13 +426,14 @@ read.genalex <- function(genalex, ploidy = 2, geo = FALSE, region = FALSE,
   res.gid@call <- gencall
   # Checking for individual name duplications or removals -------------------
 
-  same_names <- any(indNames(res.gid) %in% ind.vec)
-  if (same_names){ # no duplications, only removals
+  same_names <- intersect(indNames(res.gid), ind.vec)
+  if (setequal(same_names, indNames(res.gid))) { # no duplications, only removals
     names(ind.vec) <- ind.vec
     ind.vec        <- ind.vec[indNames(res.gid)]
   } else {         # removals and/or duplciations
     ind.vec <- ind.vec[as.integer(indNames(res.gid))]
     other(res.gid)$original_names <- ind.vec
+    ind.vec <- as.integer(indNames(res.gid))
   }
   pop.vec <- pop.vec %null% pop.vec[ind.vec]
   reg.vec <- reg.vec %null% reg.vec[ind.vec]

README.md

@@ -1,8 +1,8 @@
 # Poppr version 2 <img src="man/figures/small_logo.png" align="right"/>
 
 In Development:
-[![Build Status](https://travis-ci.org/grunwaldlab/poppr.svg?branch=master)](https://travis-ci.org/grunwaldlab/poppr)
-[![Coverage Status](https://coveralls.io/repos/grunwaldlab/poppr/badge.svg?branch=master)](https://coveralls.io/r/grunwaldlab/poppr?branch=master)
+[![Build Status](https://travis-ci.org/grunwaldlab/poppr.svg?branch=fix-readgenalex-numeric-inds)](https://travis-ci.org/grunwaldlab/poppr)
+[![Coverage Status](https://coveralls.io/repos/grunwaldlab/poppr/badge.svg?branch=fix-readgenalex-numeric-inds)](https://coveralls.io/r/grunwaldlab/poppr?branch=fix-readgenalex-numeric-inds)
 
 CRAN Status:
 [![CRAN version](http://www.r-pkg.org/badges/version-ago/poppr)](https://cran.r-project.org/package=poppr)

tests/testthat/test-import.R

@@ -14,6 +14,16 @@ A009	7_09_BB	224	97	159	160	133	156	126	119	147	227	261	134	149
 A006	7_09_BB	224	97	159	160	133	156	126	119	147	235	261	134	149
 A013	7_09_BB	224	97	163	160	133	156	126	119	147	235	257	134	149"
 
+yd <- "13	6	1	6											
+			7_09_BB											
+Ind	Pop	CHMFc4	CHMFc5	CHMFc12	SEA	SED	SEE	SEG	SEI	SEL	SEN	SEP	SEQ	SER
+4	7_09_BB	224	85	163	132	133	156	144	116	143	227	257	142	145
+2	7_09_BB	224	97	159	156	129	156	144	113	143	231	261	136	153
+2	7_09_BB	224	97	159	160	133	156	126	119	147	227	257	134	149
+9	7_09_BB	224	97	159	160	133	156	126	119	147	227	261	134	149
+6	7_09_BB	224	97	159	160	133	156	126	119	147	235	261	134	149
+3	7_09_BB	224	97	163	160	133	156	126	119	147	235	257	134	149"
+
 zz <- "1	6	1	6
 7_09_BB			
 Ind	Pop	CHMFc4	CHMFc5
@@ -24,6 +34,7 @@ A009	7_09_BB	224	97
 A006	7_09_BB	224	97
 A013	7_09_BB	224	97"
 
+
 zzna <- "13	6	1	6											
 			7_09_BB											
 Ind	Pop	CHMFc4	CHMFc5	CHMFc12	SEA	SED	SEE	SEG	SEI	SEL	SEN	SEP	SEQ	SER
@@ -86,6 +97,16 @@ test_that("basic text connections work", {
 	expect_equivalent(tab(gen), tab(monpop[1:6, drop = TRUE]))
 })
 
+test_that("names are corrected properly", {
+	expect_warning(gen <- read.genalex(textConnection(yd), sep = "\t"),
+                 "duplicate labels detected")
+  expect_false(anyNA(strata(gen)))
+  expect_named(other(gen), "original_names")
+  expect_identical(indNames(gen), as.character(1:6))
+  indNames(gen) <- sprintf("A%03d", c(4, 2, 11, 9, 6, 13))
+	expect_equivalent(tab(gen), tab(monpop[1:6, drop = TRUE]))
+})
+
 test_that("missing rows and columns are eliminated", {
   gen <- read.genalex(textConnection(zzna), sep = "\t")
   expect_true(any(is.na(tab(gen))))
@@ -387,4 +408,4 @@ test_that("genalex can import geographic information", {
 	expect_equivalent(other(stay)$xy[1:513, ], other(Pram)$xy)
 	expect_equivalent(other(cust)$xy[1:513, ], other(Pram)$xy)
 
-})
+})

tests/testthat/test-plots.R

@@ -93,8 +93,8 @@ test_that("mlg.table will plot color plot without total", {
 test_that("mlg.table will utilize old versions of dplyr", {
   skip_on_cran()
   options(poppr.old.dplyr = TRUE)
-  expect_silent(x <- mlg.table(Pinf, background = TRUE))
-  expect_silent(x <- mlg.table(Pinf))
+  expect_error(x <- mlg.table(Pinf, background = TRUE), NA)
+  expect_error(x <- mlg.table(Pinf), NA)
   options(poppr.old.dplyr = FALSE)
 })
 
@@ -298,4 +298,4 @@ test_that("greycurve produces plots", {
 	expect_output(greycurve(), NA)
 	expect_output(greycurve(scalebar = TRUE), NA)
 	expect_output(greycurve(1:100), NA)
-})
+})