Merge pull request #79 from reconhub/fix-initial-levels

Maintain user-defined levels and column order for import/export/plotting

NEWS.md

@@ -1,6 +1,12 @@
 incidence 1.5.0.99
 ===========================
 
+### BUG FIX
+
+* Two bugs regarding the ordering of groups when the user specifies a factor/
+  column order have been fixed. This affects `plot.incidence()`, `incidence()`,
+  and `as.data.frame.incidence()` For details, see
+  https://github.com/reconhub/incidence/issues/79
 
 incidence 1.5.0 (2018-11-01)
 ============================

R/check_groups.R

@@ -15,9 +15,12 @@ check_groups <- function(x, dates, na_as_group){
   if (is.null(x)) {
     return(NULL)
   }
-  if (na_as_group) {
+  x   <- factor(x)
+  lev <- levels(x)
+  if (na_as_group && any(is.na(x))) {
     x <- as.character(x)
     x[is.na(x)] <- "NA"
+    lev <- c(lev, "NA")
   }
   if (length(x) != length(dates)) {
     stop(sprintf(
@@ -27,5 +30,5 @@ check_groups <- function(x, dates, na_as_group){
                  )
         )
   }
-  factor(x)
+  factor(x, levels = lev)
 }

R/conversion.R

@@ -74,7 +74,8 @@ as.data.frame.incidence <- function(x, ..., long = FALSE){
 
     ## handle the long format here
     if (long && ncol(x$counts) > 1) {
-        groups <- factor(rep(colnames(x$counts), each = nrow(out)))
+        gnames <- colnames(x$counts)
+        groups <- factor(rep(gnames, each = nrow(out)), levels = gnames)
         counts <- as.vector(x$counts)
         if ("isoweeks" %in% names(x)) {
           out <- data.frame(dates = out$dates,

tests/testthat/test-incidence.R

@@ -304,6 +304,15 @@ test_that("Expected values, with groups", {
   expect_equal_to_reference(res.g.3, file = "rds/res.g.3.rds")
 })
 
+test_that("user-defined group levels are preserved", {
+  g <- sample(LETTERS[1:5], 100, replace = TRUE)
+  g <- factor(g, levels = LETTERS[5:1])
+  i <- incidence(rpois(100, 10), groups = g)
+  expect_identical(group_names(i), levels(g))
+  i.df <- as.data.frame(i, long = TRUE) 
+  expect_identical(levels(i.df$groups), levels(g))
+})
+
 test_that("Printing returns the object", {