Fix memory allocation issues (#888)

* Fix memory allocation issues

* cran comments

* add test

* lintr

* prepare CRAN submit

* allow httr as well

* add back test

* submitted

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 0.20.0
-Date: 2024-06-03 12:54:55 UTC
-SHA: 40c4fbce021ca275d823719e60f74717ff61f33d
+Version: 0.20.1
+Date: 2024-06-11 14:53:20 UTC
+SHA: 622b973d4f2c62cb42d6fc4b4c04907533096fcb

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.20.0
+Version: 0.20.1
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -93,7 +93,7 @@ Suggests:
     betareg,
     bife,
     biglm,
-    blavaan,
+    blavaan (>= 0.5-5),
     blme,
     boot,
     brms,
@@ -130,6 +130,7 @@ Suggests:
     grDevices,
     gt,
     httptest2,
+    httr,
     httr2,
     interp,
     ivreg,

NEWS.md

@@ -1,3 +1,10 @@
+# insight 0.20.1
+
+## Bug fixes
+
+* Fixed possible memory allocation issues when the deprecated argument `at` was
+  used in `get_datagrid()`.
+
 # insight 0.20.0
 
 ## Breaking

R/download_model.R

@@ -32,11 +32,54 @@ download_model <- function(name,
                            url = "https://raw.github.com/easystats/circus/master/data/",
                            extension = ".rda",
                            verbose = TRUE) {
-  .download_data_github(name, url, extension, verbose)
+  if (check_if_installed("httr2", quietly = TRUE)) {
+    .download_data_httr2(name, url, extension, verbose)
+  } else {
+    .download_data_httr(name, url, extension, verbose)
+  }
+}
+
+
+# Download rda files from github, using httr
+.download_data_httr <- function(name, url, extension, verbose) {
+  check_if_installed("httr", "to download models from the circus-repo")
+
+  url <- paste0(url, name, extension)
+
+  temp_file <- tempfile()
+  on.exit(unlink(temp_file))
+
+  result <- tryCatch(
+    {
+      request <- httr::GET(url)
+      httr::stop_for_status(request)
+    },
+    error = function(e) {
+      if (verbose) {
+        format_alert(
+          "Could not download model. Request failed with following error:",
+          e$message
+        )
+      }
+      NULL
+    }
+  )
+  if (is.null(result)) {
+    return(NULL)
+  }
+
+  writeBin(httr::content(request, type = "raw"), temp_file)
+
+  x <- load(temp_file)
+  model <- get(x)
+  rm(x)
+
+  model
 }
 
 
-.download_data_github <- function(name, url, extension = ".rda", verbose = TRUE) {
+# Download rda files from github, using httr2
+.download_data_httr2 <- function(name, url, extension = ".rda", verbose = TRUE) {
   check_if_installed("httr2", "to download models from the circus-repo")
 
   url <- paste0(url, name, extension)

R/get_datagrid.R

@@ -195,10 +195,10 @@ get_datagrid.data.frame <- function(x,
                                     reference = x,
                                     length = 10,
                                     range = "range",
-                                    at = NULL,
+                                    at,
                                     ...) {
   ## TODO: deprecate later
-  if (!is.null(at)) {
+  if (!missing(at)) {
     format_warning("Argument `at` is deprecated and will be removed in a future release. Please use `by` instead.") # nolint
     by <- at
   }
@@ -668,15 +668,15 @@ get_datagrid.logical <- get_datagrid.character
             spread <- stats::mad(x, na.rm = TRUE)
             by_expression <- paste0("c(", center - spread, ",", center, ",", center + spread, ")")
           } else if (parts == "quartiles") {
-            by_expression <- paste0("c(", paste0(as.vector(stats::quantile(x, na.rm = TRUE)), collapse = ","), ")")
+            by_expression <- paste0("c(", paste(as.vector(stats::quantile(x, na.rm = TRUE)), collapse = ","), ")")
           } else if (parts == "quartiles2") {
-            by_expression <- paste0("c(", paste0(as.vector(stats::quantile(x, na.rm = TRUE))[2:4], collapse = ","), ")")
+            by_expression <- paste0("c(", paste(as.vector(stats::quantile(x, na.rm = TRUE))[2:4], collapse = ","), ")")
           } else if (parts == "terciles") {
-            by_expression <- paste0("c(", paste0(as.vector(stats::quantile(x, probs = (1:2) / 3, na.rm = TRUE)), collapse = ","), ")") # nolint
+            by_expression <- paste0("c(", paste(as.vector(stats::quantile(x, probs = (1:2) / 3, na.rm = TRUE)), collapse = ","), ")") # nolint
           } else if (parts == "terciles2") {
-            by_expression <- paste0("c(", paste0(as.vector(stats::quantile(x, probs = (0:3) / 3, na.rm = TRUE)), collapse = ","), ")") # nolint
+            by_expression <- paste0("c(", paste(as.vector(stats::quantile(x, probs = (0:3) / 3, na.rm = TRUE)), collapse = ","), ")") # nolint
           } else if (parts == "fivenum") {
-            by_expression <- paste0("c(", paste0(as.vector(stats::fivenum(x, na.rm = TRUE)), collapse = ","), ")")
+            by_expression <- paste0("c(", paste(as.vector(stats::fivenum(x, na.rm = TRUE)), collapse = ","), ")")
           } else if (parts == "zeromax") {
             by_expression <- paste0("c(0,", max(x, na.rm = TRUE), ")")
           } else if (parts == "minmax") {
@@ -743,10 +743,10 @@ get_datagrid.default <- function(x,
                                  include_response = FALSE,
                                  data = NULL,
                                  verbose = TRUE,
-                                 at = NULL,
+                                 at,
                                  ...) {
   ## TODO: deprecate later
-  if (!is.null(at)) {
+  if (!missing(at)) {
     format_warning("Argument `at` is deprecated and will be removed in a future release. Please use `by` instead.") # nolint
     by <- at
   }

cran-comments.md

@@ -1,9 +1 @@
-This release fixes errors in CRAN checks.
-
-Additionally, in the process of stabilizing the API/user interface for packages
-from the 'easystats' project, some argument names were renamed and old names
-have been deprecated. This will *not break* downstream dependent packages, however,
-reverse-dependency checks will raise warnings. We have already patched all
-affected downstream packages and will submit them to CRAN in the next few days,
-after the release of 'insight'. Once this release-cycle is complete, all
-warnings due to deprecated argument names should be resolved.
+This is a hotfix release that fixes memory allocation issues when `insight::get_datagrid()` was called with the deprecated argument `at = NULL`.

tests/testthat/test-clean_parameters.R

@@ -1,6 +1,5 @@
 test_that("clean_parameters blavaan", {
   skip_on_cran()
-  skip_if(TRUE) ## FIXME: blavaan is currently broken
   skip_if_not_installed("blavaan")
   skip_if_not_installed("lavaan")
   skip_if_not_installed("Rcpp")

tests/testthat/test-get_datagrid.R

@@ -294,7 +294,6 @@ test_that("factor levels as reference / non-focal terms works", {
 })
 
 
-
 test_that("get_datagrid - multiple weight variables", {
   skip_if_not_installed("nlme")
   data("Orthodont", package = "nlme")
@@ -313,3 +312,15 @@ test_that("get_datagrid - multiple weight variables", {
     tolerance = 1e-3
   )
 })
+
+
+test_that("get_datagrid - deprecated arg doesn't cause memory allocation issues", {
+  data(iris)
+  expect_warning(
+    {
+      out <- get_datagrid(iris, at = NULL)
+    },
+    regex = "Argument `at` is deprecated"
+  )
+  expect_identical(nrow(out), 1L)
+})