Initial support for alliterative adjective animals

Fixes #5

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ids
 Title: Generate Random Identifiers
-Version: 1.0.1
+Version: 1.1.0
 Authors@R: person("Rich", "FitzJohn", role = c("aut", "cre"),
     email = "rich.fitzjohn@gmail.com")
 Description: Generate random or human readable and pronounceable identifiers.

NEWS.md

@@ -1,6 +1,10 @@
-# ids 1.1.0 (2017-05-22)
+# ids 1.1.0 (unreleased)
 
-* Fix occasionally failing text (removes one animal from the pool)
+* The `adjective_animal` generator now supports alliterative adjective animals (such as `convectional_conflictory_cod`), though this reduces the pool size (#5, requested by @gadenbuie).
+
+# ids 1.0.1 (2017-05-22)
+
+* Fix occasionally failing test (removes one animal from the pool)
 * New identifier type "proquint"
 
 # ids 1.0.0 (2016-11-03)

R/adjective_animal.R

@@ -15,6 +15,12 @@
 #'   first element will apply to the adjectives (all of them) and the
 #'   second element will apply to the animals.
 #'
+#' @param alliterate Produce "alliterative" adjective animals (e.g.,
+#'   \code{hessian_hampster}).  Note that this cannot provide an equal
+#'   probability of any particuilar combination because it forces a
+#'   weighted sampling.  Adjectives may also be repeated if
+#'   \code{n_adjectives} is more than 1.
+#'
 #' @inheritParams ids
 #' @export
 #' @author Rich FitzJohn
@@ -48,8 +54,11 @@
 #' id <- adjective_animal(NULL, n_adjectives = 2, style = "dot", max_len = 6)
 #' id()
 #' id(10)
+#'
+#' # Alliterated adjective animals aid awesomeness
+#' adjective_animal(10, n_adjectives = 3, alliterate = TRUE)
 adjective_animal <- function(n = 1, n_adjectives = 1, style = "snake",
-                             max_len = Inf) {
+                             max_len = Inf, alliterate = FALSE) {
   if (any(is.finite(max_len))) {
     if (any(max_len < 3)) {
       stop("max_len must be at least 3")
@@ -64,5 +73,50 @@ adjective_animal <- function(n = 1, n_adjectives = 1, style = "snake",
     gfycat_animals <- gfycat_animals[nchar(gfycat_animals) <= max_len[2]]
   }
   vals <- c(rep(list(gfycat_adjectives), n_adjectives), list(gfycat_animals))
-  ids(n, vals = vals, style = style)
+  if (alliterate) {
+    aa_alliterate(n, vals, style)
+  } else {
+    vals <- c(rep(list(gfycat_adjectives), n_adjectives), list(gfycat_animals))
+    ids(n, vals = vals, style = style)
+  }
+}
+
+
+## We can generate alliterative ids by either rejection sampling
+## (which will be hard with multiple adjectives) or by doing a
+## weighted sample of letters and then working with each letter
+## separately.  Do do this properly we should compute the number of
+## distinct combinations and avoid duplications but that seems
+## excessive for this and is only an issue if the number of adjectives
+## is greater than one.
+aa_alliterate <- function(n, vals, style) {
+  m <- lapply(vals, function(x) split(x, factor(substr(x, 1, 1), letters)))
+  m <- matrix(unlist(m, FALSE, FALSE), 26, length(vals),
+              dimnames = list(letters, NULL))
+
+  p <- rowSums(log(lengths(m)))
+  p <- exp(p - max(p))
+  p <- p / sum(p)
+
+  gen1 <- function(start, n) {
+    ids(n, vals = m[start, , drop = TRUE], style = style)
+  }
+
+  gen <- function(n) {
+    start <- letters[sample.int(26, n, prob = p, replace = TRUE)]
+    ret <- character(n)
+    for (i in unique(start)) {
+      j <- start == i
+      ret[j] <- gen1(i, sum(j))
+    }
+    ret
+  }
+
+  if (is.null(n)) {
+    function(n = 1) {
+      gen(n)
+    }
+  } else {
+    gen(n)
+  }
 }

tests/testthat/test-adjective-animal.R

@@ -63,3 +63,19 @@ test_that("functional interface", {
   x <- f(100)
   expect_true(all(grepl(re, x)))
 })
+
+
+test_that("alliterate", {
+  res <- adjective_animal(10, alliterate = TRUE)
+  res <- strsplit(res, "_", fixed = TRUE)
+  m <- vapply(res, substr, character(2), 1, 1)
+  expect_equal(m[1, ], m[2, ])
+})
+
+
+test_that("alliterate: functional", {
+  res <- adjective_animal(NULL, n_adjective = 4, alliterate = TRUE)
+  expect_is(res, "function")
+  s <- strsplit(res(1), "_", fixed = TRUE)[[1]]
+  expect_equal(length(unique(substr(s, 1, 1))), 1)
+})