CRAN release candidate 0.4.1 (#166)

* CRAN release candidate 0.4.1

* Update demean.R

* Update test-data_rename.R

* bump version

* submission

Co-authored-by: Daniel <[email protected]>

.gitignore

@@ -61,3 +61,4 @@ Temporary Items
 .apdisk
 docs
 inst/doc
+CRAN-SUBMISSION

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: datawizard
 Title: Easy Data Wrangling
-Version: 0.4.0.17
+Version: 0.4.1
 Authors@R: c(
     person("Dominique", "Makowski", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0001-5375-9967", Twitter = "@Dom_Makowski")),
@@ -25,7 +25,7 @@ BugReports: https://github.com/easystats/datawizard/issues
 Depends:
     R (>= 3.4)
 Imports:
-    insight (>= 0.17.0),
+    insight (>= 0.17.1),
     stats,
     utils
 Suggests: 
@@ -61,5 +61,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
-remotes: easystats/bayestestR, easystats/insight
+RoxygenNote: 7.2.0

R/data_find.R

@@ -159,9 +159,10 @@ data_findcols <- function(data,
                           ends_with = NULL,
                           ignore_case = FALSE,
                           ...) {
-
-  warning(insight::format_message("'data_findcols()' is deprecated and will be removed in a future update.",
-                                  "Its usage is discouraged. Please use 'data_find()' instead."), call. = FALSE)
+  warning(insight::format_message(
+    "'data_findcols()' is deprecated and will be removed in a future update.",
+    "Its usage is discouraged. Please use 'data_find()' instead."
+  ), call. = FALSE)
 
   # init
   n <- names(data)

R/data_read.R

@@ -60,8 +60,7 @@ data_read <- function(path, path_catalog = NULL, encoding = NULL, verbose = TRUE
   }
 
   # read data
-  switch(
-    .file_ext(path),
+  switch(.file_ext(path),
     "txt" = ,
     "csv" = .read_text(path, encoding, verbose, ...),
     "xls" = ,

R/data_recode.R

@@ -325,7 +325,6 @@ data_recode.factor <- function(x,
 
       # recode
       x[which(original_x %in% old_values)] <- recode[[i]]
-
     } else {
       # pattern: new = old
       # name of list element is new value

R/data_shift.R

@@ -34,8 +34,10 @@ data_shift <- function(x, ...) {
 #' @export
 data_shift.default <- function(x, lowest = 0, verbose = TRUE, ...) {
   if (isTRUE(verbose)) {
-    message(insight::format_message("Shifting non-numeric variables is not possible.",
-                                    "Try using 'data_to_numeric()' and specify the 'lowest' argument."))
+    message(insight::format_message(
+      "Shifting non-numeric variables is not possible.",
+      "Try using 'data_to_numeric()' and specify the 'lowest' argument."
+    ))
   }
   x
 }

R/data_tabulate.R

@@ -84,7 +84,8 @@ data_tabulate.default <- function(x, drop_levels = FALSE, name = NULL, verbose =
 
   # create data frame with freq table and cumulative percentages etc.
   out <- data_rename(data.frame(freq_table, stringsAsFactors = FALSE),
-                     replacement = c("Value", "N"))
+    replacement = c("Value", "N")
+  )
 
   out$`Raw %` <- 100 * out$N / sum(out$N)
   out$`Valid %` <- c(100 * out$N[-nrow(out)] / sum(out$N[-nrow(out)]), NA)
@@ -95,11 +96,13 @@ data_tabulate.default <- function(x, drop_levels = FALSE, name = NULL, verbose =
     if (is.null(group_variable)) {
       var_info <- data.frame(Variable = obj_name, stringsAsFactors = FALSE)
     } else {
-      var_info <- data.frame(Variable = obj_name,
-                             Group = paste0(lapply(colnames(group_variable), function(i) {
-                               sprintf("%s (%s)", i, group_variable[[i]])
-                             }), collapse = ", "),
-                             stringsAsFactors = FALSE)
+      var_info <- data.frame(
+        Variable = obj_name,
+        Group = paste0(lapply(colnames(group_variable), function(i) {
+          sprintf("%s (%s)", i, group_variable[[i]])
+        }), collapse = ", "),
+        stringsAsFactors = FALSE
+      )
     }
     out <- cbind(var_info, out)
   }
@@ -124,13 +127,13 @@ data_tabulate.default <- function(x, drop_levels = FALSE, name = NULL, verbose =
 #' @rdname data_tabulate
 #' @export
 data_tabulate.data.frame <- function(x,
-                                  select = NULL,
-                                  exclude = NULL,
-                                  ignore_case = FALSE,
-                                  collapse = FALSE,
-                                  drop_levels = FALSE,
-                                  verbose = TRUE,
-                                  ...) {
+                                     select = NULL,
+                                     exclude = NULL,
+                                     ignore_case = FALSE,
+                                     collapse = FALSE,
+                                     drop_levels = FALSE,
+                                     verbose = TRUE,
+                                     ...) {
   # evaluate arguments
   select <- .select_nse(select, x, exclude, ignore_case)
   out <- lapply(select, function(i) {
@@ -146,13 +149,13 @@ data_tabulate.data.frame <- function(x,
 
 #' @export
 data_tabulate.grouped_df <- function(x,
-                                  select = NULL,
-                                  exclude = NULL,
-                                  ignore_case = FALSE,
-                                  verbose = TRUE,
-                                  collapse = FALSE,
-                                  drop_levels = FALSE,
-                                  ...) {
+                                     select = NULL,
+                                     exclude = NULL,
+                                     ignore_case = FALSE,
+                                     verbose = TRUE,
+                                     collapse = FALSE,
+                                     drop_levels = FALSE,
+                                     ...) {
   # dplyr < 0.8.0 returns attribute "indices"
   grps <- attr(x, "groups", exact = TRUE)
   group_variables <- NULL
@@ -441,8 +444,10 @@ print_md.dw_data_tabulates <- function(x, big_mark = NULL, ...) {
 
   # "table" header with variable label/name, and type
   if (identical(format, "text")) {
-    out <- paste(insight::color_text(name, "red"),
-                 insight::color_text(sprintf("<%s>\n", a$type), "blue"))
+    out <- paste(
+      insight::color_text(name, "red"),
+      insight::color_text(sprintf("<%s>\n", a$type), "blue")
+    )
   } else {
     out <- paste0(name, " (", a$type, ")")
   }
@@ -452,19 +457,33 @@ print_md.dw_data_tabulates <- function(x, big_mark = NULL, ...) {
 
 
 .variable_type <- function(x) {
-  if (is.ordered(x))
+  if (is.ordered(x)) {
     vt <- "ord"
-  else if (is.factor(x))
+  } else if (is.factor(x)) {
     vt <- "fct"
-  else if (class(x)[1] == "Date")
+  } else if (class(x)[1] == "Date") {
     vt <- "date"
-  else {
-    vt <- switch(typeof(x), logical = "lgl", integer = "int",
-                 double = "dbl", character = "chr", complex = "cpl",
-                 closure = "fn", environment = "env", typeof(x))
+  } else {
+    vt <- switch(typeof(x),
+      logical = "lgl",
+      integer = "int",
+      double = "dbl",
+      character = "chr",
+      complex = "cpl",
+      closure = "fn",
+      environment = "env",
+      typeof(x)
+    )
   }
 
-  switch(vt, "ord" = "ordinal", "fct" = "categorical", "dbl" = "numeric",
-         "int" = "integer", "chr" = "character", "lbl" = "labelled",
-         "cpl" = "complex", vt)
+  switch(vt,
+    "ord" = "ordinal",
+    "fct" = "categorical",
+    "dbl" = "numeric",
+    "int" = "integer",
+    "chr" = "character",
+    "lbl" = "labelled",
+    "cpl" = "complex",
+    vt
+  )
 }

R/data_to_numeric.R

@@ -151,8 +151,10 @@ data_to_numeric.logical <- data_to_numeric.numeric
 #' @export
 data_to_numeric.Date <- function(x, verbose = TRUE, ...) {
   if (verbose) {
-    warning(insight::format_message("Converting a date-time variable into numeric.",
-                                    "Please note that this conversion probably not returns meaningful results."), call. = FALSE)
+    warning(insight::format_message(
+      "Converting a date-time variable into numeric.",
+      "Please note that this conversion probably not returns meaningful results."
+    ), call. = FALSE)
   }
   as.numeric(x)
 }

R/demean.R

@@ -344,7 +344,7 @@ degroup <- function(x,
 
   if (center == "mode") {
     x_gm_list <- lapply(select, function(i) {
-      stats::ave(dat[[i]], dat[[group]], FUN = function(.gm) .mode(stats::na.omit(.gm)))
+      stats::ave(dat[[i]], dat[[group]], FUN = function(.gm) distribution_mode(stats::na.omit(.gm)))
     })
   } else if (center == "median") {
     x_gm_list <- lapply(select, function(i) {

R/select_helpers.R

@@ -120,44 +120,37 @@
     # default -----
     pattern <- colnames(data)
     fixed <- TRUE
-
   } else if (!is.null(data) && !is.null(x) && all(x == "all")) {
     # select all columns -----
     pattern <- colnames(data)
     fixed <- TRUE
-
   } else if (grepl("^starts_with\\(\"(.*)\"\\)", x)) {
     # select-helper starts_with -----
     if (negate) {
       pattern <- paste0("^(?!", gsub("starts_with\\(\"(.*)\"\\)", "\\1", x), ")")
     } else {
       pattern <- paste0("^", gsub("starts_with\\(\"(.*)\"\\)", "\\1", x))
     }
-
   } else if (grepl("^ends_with\\(\"(.*)\"\\)", x)) {
     # select-helper end_with -----
     if (negate) {
       pattern <- paste0("(?<!", gsub("ends_with\\(\"(.*)\"\\)", "\\1", x), ")$")
     } else {
       pattern <- paste0(gsub("ends_with\\(\"(.*)\"\\)", "\\1", x), "$")
     }
-
   } else if (grepl("^contains\\(\"(.*)\"\\)", x)) {
     # select-helper contains -----
     if (negate) {
       pattern <- paste0("^((?!\\Q", gsub("contains\\(\"(.*)\"\\)", "\\1", x), "\\E).)*$")
     } else {
       pattern <- paste0("\\Q", gsub("contains\\(\"(.*)\"\\)", "\\1", x), "\\E")
     }
-
   } else if (grepl("^matches\\(\"(.*)\"\\)", x)) {
     # matches is an alias for regex -----
     pattern <- gsub("matches\\(\"(.*)\"\\)", "\\1", x)
-
   } else if (grepl("^regex\\(\"(.*)\"\\)", x)) {
     # regular expression -----
     pattern <- gsub("regex\\(\"(.*)\"\\)", "\\1", x)
-
   } else if (!is.null(data) && !is.null(user_function)) {
     # function -----
     if (negate) {
@@ -166,7 +159,6 @@
       pattern <- colnames(data)[sapply(data, user_function)]
     }
     fixed <- TRUE
-
   } else if (!is.null(data) && grepl("^c\\((.*)\\)$", x)) {
     # here we most likely have a character vector with minus (negate) -----
     cols <- try(eval(parse(text = x)), silent = TRUE)
@@ -180,7 +172,6 @@
     } else {
       pattern <- x
     }
-
   } else if (!is.null(data) && grepl(":", x, fixed = TRUE)) {
     # range -----
     from_to <- unlist(strsplit(x, ":", fixed = TRUE))
@@ -203,7 +194,6 @@
       pattern <- colnames(data)[from:to]
     }
     fixed <- TRUE
-
   } else {
     # everything else
     pattern <- x

R/standardize.R

@@ -66,7 +66,7 @@
 #'   (as does the output of `standardize()`), it will take it from there if the
 #'   rest of the arguments are absent.
 #' @param force Logical, if `TRUE`, forces recoding of factors and character
-#'   vecrors as well.
+#'   vectors as well.
 #' @param ... Arguments passed to or from other methods.
 #' @inheritParams find_columns
 #'