Merge pull request #85 from reconhub/one-group

Allow for single group to not be ignored when plotting or creating data frames

.Rbuildignore

@@ -21,3 +21,4 @@ README.html
 ^appveyor\.yml$
 bug_reports/*
 ^revdep/
+^_pkgdown.yml$

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: incidence
 Type: Package
 Title: Compute, Handle, Plot and Model Incidence of Dated Events
-Version: 1.5.2.9000
+Version: 1.5.3
 Authors@R: c(
   person("Thibaut", "Jombart", role = c("aut"), email = "[email protected]"), 
   person("Zhian N.", "Kamvar", role = c("aut", "cre"), email = "[email protected]"),

NEWS.md

@@ -1,6 +1,17 @@
-incidence 1.5.2.9000
-===========================
+incidence 1.5.3 (2018-12-07)
+============================
+
+### BUG FIX
+
+* `plot.incidence()` will now respect single groups.
+  (See https://github.com/reconhub/incidence/issues/84)
+* `as.data.frame.incidence()` will now respect single groups.
+  (See https://github.com/reconhub/incidence/issues/84)
+
+### MISC
 
+* `demo("incidence-demo" package = "incidenc")` has been updated to show use of
+  custom colors.
 
 incidence 1.5.2 (2018-11-30)
 ============================

R/conversion.R

@@ -59,8 +59,10 @@
 #'
 
 as.data.frame.incidence <- function(x, ..., long = FALSE){
-    counts <- x$counts
-    if (ncol(counts) == 1L) {
+    counts  <- x$counts
+    gnames  <- group_names(x)
+    unnamed <- is.null(gnames) && ncol(counts) == 1L
+    if (unnamed) {
         colnames(counts) <- "counts"
     }
 
@@ -73,8 +75,7 @@ as.data.frame.incidence <- function(x, ..., long = FALSE){
     }
 
     ## handle the long format here
-    if (long && ncol(x$counts) > 1) {
-        gnames <- colnames(x$counts)
+    if (long && !unnamed) {
         groups <- factor(rep(gnames, each = nrow(out)), levels = gnames)
         counts <- as.vector(x$counts)
         if ("isoweeks" %in% names(x)) {

R/plot.R

@@ -104,6 +104,7 @@ plot.incidence <- function(x, ..., fit = NULL, stack = is.null(fit),
   ## extract data in suitable format for ggplot2
   df <- as.data.frame(x, long = TRUE)
   n.groups <- ncol(x$counts)
+  gnames   <- group_names(x)
 
   ## Use custom labels for usual time intervals
   if (is.null(ylab)) {
@@ -225,12 +226,31 @@ plot.incidence <- function(x, ..., fit = NULL, stack = is.null(fit),
   ## by default, the palette is used, but the user can manually specify the
   ## colors.
 
-  if (ncol(x$counts) < 2) {
+  if (n.groups < 2 && is.null(gnames)) {
     out <- out + ggplot2::aes(fill = 'a') +
       ggplot2::scale_fill_manual(values = color, guide = FALSE)
   } else {
+    if (!is.null(names(color))) {
+      tmp     <- color[gnames] 
+      matched <- names(color) %in% names(tmp)
+      if (!all(matched)) {
+        removed <- paste(names(color)[!matched], 
+                         color[!matched],
+                         sep = '" = "',
+                         collapse = '", "')
+        message(sprintf("%d colors were not used: \"%s\"", sum(!matched), removed))
+      }
+      color <- tmp
+    }
+
     ## find group colors
-    if (length(color) != ncol(x$counts)) {
+    if (length(color) != n.groups) {
+      msg <- "The number of colors (%d) did not match the number of groups (%d)"
+      msg <- paste0(msg, ".\nUsing `col_pal` instead.")
+      default_color <- length(color) == 1L && color == "black"
+      if (!default_color) {
+        message(sprintf(msg, length(color), n.groups))
+      }
       group.colors <- col_pal(n.groups)
     } else {
       group.colors <- color

R/print.R

@@ -9,7 +9,7 @@ print.incidence <- function(x, ...) {
     cat(sprintf("[%d cases from ISO weeks %s to %s]\n",
                 sum(x$n), head(x$isoweeks, 1), tail(x$isoweeks, 1)))
   }
-  if (ncol(x$counts) > 1L) {
+  if (!is.null(group_names(x))) {
     groups.txt <- paste(group_names(x), collapse = ", ")
     cat(sprintf("[%d groups: %s]\n", ncol(x), groups.txt))
   }

demo/incidence-demo.R

@@ -16,31 +16,31 @@ library('incidence')
 library('ggplot2')
 
 # compute weekly stratified incidence
-i.7.group <- incidence(dat1$date_of_onset,
-                       interval = 7L,
-                       groups   = dat1$hospital)
+i.7.group <- incidence(dat1$date_of_onset, interval = 7, groups = dat1$hospital)
 # print incidence object
 i.7.group
 
 # plot incidence object
 my_theme <- theme_bw(base_size = 12) +
-  theme(legend.position = c(.8, .7)) +
   theme(panel.grid.minor = element_blank()) +
-  theme(axis.text = element_text(color = "black"))
-plot(i.7.group, border = "white") + my_theme
+  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5, color = "black"))
+
+plot(i.7.group, border = "white") + 
+  my_theme + 
+  theme(legend.position = c(0.8, 0.75))
 
 #' 3) Manipulate incidence object
 #'
-#+ incidence-early-curve, fig.width=6, fig.height=7
-# plot the first 8 weeks
-plot(i.7.group[1:8, ], show_cases = TRUE) +
-  theme_bw(base_size = 12) +
-  theme(axis.text.x = element_text(angle = 90, hjust = 1, color = "black")) +
-  theme(panel.grid.minor = element_blank())
-
+#+ incidence-early-curve, fig.width=6, fig.height=6
+# plot the first 18 weeks, defined hospitals, and use different colors
+i.7.sub <- i.7.group[1:18, c(1:2, 4:5)]
+hosp_colors <- c("#899DA4", "#C93312", "#FAEFD1", "#DC863B")
+plot(i.7.sub, show_cases = TRUE, border = "black", color = hosp_colors) + 
+  my_theme +
+  theme(legend.position = c(0.35, 0.8)) 
 # exclude NA group by disabling treating NA as a separate group
 i.7.group0 <- incidence(dat1$date_of_onset,
-                        interval    = 7L,
+                        interval    = 7,
                         groups      = dat1$hospital,
                         na_as_group = FALSE)
 
@@ -63,7 +63,7 @@ colnames(i.7.group1$counts)
 #'
 #' 1) Import pre-computed daily incidence
 #'
-#+ incidence-curve2, fig.width=9, fig.height=5
+#+ incidence-curve2, fig.width=9, fig.height=6
 # preview datasets
 head(zika_girardot_2015, 3)
 head(zika_sanandres_2015, 3)
@@ -84,7 +84,7 @@ i.group <- as.incidence(x = dat2[, 2:3], dates = dat2$date)
 # pool incidence across two locations
 i.pooled <- pool(i.group)
 cowplot::plot_grid(
-	plot(i.group, border = "white")  + my_theme,
+	plot(i.group, border = "white")  + my_theme + theme(legend.position = c(0.9, 0.7)),
 	plot(i.pooled, border = "white") + my_theme,
 	ncol       = 1,
 	labels     = c("(A)", "(B)"),