Generates SSN numbers (#129)

DESCRIPTION

@@ -154,6 +154,8 @@ Collate:
     'phonenumbers-provider.R'
     'sequence-provider.R'
     'sequences.R'
+    'ssn-provider.R'
+    'ssn.R'
     'taxonomy-provider.R'
     'taxonomy.R'
     'useragent-provider.R'

NAMESPACE

@@ -20,6 +20,7 @@ export(MissingDataProvider)
 export(NumericsProvider)
 export(PersonProvider)
 export(PhoneNumberProvider)
+export(SSNProvider)
 export(SequenceProvider)
 export(TaxonomyProvider)
 export(UserAgentProvider)
@@ -52,6 +53,7 @@ export(ch_rgb_color)
 export(ch_rgb_css_color)
 export(ch_safe_color_name)
 export(ch_safe_hex_color)
+export(ch_ssn)
 export(ch_taxonomic_epithet)
 export(ch_taxonomic_genus)
 export(ch_taxonomic_species)

R/ssn-provider.R

@@ -0,0 +1,62 @@
+#' @title SSNProvider
+#' @description methods for generating social security numbers
+#' @export
+#' @keywords internal
+#' @examples
+#' z <- SSNProvider$new()
+#' z$render()
+#'
+SSNProvider <- R6::R6Class(
+  inherit = BaseProvider,
+  'SSNProvider',
+  public = list(
+    #' @field locale (character) the locale
+    locale = NULL,
+
+    #' @description fetch the allowed locales for this provider
+    allowed_locales = function() private$locales,
+
+    #' @description Create a new `SSNProvider` object
+    #' @param locale (character) the locale to use. See
+    #' `$allowed_locales()` for locales supported (default: en_US)
+    #' @return A new `SSNProvider` object
+    initialize = function(locale = NULL) {
+      if (!is.null(locale)) {
+        # check locale globally supported
+        super$check_locale(locale)
+        # check job provider locales
+        check_locale_(locale, private$locales)
+        self$locale <- locale
+      } else {
+        self$locale <- 'en_US'
+      }
+
+    },
+
+    #' @description Make a SSN
+    render = function() {
+
+      # Adapted from https://github.com/joke2k/faker/blob/e14abc47e5f1ea7ce62f068c4aac6b9f51db6f5c/faker/providers/ssn/en_US/__init__.py#L219-L231
+
+      # Certain numbers are invalid for United States Social Security
+      # Numbers. The area (first 3 digits) cannot be 666 or 900-999.
+      # The group number (middle digits) cannot be 00. The serial
+      # (last 4 digits) cannot be 0000.
+
+      area <- sample.int(898, 1)
+      group <- sample.int(99, 1)
+      serial <- sample.int(9999, 1)
+
+      if(area >= 666) area <- area + 1
+
+      sprintf("%03d-%02d-%04d", area, group, serial)
+
+    }
+  ),
+
+  private = list(
+    locales = c(
+      "en_US" # TODO
+    )
+  )
+)

R/ssn.R

@@ -0,0 +1,20 @@
+#' Create fake Social Security Numbers
+#'
+#' @export
+#' @template params
+#' @param locale (character) the locale to use. See
+#' `SSNProvider$new()$allowed_locales()` for locales
+#' supported (default: en_US)
+#' @seealso [SSNProvider]
+#' @examples
+#' ch_ssn()
+#' ch_ssn(10)
+ch_ssn <- function(n = 1, locale = NULL) {
+  assert(n, c('integer', 'numeric'))
+  if (n == 1) {
+    SSNProvider$new(locale = locale)$render()
+  } else {
+    x <- SSNProvider$new(locale = locale)
+    replicate(n, x$render())
+  }
+}

tests/testthat/test-ssn.R

@@ -0,0 +1,24 @@
+context("SSNProvider works")
+
+test_that("SSNProvider works", {
+  aa <- SSNProvider$new()
+
+  expect_is(aa, "SSNProvider")
+  expect_is(aa, "R6")
+
+  expect_is(aa$render, "function")
+  expect_is(aa$render(), "character")
+  expect_match(aa$render(), "\\d\\d\\d-\\d\\d-\\d\\d\\d\\d")
+
+  expect_error(SSNProvider$new("ex_EX"),
+    "ex_EX not in set of available locales")
+})
+
+context("ch_ssn works")
+
+test_that("ch_ssn", {
+  expect_is(ch_ssn(), "character")
+  expect_match(ch_ssn(), "\\d\\d\\d-\\d\\d-\\d\\d\\d\\d") 
+  expect_equal(length(ch_ssn(3)), 3)
+})
+