Merge branch 'main' into unnormalize-grouped-data

.Rbuildignore

@@ -46,6 +46,5 @@ references.bib
 ^hextools/.
 ^WIP/.
 ^CRAN-SUBMISSION$
-^LICENSE$
 docs
 ^.dev$

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: datawizard
 Title: Easy Data Wrangling and Statistical Transformations
-Version: 0.7.1.11
+Version: 0.8.0.7
 Authors@R: c(
     person("Indrajeet", "Patil", , "patilindrajeet.science@gmail.com", role = "aut",
            comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")),
@@ -27,13 +27,13 @@ Description: A lightweight package to assist in key steps involved in any data
     (3) compute statistical summaries of data properties and distributions. 
     It is also the data wrangling backend for packages in 'easystats' ecosystem.
     References: Patil et al. (2022) <doi:10.21105/joss.04684>.
-License: GPL (>= 3)
+License: MIT + file LICENSE
 URL: https://easystats.github.io/datawizard/
 BugReports: https://github.com/easystats/datawizard/issues
 Depends:
     R (>= 3.6)
 Imports:
-    insight (>= 0.19.1),
+    insight (>= 0.19.3.2),
     stats,
     utils
 Suggests: 
@@ -43,6 +43,7 @@ Suggests:
     data.table,
     dplyr (>= 1.0),
     effectsize,
+    emmeans,
     gamm4,
     ggplot2,
     gt,
@@ -77,3 +78,4 @@ Config/Needs/website:
     rstudio/bslib,
     r-lib/pkgdown,
     easystats/easystatstemplate
+Remotes: easystats/insight

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2023 datawizard authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -67,6 +67,7 @@ S3method(describe_distribution,numeric)
 S3method(format,data_codebook)
 S3method(format,dw_data_peek)
 S3method(format,dw_data_tabulate)
+S3method(format,dw_groupmeans)
 S3method(format,parameters_distribution)
 S3method(kurtosis,data.frame)
 S3method(kurtosis,default)
@@ -76,6 +77,9 @@ S3method(labels_to_levels,data.frame)
 S3method(labels_to_levels,default)
 S3method(labels_to_levels,factor)
 S3method(makepredictcall,dw_transformer)
+S3method(means_by_group,data.frame)
+S3method(means_by_group,default)
+S3method(means_by_group,numeric)
 S3method(normalize,data.frame)
 S3method(normalize,factor)
 S3method(normalize,grouped_df)
@@ -86,6 +90,9 @@ S3method(print,data_codebook)
 S3method(print,dw_data_peek)
 S3method(print,dw_data_tabulate)
 S3method(print,dw_data_tabulates)
+S3method(print,dw_groupmeans)
+S3method(print,dw_groupmeans_list)
+S3method(print,dw_transformer)
 S3method(print,parameters_distribution)
 S3method(print,parameters_kurtosis)
 S3method(print,parameters_skewness)
@@ -252,6 +259,7 @@ export(get_columns)
 export(kurtosis)
 export(labels_to_levels)
 export(mean_sd)
+export(means_by_group)
 export(median_mad)
 export(normalize)
 export(print_html)
@@ -272,6 +280,7 @@ export(reverse)
 export(reverse_scale)
 export(row_to_colnames)
 export(rowid_as_column)
+export(rowmean_n)
 export(rownames_as_column)
 export(skewness)
 export(slide)

NEWS.md

@@ -1,5 +1,34 @@
 # datawizard (devel)
 
+NEW FUNCTIONS
+
+* `rowmean_n()`, to compute row means if row contains at least `n` non-missing
+  values.
+
+* `means_by_group()`, to compute mean values of variables, grouped by levels
+  of specified factors.
+
+CHANGES
+
+* `recode_into()` gains an `overwrite` argument to skip overwriting already
+  recoded cases when multiple recode patterns apply to the same case.
+
+* `datawizard` moves from the GPL-3 license to the MIT license.
+
+BUG FIXES
+
+* Fixed issues in `data_write()` when writing labelled data into SPSS format
+  and vectors were of different type as value labels.
+
+* Fixed issue in `recode_into()` with probably wrong case number printed in the
+  warning when several recode patterns match to one case.
+
+* Fixed issue in `data_filter()` where functions containing a `=` (e.g. when
+  naming arguments, like `grepl(pattern, x = a)`) were mistakenly seen as
+  faulty syntax. 
+
+# datawizard 0.8.0
+
 BREAKING CHANGES
 
 * The following re-exported functions from `{insight}` have now been removed:
@@ -42,6 +71,14 @@ NEW FUNCTIONS
 * `data_modify()`, to create new variables, or modify or remove existing
   variables in a data frame.
 
+MINOR CHANGES
+
+* `to_numeric()` for variables of type `Date`, `POSIXct` and `POSIXlt` now
+  includes the class name in the warning message.
+
+* Added a `print()` method for `center()`, `standardize()`, `normalize()` and
+  `rescale()`.
+
 BUG FIXES
 
 * `standardize_parameters()` now works when the package namespace is in the model

R/center.R

@@ -225,7 +225,6 @@ center.data.frame <- function(x,
 }
 
 
-
 #' @export
 center.grouped_df <- function(x,
                               select = NULL,
@@ -276,3 +275,31 @@ center.grouped_df <- function(x,
   attributes(args$x) <- args$info
   args$x
 }
+
+
+# methods -------------------------
+
+#' @export
+print.dw_transformer <- function(x, ...) {
+  print(as.vector(x), ...)
+  vector_info <- NULL
+  if (!is.null(attributes(x)$scale)) {
+    # attributes for center() / standardize()
+    vector_info <- sprintf(
+      "(center: %.2g, scale = %.2g)\n",
+      attributes(x)$center,
+      attributes(x)$scale
+    )
+  } else if (!is.null(attributes(x)$range_difference)) {
+    # attributes for normalize() / rescale()
+    vector_info <- sprintf(
+      "(original range = %.2g to %.2g)\n",
+      attributes(x)$min_value,
+      attributes(x)$min_value + attributes(x)$range_difference
+    )
+  }
+  if (!is.null(vector_info)) {
+    insight::print_color(vector_info, color = "grey")
+  }
+  invisible(x)
+}

R/data_match.R

@@ -311,29 +311,39 @@ data_filter.grouped_df <- function(x, ...) {
   tmp <- gsub(">=", "", tmp, fixed = TRUE)
   tmp <- gsub("!=", "", tmp, fixed = TRUE)
 
-  # Give more informative message to users
-  # about possible misspelled comparisons / logical conditions
-  # check if "=" instead of "==" was used?
-  if (any(grepl("=", tmp, fixed = TRUE))) {
-    insight::format_error(
-      "Filtering did not work. Please check if you need `==` (instead of `=`) for comparison."
-    )
-  }
-  # check if "&&" etc instead of "&" was used?
-  logical_operator <- NULL
-  if (any(grepl("&&", .fcondition, fixed = TRUE))) {
-    logical_operator <- "&&"
-  }
-  if (any(grepl("||", .fcondition, fixed = TRUE))) {
-    logical_operator <- "||"
-  }
-  if (!is.null(logical_operator)) {
-    insight::format_error(
-      paste0(
-        "Filtering did not work. Please check if you need `",
-        substr(logical_operator, 0, 1),
-        "` (instead of `", logical_operator, "`) as logical operator."
+  # We want to check whether user used a "=" in the filter syntax. This
+  # typically indicates that the comparison "==" is probably wrong by using
+  # a "=" instead of `"=="`. However, if a function was provided, we indeed
+  # may have "=", e.g. if the pattern was
+  # `data_filter(out, grep("pattern", x = value))`. We thus first check if we
+  # can identify a function call, and only continue checking for wrong syntax
+  # when we have not identified a function.
+
+  if (!is.function(try(get(gsub("^(.*?)\\((.*)", "\\1", tmp)), silent = TRUE))) {
+    # Give more informative message to users
+    # about possible misspelled comparisons / logical conditions
+    # check if "=" instead of "==" was used?
+    if (any(grepl("=", tmp, fixed = TRUE))) {
+      insight::format_error(
+        "Filtering did not work. Please check if you need `==` (instead of `=`) for comparison."
       )
-    )
+    }
+    # check if "&&" etc instead of "&" was used?
+    logical_operator <- NULL
+    if (any(grepl("&&", .fcondition, fixed = TRUE))) {
+      logical_operator <- "&&"
+    }
+    if (any(grepl("||", .fcondition, fixed = TRUE))) {
+      logical_operator <- "||"
+    }
+    if (!is.null(logical_operator)) {
+      insight::format_error(
+        paste0(
+          "Filtering did not work. Please check if you need `",
+          substr(logical_operator, 0, 1),
+          "` (instead of `", logical_operator, "`) as logical operator."
+        )
+      )
+    }
   }
 }

R/data_modify.R

@@ -101,7 +101,6 @@ data_modify.default <- function(data, ...) {
   insight::format_error("`data` must be a data frame.")
 }
 
-#' @rdname data_modify
 #' @export
 data_modify.data.frame <- function(data, ...) {
   dots <- eval(substitute(alist(...)))
@@ -149,7 +148,17 @@ data_modify.data.frame <- function(data, ...) {
     if (!is.character(symbol)) {
       eval_symbol <- .dynEval(symbol, ifnotfound = NULL)
       if (is.character(eval_symbol)) {
-        symbol <- str2lang(paste0(names(dots)[i], " = ", eval_symbol))
+        symbol <- try(str2lang(paste0(names(dots)[i], " = ", eval_symbol)), silent = TRUE)
+        # we may have the edge-case of having a function that returns a character
+        # vector, like "new_var = sample(letters[1:3])". In this case, "eval_symbol"
+        # is of type character, but no symbol, thus str2lang() above creates a
+        # wrong pattern. We then take "eval_symbol" as character input.
+        if (inherits(symbol, "try-error")) {
+          symbol <- str2lang(paste0(
+            names(dots)[i],
+            " = c(", paste0("\"", eval_symbol, "\"", collapse = ","), ")"
+          ))
+        }
       }
     }
 
@@ -240,7 +249,12 @@ data_modify.grouped_df <- function(data, ...) {
 
   # create new variables as dummys, do for-loop works
   for (i in names(dots)) {
-    data[[i]] <- NA
+    # don't overwrite / fill existing variables with NA,
+    # e.g. if we have "data_modify(iris, Sepal.Length = normalize(Sepal.Length))"
+    # normalize() won't work when we fill with NA
+    if (!i %in% colnames(data)) {
+      data[[i]] <- NA
+    }
   }
 
   # create new variables per group

R/data_write.r

@@ -127,18 +127,30 @@ data_write <- function(data,
     insight::format_alert("Preparing data file: converting variable types.")
   }
   x[] <- lapply(x, function(i) {
+    # make sure we have labelled class for labelled data
     value_labels <- attr(i, "labels", exact = TRUE)
     variable_label <- attr(i, "label", exact = TRUE)
+    # factor requires special preparation to save levels as labels
+    # haven:::vec_cast_named requires "x" and "labels" to be of same type
     if (is.factor(i)) {
-      # factor requires special preparation to save levels as labels
       haven::labelled(
         x = as.numeric(i),
         labels = stats::setNames(seq_along(levels(i)), levels(i)),
         label = variable_label
       )
     } else if (!is.null(value_labels) || !is.null(variable_label)) {
-      # make sure we have labelled class for labelled data
-      haven::labelled(x = i, labels = value_labels, label = variable_label)
+      # character requires special preparation to save value labels
+      # haven:::vec_cast_named requires "x" and "labels" to be of same type
+      if (is.character(i)) {
+        haven::labelled(
+          x = i,
+          labels = stats::setNames(as.character(value_labels), names(value_labels)),
+          label = variable_label
+        )
+      } else {
+        # this should work for the remaining types...
+        haven::labelled(x = i, labels = value_labels, label = variable_label)
+      }
     } else {
       # non labelled data can be saved "as is"
       i