feat: new is_odd(), is_even() and seq_surnames() functions

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: lares
 Type: Package
 Title: Analytics & Machine Learning Sidekick
-Version: 5.2.9.9008
+Version: 5.2.9.9009
 Authors@R: c(
     person("Bernardo", "Lares", , "laresbernardo@gmail.com", c("aut", "cre")))
 Maintainer: Bernardo Lares <laresbernardo@gmail.com>

NAMESPACE

@@ -127,7 +127,9 @@ export(importxlsx)
 export(impute)
 export(install_recommended)
 export(ip_data)
+export(is_even)
 export(is_ip)
+export(is_odd)
 export(is_url)
 export(iter_seeds)
 export(json2vector)
@@ -222,6 +224,7 @@ export(scrabble_points)
 export(scrabble_score)
 export(scrabble_words)
 export(sentimentBreakdown)
+export(seq_surnames)
 export(shap_var)
 export(slackSend)
 export(splot_change)

R/checks.R

@@ -5,6 +5,7 @@
 #' and return error/message with possible options to use. Similar
 #' to \code{match.arg()} but more flexible.
 #'
+#' @family Checks
 #' @param inputs Vector character. Check options.
 #' @param opts Vector character. Valid options.
 #' @param input_name Character. Custom your message and change "input"
@@ -58,6 +59,7 @@ check_opts <- function(inputs, opts,
 #' This function checks if an object has a specific attribute and
 #' stops if not.
 #'
+#' @family Checks
 #' @param object Object of any kind
 #' @param attr Character. Attribute to check
 #' @param check Character. Attribute value
@@ -99,6 +101,7 @@ check_attr <- function(object, attr = "type", check = NULL, stop = TRUE) {
 #' constant values, are binary values... Notice that \code{is_} will return
 #' the result for each observation and \code{are_} for the whole vector.
 #'
+#' @family Checks
 #' @param x Vector
 #' @param ... Additional parameters passed to \code{grepl()}
 #' @return \code{is_url}. Boolean. Result of checking if \code{x} is a valid URL string.
@@ -114,12 +117,17 @@ check_attr <- function(object, attr = "type", check = NULL, stop = TRUE) {
 #' are_constant(1:10)
 #'
 #' are_binary(c("A", "B", "A"))
+#' 
+#' is_even(1:5)
+#' is_odd(1:5)
+#' is_odd(c(0, 1.5, 2.5, NA, Inf, NULL))
+#' @rdname checks
 #' @export
 is_url <- function(x, ...) {
   return(grepl("(http|https)://[a-zA-Z0-9./?=_%:-]*", x, ...))
 }
 
-#' @rdname is_url
+#' @rdname checks
 #' @return \code{is_ip}. Boolean. Result of checking if \code{x} is a valid IP string.
 #' @export
 is_ip <- function(x, ...) {
@@ -130,23 +138,30 @@ is_ip <- function(x, ...) {
   return(grepl(regex, x, ...))
 }
 
-#' @rdname is_url
+#' @rdname checks
 #' @return \code{are_id}. Boolean. Result of checking if \code{x} is a potential ID vector
 #' @export
 are_id <- function(x) {
   return(is.character(x) && length(unique(x)) == length(x))
 }
 
-#' @rdname is_url
+#' @rdname checks
 #' @return \code{are_constant}. Boolean. Result of checking if \code{x} is a constant vector
 #' @export
 are_constant <- function(x) {
   return(length(unique(x)) == 1)
 }
 
-#' @rdname is_url
+#' @rdname checks
 #' @return \code{are_binary}. Boolean. Result of checking if \code{x} is a binary vector
 #' @export
 are_binary <- function(x) {
   return(length(unique(x)) == 2)
 }
+
+#' @rdname checks
+#' @export
+is_even <- function(x) x %% 2 == 0
+#' @rdname checks
+#' @export
+is_odd <- function(x) x %% 2 == 1

R/family.R

@@ -0,0 +1,44 @@
+####################################################################
+#' Family Tree and Surnames Sequence
+#'
+#' @param n Integer. Number of generations. Notice this will generate sequences
+#' of 2^n integer values.
+#' @return Integer vector.
+#' @examples
+#' seq_surnames(1) # Expected: 1
+#' seq_surnames(2) # Expected: 1, 2
+#' seq_surnames(3) # Expected: 1, 5, 3, 7, 2, 6, 4, 8
+#' seq_surnames(4) # Expected: 1, 9, 5, 13, 3, 11, 7, 15, 2, 10, 6, 14, 4, 12, 8, 16
+#' @export
+seq_surnames <- function(n = 1) {
+  stopifnot(!is.integer(n))
+  ni <- n - 1 # We calculate only one and then sum 1 to the other half
+  for (k in seq(2^ni)) {
+    # Always start with 1
+    if (k == 1) {
+      vals <- NULL
+      vals[1] <- 1
+    } else {
+      # Handle the specific case for n = 2
+      if (n == 2) {
+        vals[k] <- k
+      } else {
+        # Generate the first 4 values of seq for larger n
+        if (k %in% seq(4)) {
+          if (is_odd(k)) {
+            vals[k] <- vals[k - 1] - 2^(ni - 1)
+          } else {
+            vals[k] <- vals[k - 1] + 2^(ni)
+          }
+        }
+      }
+    }
+  }
+  # Now sum the rest of the sequence based on vals
+  if (n >= 3) {
+    for (i in (n - 2):1) {
+      vals <- c(vals, vals + 2^(i - 1))
+    }
+  }
+  return(vals)
+}