Merge pull request #18 from olivroy/rm-dep

Improve argument checks
rolkra · Sep 5, 2023 · 897b4ab · 897b4ab
2 parents 47f847c + 098b706
commit 897b4ab
Show file tree

Hide file tree

Showing 16 changed files with 999 additions and 169 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -14,18 +14,17 @@ Encoding: UTF-8
 URL: https://github.com/rolkra/explore
 Depends: R (>= 3.5.0)
 Imports: 
-    assertthat,
     broom,
     dplyr,
     DT (>= 0.3.0),
-    forcats,
+    forcats (>= 1.0.0),
     ggplot2 (>= 3.4.0),
     gridExtra,
     magrittr,
     MASS,
     palmerpenguins,
     randomForest,
-    rlang,
+    rlang (>= 1.1.0),
     rmarkdown,
     rpart,
     rpart.plot,

diff --git a/R/abtest.R b/R/abtest.R
@@ -1,7 +1,7 @@
 #' A/B testing
 #'
 #' @param data A dataset
-#' @param expr Expression, that results in a FALSE/TRUE
+#' @param expr Logical expression, that return in a FALSE/TRUE
 #' @param target Target variable
 #' @param sign_level Significance Level (typical 0.01/0.05/0.10)
 #' @return Plot that shows if difference is significant
@@ -20,16 +20,10 @@
 abtest <- function(data, expr, target, sign_level = 0.05) {
 
   # check parameter
-  rlang::check_required(data)
+  check_data_frame_non_empty(data)
   rlang::check_required(expr)
   rlang::check_required(target)
-
-  assertthat::assert_that(is.data.frame(data), msg = "expect data of type data.frame")
-  assertthat::assert_that(nrow(data) > 0, msg = "data has 0 observations")
-  assertthat::assert_that(is.numeric(sign_level), msg = "expect numeric value for sign_level")
-  assertthat::assert_that(sign_level <= 1, msg = "expect sign_level between 0 and 1")
-  assertthat::assert_that(sign_level > 0, msg = "expect sign_level between 0 and 1")
-
+  check_number_decimal(sign_level, min = 0, max = 1)
 
   # parameter target
   target_quo <- enquo(target)

diff --git a/R/add-var.R b/R/add-var.R
@@ -22,11 +22,7 @@ add_var_random_cat <- function(data,
                                seed) {
 
   # data table available?
-  rlang::check_required(data)
-
-  if (!is.data.frame(data)) {
-    stop("expect a table of type data.frame")
-  }
+  check_data_frame_non_empty(data)
 
   # check if var already exists
   if (name %in% names(data) & !overwrite) {
@@ -105,11 +101,7 @@ add_var_random_int <- function(data, name = "random_int",
                                seed) {
 
   # data table available?
-  rlang::check_required(data)
-
-  if (!is.data.frame(data)) {
-    stop("expect a table of type data.frame")
-  }
+  check_data_frame_non_empty(data)
 
   if (name %in% names(data) & !overwrite) {
     stop("Variable ", name, " already exists!")
@@ -154,14 +146,7 @@ add_var_random_dbl <- function(data, name = "random_dbl",
                                seed) {
 
   # data table available?
-  if (missing(data))  {
-    stop("data is missing")
-  }
-
-  # is it a data.frame?
-  if (!is.data.frame(data)) {
-    stop("expect a table of type data.frame")
-  }
+  check_data_frame_non_empty(data)
 
   # check variable name
   if (name %in% names(data) & !overwrite) {
@@ -260,16 +245,8 @@ add_var_random_starsign <- function(data, name = "random_starsign", lang = "en",
 #' @export
 
 add_var_id <- function(data, name = "id", overwrite = FALSE)  {
-
   # data table available?
-  if (missing(data))  {
-    stop("data is missing")
-  }
-
-  # is it a data.frame?
-  if (!is.data.frame(data)) {
-    stop("expect a table of type data.frame")
-  }
+  check_data_frame(data)
 
   # check variable name
   if (name %in% names(data) & !overwrite) {

diff --git a/R/create-data.R b/R/create-data.R
@@ -11,22 +11,21 @@
 create_data_empty <- function(obs = 1000, add_id = FALSE, seed = 123) {
 
   # checks
-  assertthat::assert_that(is.numeric(obs))
-  assertthat::assert_that(obs > 0)
-  assertthat::assert_that(is.logical(add_id))
-  assertthat::assert_that(is.numeric(seed))
+  check_number_whole(obs, min = 1)
+  check_bool(add_id)
+  check_number_decimal(seed)
 
   # reproducible random numbers
   set.seed(seed)
 
   # create empty data frame
   data <- data.frame(
-    row.names = seq(1, obs)
+    row.names = seq_len(obs)
   )
 
   # add if
   if (add_id)  {
-    data[["id"]] <- seq(1, obs)
+    data[["id"]] <- seq_len(obs)
   }
 
   # return data
@@ -49,10 +48,9 @@ create_data_app = function(obs = 1000,
                            add_id = FALSE,
                            seed = 123) {
   # checks
-  assertthat::assert_that(is.numeric(obs))
-  assertthat::assert_that(obs > 0)
-  assertthat::assert_that(is.logical(add_id))
-  assertthat::assert_that(is.numeric(seed))
+  check_number_whole(obs, min = 1)
+  check_bool(add_id)
+  check_number_decimal(seed)
 
   # set seed (randomization)
   set.seed(seed)
@@ -154,10 +152,9 @@ create_data_app = function(obs = 1000,
 create_data_person <- function(obs = 1000, add_id = FALSE, seed = 123) {
 
   # checks
-  assertthat::assert_that(is.numeric(obs))
-  assertthat::assert_that(obs > 0)
-  assertthat::assert_that(is.logical(add_id))
-  assertthat::assert_that(is.numeric(seed))
+  check_number_whole(obs, min = 1)
+  check_bool(add_id)
+  check_number_decimal(seed)
 
   # reproducible random numbers
   set.seed(seed)
@@ -169,7 +166,7 @@ create_data_person <- function(obs = 1000, add_id = FALSE, seed = 123) {
   data <- tibble::tibble(
     age = sample(16:95, nobs, replace = TRUE),
     gender = sample(c("Male","Female", "X"), prob = c(0.49, 0.49, 0.02), nobs, replace = TRUE),
-    eye_color = sample(c("Blue","Green","Brown"), nobs, replace = TRUE),
+    eye_color = sample(c("Blue","Green","Brown"), size = nobs, replace = TRUE),
     shoe_size = trunc(stats::rnorm(nobs, mean = 43, sd = 3)),
     iq = trunc(stats::rnorm(nobs, mean = 100, sd = 20)),
     education = sample(c(0:100), nobs, replace = TRUE),
@@ -179,7 +176,7 @@ create_data_person <- function(obs = 1000, add_id = FALSE, seed = 123) {
 
     pet = sample(c("Dog","Cat","Other","No"),
                  prob = c(0.23,0.22,0.11,0.35),
-                 nobs, replace = TRUE),
+                nobs, replace = TRUE),
 
     favorite_pizza = sample(c("Margaritha", "Carciofi","Pepperoni", "Hawai", "Quattro Statgioni", "Provenciale"), nobs, replace = TRUE),
     favorite_icecream = sample(c("Vanilla", "Chocolate","Strawberry", "Lemon", "Cookie", "Hazelnut","Apple"),
@@ -257,12 +254,10 @@ create_data_buy = function(obs = 1000,
                            seed = 123) {
 
   # checks
-  assertthat::assert_that(is.numeric(obs))
-  assertthat::assert_that(obs > 0)
-  assertthat::assert_that(is.numeric(target1_prob))
-  assertthat::assert_that(target1_prob >= 0 & target1_prob <= 1)
-  assertthat::assert_that(is.logical(add_id))
-  assertthat::assert_that(is.numeric(seed))
+  check_number_whole(obs, min = 1)
+  check_bool(add_id)
+  check_number_decimal(seed)
+  check_number_decimal(target1_prob, min = 0, max = 1)
 
   # define variables for CRAN-package check
   target_ind <- NULL
@@ -381,12 +376,10 @@ create_data_churn = function(obs = 1000,
                              seed = 123) {
 
   # checks
-  assertthat::assert_that(is.numeric(obs))
-  assertthat::assert_that(obs > 0)
-  assertthat::assert_that(is.numeric(target1_prob))
-  assertthat::assert_that(target1_prob >= 0 & target1_prob <= 1)
-  assertthat::assert_that(is.logical(add_id))
-  assertthat::assert_that(is.numeric(seed))
+  check_number_whole(obs, min = 1)
+  check_bool(add_id)
+  check_number_decimal(seed)
+  check_number_decimal(target1_prob, min = 0, max = 1)
 
   # set seed (randomization)
   set.seed(seed)
@@ -482,10 +475,9 @@ create_data_newsletter = function(obs = 1000,
                               add_id = FALSE,
                               seed = 123) {
   # checks
-  assertthat::assert_that(is.numeric(obs))
-  assertthat::assert_that(obs > 0)
-  assertthat::assert_that(is.logical(add_id))
-  assertthat::assert_that(is.numeric(seed))
+  check_number_whole(obs, min = 1)
+  check_bool(add_id)
+  check_number_decimal(seed)
 
   # define variables for CRAN-package check
   sending_h <- NULL
@@ -564,12 +556,10 @@ create_data_unfair = function(obs = 1000,
                               add_id = FALSE,
                               seed = 123) {
   # checks
-  assertthat::assert_that(is.numeric(obs))
-  assertthat::assert_that(obs > 0)
-  assertthat::assert_that(is.numeric(target1_prob))
-  assertthat::assert_that(target1_prob >= 0 & target1_prob <= 1)
-  assertthat::assert_that(is.logical(add_id))
-  assertthat::assert_that(is.numeric(seed))
+  check_number_whole(obs, min = 1)
+  check_bool(add_id)
+  check_number_decimal(seed)
+  check_number_decimal(target1_prob, min = 0, max = 1)
 
   # set seed (randomization)
   set.seed(seed)
@@ -671,12 +661,10 @@ create_data_random = function(obs = 1000, vars = 10,
                               add_id = TRUE,
                               seed = 123) {
   # checks
-  assertthat::assert_that(is.numeric(obs))
-  assertthat::assert_that(obs > 0)
-  assertthat::assert_that(is.numeric(target1_prob))
-  assertthat::assert_that(target1_prob >= 0 & target1_prob <= 1)
-  assertthat::assert_that(is.logical(add_id))
-  assertthat::assert_that(is.numeric(seed))
+  check_number_whole(obs, min = 1)
+  check_bool(add_id)
+  check_number_decimal(seed)
+  check_number_decimal(target1_prob, min = 0, max = 1)
 
   # set seed (randomization)
   set.seed(seed)

diff --git a/R/describe.R b/R/describe.R
@@ -11,11 +11,8 @@
 #' @export
 
 describe_num <- function(data, var, n, out = "text", margin = 0) {
-  rlang::check_required(data)
   # data type data.frame?
-  if (!is.data.frame(data))  {
-    stop("expect a table of type data.frame")
-  }
+  check_data_frame_non_empty(data)
 
   # parameter var
   rlang::check_required(var)
@@ -109,7 +106,7 @@ describe_num <- function(data, var, n, out = "text", margin = 0) {
 #' @param var Variable or variable name
 #' @param n Weights variable for count-data
 #' @param max_cat Maximum number of categories displayed
-#' @param out Output format ("text"|"list")
+#' @param out Output format ("text"|"list"|"tibble"|"df")
 #' @param margin Left margin for text output (number of spaces)
 #' @return Description as text or list
 #' @examples
@@ -118,18 +115,14 @@ describe_num <- function(data, var, n, out = "text", margin = 0) {
 
 describe_cat <- function(data, var, n, max_cat = 10, out = "text", margin = 0) {
   # data table available?
-  rlang::check_required(data)
+  check_data_frame_non_empty(data)
   # data type data.frame?
-  if (!is.data.frame(data))  {
-    stop("expect a table of type data.frame")
-  }
 
   # var
   rlang::check_required(var)
-  if(!missing(var))  {
-    var_quo <- enquo(var)
-    var_txt <- quo_name(var_quo)[[1]]
-  }
+  # non-standard evaluation.
+  var_quo <- enquo(var)
+  var_txt <- quo_name(var_quo)[[1]]
 
   # check if var in data
   if(!var_txt %in% names(data)) {
@@ -247,14 +240,9 @@ describe_cat <- function(data, var, n, max_cat = 10, out = "text", margin = 0) {
 #' describe_all(iris)
 #' @export
 
-describe_all <- function(data = NA, out = "large") {
-  # data table available?
-  rlang::check_required(data)
-
-  # data type data.frame?
-  if (!is.data.frame(data))  {
-    stop("expect a table of type data.frame")
-  }
+describe_all <- function(data, out = "large") {
+  # data table available?  data type data.frame?
+  check_data_frame_non_empty(data)
 
   # define variables for package check
   variable <- NULL
@@ -359,12 +347,9 @@ describe_all <- function(data = NA, out = "large") {
 describe_tbl <- function(data, n, target, out = "text")  {
 
   # data table available?
-  rlang::check_required(data)
+  check_data_frame_non_empty(data)
 
   # data type data.frame?
-  if (!is.data.frame(data))  {
-    stop("expect a table of type data.frame")
-  }
 
   # parameter target
   if(!missing(target))  {
@@ -502,12 +487,8 @@ describe_tbl <- function(data, n, target, out = "text")  {
 
 describe <- function(data, var, n, target, out = "text", ...)  {
   # data table available?
-  rlang::check_required(data)
+  check_data_frame_non_empty(data)
 
-  # data type data.frame?
-  if (!is.data.frame(data))  {
-    stop("expect a table of type data.frame")
-  }
 
   # parameter var
   if(!missing(var))  {

diff --git a/R/explain.R b/R/explain.R
@@ -25,7 +25,7 @@ explain_tree <- function(data, target, n,
                          max_cat = 10, max_target_cat = 5, maxdepth = 3,
                          minsplit = 20, cp = 0, weights = NA,
                          size = 0.7, out = "plot", ...)  {
-  rlang::check_required(data)
+  check_data_frame_non_empty(data)
   # define variables to pass CRAN-checks
   type <- NULL
   variable <- NULL
@@ -185,7 +185,7 @@ explain_tree <- function(data, target, n,
 #' @export
 
 explain_logreg <- function(data, target, out = "tibble", ...)  {
-  rlang::check_required(data)
+  check_data_frame_non_empty(data)
   # parameter data
 
   # parameter target
@@ -246,7 +246,7 @@ explain_forest <- function(data, target, ntree = 50, out = "plot", ...)  {
   variable <- NULL
 
   # parameter data
-  rlang::check_required(data)
+  check_data_frame_non_empty(data)
   rlang::check_required(target)
   # parameter target
   target_quo <- enquo(target)
@@ -325,8 +325,7 @@ explain_forest <- function(data, target, ntree = 50, out = "plot", ...)  {
 predict_target <- function(data, model, name = "prediction") {
 
   # check parameter
-  rlang::check_required(data)
-  if (!is.data.frame(data)) { stop("data must be of class data.frame or tbl") }
+  check_data_frame_non_empty(data)
 
   result <- data
   values <- NA