Merge pull request #142 from ropensci/feat/article_providers

Add ISBN provider

DESCRIPTION

@@ -99,6 +99,7 @@ Collate:
     'internet-provider-fr_FR.R'
     'internet-provider-hr_HR.R'
     'internet-provider.R'
+    'isbn-provider.R'
     'job.R'
     'jobs-provider-da_DK.R'
     'jobs-provider-en_US.R'

Makefile

@@ -11,7 +11,10 @@ doc:
 install: doc build
 	R CMD INSTALL . && rm *.tar.gz
 
-build:
+update_collate:
+	${RSCRIPT} -e "roxygen2::update_collate('.')"
+
+build: update_collate
 	R CMD build .
 
 eg:
@@ -29,7 +32,7 @@ locales_update:
 	${RSCRIPT} -e "devtools::load_all(); z=data.table::setDF(data.table::rbindlist(lapply(available_locales, stringi::stri_locale_info))); save(z, version=2, file='data/available_locales_df.rda')"
 
 # No real targets!
-.PHONY: all test doc install	
+.PHONY: all test doc install
 
 vignettes:
 	${RSCRIPT} -e "devtools::build_vignettes()"

R/address-provider-en_NZ.R

@@ -35,7 +35,6 @@ AddressProvider_en_NZ <- R6::R6Class(
       pattern <- super$random_element(private$city_formats)
       dat <- list(
         # , , te_reo_first, te_reo_ending, te_reo_part
-
         first_name = private$pp$first_name(),
         last_name = private$pp$last_name(),
         city_suffix = super$random_element(private$street_suffixes),

R/address-provider.R

@@ -52,4 +52,3 @@ AddressProvider <- R6::R6Class(
     provider_ = "AddressProvider"
   )
 )
-

R/isbn-provider.R

@@ -0,0 +1,92 @@
+#' @title ISBNProvider
+#' @description International Standard Book Number - Provider.
+#' ISBN starts with group code, all English language ISBN-10 codes
+#' start with a 0 or 1, and all German language books start with a 3.
+#' see <https://en.wikipedia.org/wiki/List_of_ISBN_registration_groups>.
+#'
+#' Charlatan does not provide further helpers for you, but you can supply the
+#' prefix yourself, if for instance you want to create Mexican ISBNs you can
+#' by supplying the ISBN10 prefix 970, or for Andorra supply the ISBN 13 prefix
+#' 97899920 (that is 978 for ISBN13, and 99920 for Andorra).
+#'
+#' @param n (integer) number of ISBN10s to make, default=1
+#' @param prefix (integer/character) prefix for ISBN
+#' @export
+#' @examples
+#' z <- ISBNProvider$new()
+#' z$isbn10()
+#' z$isbn13()
+#' z$isbn10(10)
+#' z$isbn13(100)
+#' # or even z$isbn10(500)
+ISBNProvider <- R6::R6Class(
+  "ISBNProvider",
+  inherit = BareProvider,
+  public = list(
+    #' @description Make a ISBN10
+    #' This is a completely random (apart from the prefix), but valid ISBN10 number.
+    isbn10 = function(n = 1, prefix = NULL) {
+      replicate(n, private$generate_isbn10(prefix = prefix))
+    },
+    #' @description Make a ISBN13.
+    #' This is a completely random (apart from the prefix), but valid ISBN13 number.
+    isbn13 = function(n = 1, prefix = NULL) {
+      replicate(n, private$generate_isbn13(prefix = prefix))
+    }
+  ),
+  private = list(
+    provider_ = "ISBNProvider",
+    generate_isbn10 = function(prefix = NULL) {
+      first9isbn <- sample(0:9, size = 9, replace = TRUE)
+      if (!is.null(prefix)) {
+        first9isbn <- private$subst_vector(prefix, first9isbn)
+      }
+      final_number <- private$generate_isbn10_checkdigit(first9isbn)
+      isbn <- paste0(c(first9isbn, final_number), collapse = "")
+      isbn
+    },
+    generate_isbn10_checkdigit = function(first9isbn) {
+      first_9 <- as.integer(first9isbn)
+      if (length(first_9) != 9) {
+        stop("needs exactly 9 tokens")
+      }
+      final_number <- 11 - (checksum_util(first_9, 10:2) %% 11)
+      final_number <- final_number %% 11
+      if (final_number == 10) {
+        final_number <- "X"
+      }
+      as.character(final_number)
+    },
+    generate_isbn13 = function(prefix = NULL) {
+      first12isbn <- sample(0:9, 12, replace = TRUE)
+      if (!is.null(prefix)) {
+        first12isbn <- private$subst_vector(prefix, first12isbn)
+      }
+      final_number <- private$generate_isbn13_checkdigit(first12isbn)
+      isbn <- paste0(c(first12isbn, final_number), collapse = "")
+      isbn
+    },
+    generate_isbn13_checkdigit = function(first12isbn) {
+      # first12isbn should be a vector of 12 long.
+      first_12 <- as.integer(first12isbn)
+      if (length(first_12) != 12) {
+        stop("needs exactly 12 tokens")
+      }
+      final_number <- 10 - (checksum_util(first_12, rep(c(1, 3), 6)) %% 10)
+      if (final_number == 10) {
+        final_number <- 0
+      }
+      final_number
+    },
+    subst_vector = function(prefix, vector) {
+      step <- nchar(prefix)
+      max_n <- length(vector)
+      if (step > max_n) {
+        step <- max_n
+      }
+      values <- strsplit(as.character(prefix), "")[[1]]
+      vector[1:step] <- values[1:step]
+      as.integer(vector)
+    }
+  )
+)

R/sequence-provider.R

@@ -1,7 +1,6 @@
 #' @title SequenceProvider
 #' @description genetic sequence generator
 #' @export
-#' @keywords internal
 #' @examples
 #' z <- SequenceProvider$new()
 #' z$render()

R/ssn-provider-all.R

@@ -48,21 +48,9 @@ SSNProvider_nl_NL <- R6Class(
     #' @description Make a SSN
     #'  Dutch SSN (BSN) is 9 digits that follow a certain proof (elfproef).
     render = function() {
-      first_8 <- as.integer(strsplit(as.character(as.integer(runif(1) * 1e8)), "")[[1]])
-      if (length(first_8) == 7) {
-        first_8[8] <- 1
-      }
-      final_number <- (
-        9 * first_8[1] +
-          +8 * first_8[2] +
-          +7 * first_8[3] +
-          +6 * first_8[4] +
-          +5 * first_8[5] +
-          +4 * first_8[6] +
-          +3 * first_8[7] +
-          +2 * first_8[8]
-      ) %% 11
+      first_8 <- sample(0:9, 8, replace = TRUE)
 
+      final_number <- checksum_util(first_8, 9:2) %% 11
       bsn <- paste0(c(first_8, final_number), collapse = "")
       bsn
     }

R/zzz.R

@@ -118,3 +118,13 @@ locale_mismatch <- function(parent_provider, child_provider) {
   child <- cr_loc_spec_provider(child_provider, "en_US")$allowed_locales()
   parent[!parent %in% child]
 }
+
+#' generalized util function for sequence multiplication
+#'
+#' Util function for ISBN, ean, SSN providers.
+#' for cases such as sum(x[4]*5 + x[3]*4 + x[2]*3 + x[1] *2)
+#' @keywords internal
+checksum_util <- function(vector, multiplicationvector) {
+  stopifnot(length(vector) == length(multiplicationvector))
+  sum(vector * multiplicationvector)
+}

tests/testthat/test-addresses.R

@@ -28,13 +28,13 @@ test_that("every_locale has the same basic functions", {
     expect_false(bb$address() == "")
     expect_is(bb$city, "function")
     expect_type(bb$city(), "character")
-    expect_false(bb$city() == "",label = sprintf("city - %s", locale))
+    expect_false(bb$city() == "", label = sprintf("city - %s", locale))
     expect_is(bb$street_address, "function")
     expect_type(bb$street_address(), "character")
-    expect_false(bb$street_address() == "",label = sprintf("city - %s", locale))
+    expect_false(bb$street_address() == "", label = sprintf("city - %s", locale))
     expect_is(bb$street_name, "function")
     expect_type(bb$street_name(), "character")
-    expect_false(bb$street_name() == "",label = sprintf("city - %s", locale))
+    expect_false(bb$street_name() == "", label = sprintf("city - %s", locale))
     expect_is(bb$postcode, "function")
     expect_type(bb$postcode(), "character")
     expect_false(bb$postcode() == "", label = sprintf("postcode - %s", locale))
@@ -75,18 +75,18 @@ test_that("custom functions from AddressProvider_nl_NL work", {
   expect_true(aa$province() %in% aa$.__enclos_env__$private$provinces)
 })
 
-test_that("all locales consistently give results -- stresstest",{
-    skip_on_cran()
-    skip_on_ci()
-
-    aa <- cr_loc_spec_provider("AddressProvider", "en_US")
-    for (locale in aa$allowed_locales()) {
-        bb <- cr_loc_spec_provider("AddressProvider", locale)
-        for (i in 1:50){
-            expect_false(bb$city() == "",label = sprintf("city - %s", locale))
-            expect_false(bb$street_address() == "",label = sprintf("city - %s", locale))
-            expect_false(bb$street_name() == "",label = sprintf("city - %s", locale))
-            expect_false(bb$postcode() == "", label = sprintf("postcode - %s", locale))
-        }
+test_that("all locales consistently give results -- stresstest", {
+  skip_on_cran()
+  skip_on_ci()
+
+  aa <- cr_loc_spec_provider("AddressProvider", "en_US")
+  for (locale in aa$allowed_locales()) {
+    bb <- cr_loc_spec_provider("AddressProvider", locale)
+    for (i in 1:50) {
+      expect_false(bb$city() == "", label = sprintf("city - %s", locale))
+      expect_false(bb$street_address() == "", label = sprintf("city - %s", locale))
+      expect_false(bb$street_name() == "", label = sprintf("city - %s", locale))
+      expect_false(bb$postcode() == "", label = sprintf("postcode - %s", locale))
     }
+  }
 })

tests/testthat/test-company.R

@@ -45,7 +45,7 @@ test_that("all locales have `company()` function", {
   for (loc in CompanyProvider_en_US$new()$allowed_locales()) {
     aa <- cr_loc_spec_provider("CompanyProvider", locale = loc)
     expect_gt(nchar(aa$company()), 0)
-    expect_false(aa$company() == "",label = sprintf("company - %s", loc))
+    expect_false(aa$company() == "", label = sprintf("company - %s", loc))
     expect_type(aa$company, "closure")
   }
 })

tests/testthat/test-isbn.R

@@ -0,0 +1,50 @@
+test_that("ISBN 13 creates valid ISBN", {
+  ISBNP <- ISBNProvider$new()
+  # ISBN version 13
+  # 978-0-306-40615-? 7
+  # LOW LEVEL CHECKDIGIT
+  expect_equal(ISBNP$.__enclos_env__$private$generate_isbn13_checkdigit(c(9, 7, 8, 0, 3, 0, 6, 4, 0, 6, 1, 5)), 7)
+  # UNDERLYING GENERATOR
+  expect_equal(nchar(ISBNP$.__enclos_env__$private$generate_isbn13()), 13)
+  # USER FACING FUNCTION
+  expect_equal(nchar(ISBNP$isbn13()), 13)
+})
+test_that("ISBN 10 creates valid ISBN", {
+  ISBNP <- ISBNProvider$new()
+  # isbn version 10
+  # 0-306-40615-? 2
+
+
+  # LOW LEVEL CHECKDIGIT
+  # 0575055030 men at arms
+  expect_equal(ISBNP$.__enclos_env__$private$generate_isbn10_checkdigit(c(0, 5, 7, 5, 0, 5, 5, 0, 3)), "0")
+  # 038553826X raising steam
+  expect_equal(ISBNP$.__enclos_env__$private$generate_isbn10_checkdigit(c(0, 3, 8, 5, 5, 3, 8, 2, 6)), "X")
+  # 0062429981 The Shepherd's Crown
+  expect_equal(ISBNP$.__enclos_env__$private$generate_isbn10_checkdigit(c(0, 0, 6, 2, 4, 2, 9, 9, 8)), "1")
+
+  ## optional extra checks
+  # # 0192854259 good omens
+  # expect_equal(ISBNP$.__enclos_env__$private$generate_isbn10_checkdigit(c(0,1,9,2,8,5,4,2,5)), "9")
+  # # 0552152676 thud
+  # expect_equal(ISBNP$.__enclos_env__$private$generate_isbn10_checkdigit(c(0,5,5,2,1,5,2,6,7)), "6")
+  # # 0552142352 interesting times
+  # expect_equal(ISBNP$.__enclos_env__$private$generate_isbn10_checkdigit(c(0,5,5,2,1,4,2,3,5)), "2")
+  # # 0552134635 moving pictures
+  # expect_equal(ISBNP$.__enclos_env__$private$generate_isbn10_checkdigit(c(0,5,5,2,1,3,4,6,3)), "5")
+
+  # UNDERLYING GENERATOR
+  expect_equal(nchar(ISBNP$.__enclos_env__$private$generate_isbn10()), 10)
+  # USER FACING FUNCTION
+  expect_equal(nchar(ISBNP$isbn10()), 10)
+})
+
+test_that("prefix logic works", {
+  ISBNP <- ISBNProvider$new()
+
+  expect_equal(ISBNP$.__enclos_env__$private$subst_vector("978", c(1, 1, 1, 1, 1)), c(9, 7, 8, 1, 1))
+  # 978 or 979
+  expect_equal(substr(ISBNP$isbn13(n = 1, prefix = 978), 1, 3), "978")
+  # 1 or 0 for isbn10
+  expect_equal(substr(ISBNP$isbn10(n = 1, prefix = 1), 1, 1), "1")
+})

tests/testthat/test-zzz.R

@@ -72,3 +72,14 @@ test_that("All non-localized providers inherit from BareProvider", {
     }
   }
 })
+
+
+test_that("checksum_util works for our usecases", {
+  # ISBN 10
+  expect_equal(checksum_util(c(0, 3, 0, 6, 4, 0, 6, 1, 5), 10:2), 130)
+  # ISBN 13
+  expect_equal(checksum_util(c(9, 7, 8, 0, 3, 0, 6, 4, 0, 6, 1, 5), rep(c(1, 3), 6)), 93)
+  # SSN dutch
+  # 111222333 en 123456782
+  expect_equal(checksum_util(c(1, 1, 1, 2, 2, 2, 3, 3), 9:2), 69)
+})