diff --git a/DESCRIPTION b/DESCRIPTION index 08129b89..295e7f4e 100644 --- a/DESCRIPTION +++ b/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", diff --git a/NEWS b/NEWS index 0e4987e6..875d7af9 100644 --- a/NEWS +++ b/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 =========== diff --git a/R/file_handling.r b/R/file_handling.r index 6aff1359..c2e4d4e9 100644 --- a/R/file_handling.r +++ b/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] diff --git a/README.md b/README.md index 4dec472e..d56669a2 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,8 @@ # Poppr version 2 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) diff --git a/tests/testthat/test-import.R b/tests/testthat/test-import.R index a02bd952..11c9a2e4 100644 --- a/tests/testthat/test-import.R +++ b/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) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R index ada1e920..ce80b609 100644 --- a/tests/testthat/test-plots.R +++ b/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) -}) \ No newline at end of file +})