update

NAMESPACE

@@ -5,6 +5,8 @@ S3method(t_outlier_test,formula)
 S3method(t_outlier_test,recipe)
 export(GH_filter)
 export(barycenter_distance)
+export(create_alpha_index)
+export(create_kfold)
 export(get_validation_set)
 export(log_message)
 export(outliars)

R/misc.R

@@ -0,0 +1,50 @@
+#' Utility function to log formated messages into the console.
+#'
+#' @param message A character. Message to be printed.
+#' @param title logical. If TRUE, a nice hand-crafted frame is painted around the
+#' undoubtedly useful message.
+#'
+#' @return
+#' @export
+#'
+#' @examples
+log_message <- function(message, title = T){
+
+  if(title){
+    cat(paste(rep("*", 50), collapse = ""), fill = T)
+    cat(message, fill = T)
+    cat(paste(rep("*", 50), collapse = ""), fill = T)
+  }else{
+    cat(message, fill = T)
+  }
+
+  flush.console()
+}
+
+
+#' Create names that could be ordered alphabetically
+#'
+#' @description
+#' Create an ordered list of names using padding of incremental values.
+#'
+#' @param n An integer. The number of variables
+#' @param prefix A character. The prefix added before each incremental value.
+#' @param sep A character. The separator used between the prefix and the numerical
+#' values.
+#'
+#' @return The function returns a vector of well-defined alphabetically-ordered
+#' names.
+#' @export
+#'
+#' @examples
+create_alpha_index <- function(n = 10, prefix, sep = "_"){
+  M <- floor(log(n, base = 10))
+  z <- M - floor(log(1:n, base = 10))
+  idx <- paste0(
+    sapply(z, FUN = function(times = z) paste(rep(0, times), collapse = "")),
+    1:n
+  )
+  if(!missing(prefix)) {
+    paste(prefix, idx, sep = sep)
+  }else idx
+}

R/partition.R

@@ -0,0 +1,40 @@
+#' Create k-folds partition of a training data.frame.
+#'
+#' @param X The data.frame to be partitioned.
+#' @param k Integer. The number of folds
+#' @param strata Character. The name of the column to stratify the data.frame
+#' with.
+#' @param seed A number. The random seed.
+#'
+#' @return
+#' @export
+#'
+#' @examples
+create_kfold <- function(X, k = 10, strata, seed){
+  if(!missing(seed)) set.seed(seed)
+
+  # -- Closure function that create the data partitions -- ####
+  create_kfold_closure <- function(x){
+    partition_size <- floor(x / k)
+    remainder <- x %% k
+    c(rep(1:k, partition_size), sample(k, size = remainder))
+  }
+  # -- Closure function that create the data partitions -- #
+
+  # -- Do the data partitions need to be stratified ? -- ####
+  if(missing(strata)){
+    K <- create_kfold_closure(nrow(X))
+    sample(K, size = length(K))
+  }else{
+    id <- X[[strata]]
+    id_ord <- order(id)
+    a <- lapply(table(id), create_kfold_closure)
+    K <- Reduce(c, a)[order(id_ord)]
+  }
+  # -- Do the data partitions need to be stratified ? -- #
+
+  # -- Output kfolds with names -- ####
+  structure(split(1:length(K), K),
+            names = create_alpha_index(n = k, prefix = "split"))
+  # -- Output kfolds with names -- #
+}