1# This needs to be less than 1, to distinguish it from "regular" return values
2# of plyr::id() used by add_group()
3NO_GROUP <- -1L
4
5# Ensure that the data frame contains a grouping variable.
6#
7# If the `group` variable is not present, then a new group
8# variable is generated from the interaction of all discrete (factor or
9# character) vectors, excluding `label`. The special value `NO_GROUP`
10# is used for all observations if no discrete variables exist.
11add_group <- function(data) {
12  if (empty(data)) return(data)
13
14  if (is.null(data[["group"]])) {
15    disc <- vapply(data, is.discrete, logical(1))
16    disc[names(disc) %in% c("label", "PANEL")] <- FALSE
17
18    if (any(disc)) {
19      data$group <- id(data[disc], drop = TRUE)
20    } else {
21      data$group <- NO_GROUP
22      attr(data$group, "n") <- 1L
23    }
24  } else {
25    data$group <- id(data["group"], drop = TRUE)
26  }
27
28  data
29}
30
31# Is a grouping available?
32# (Will return TRUE if an explicit group or a discrete variable with only one
33# level existed when add_group() was called.)
34has_groups <- function(data) {
35  # If no group aesthetic is specified, all values of the group column equal to
36  # NO_GROUP. On the other hand, if a group aesthetic is specified, all values
37  # are different from NO_GROUP (since they are a result of plyr::id()). NA is
38  # returned for 0-row data frames.
39  data$group[1L] != NO_GROUP
40}
41