rewrite the fenwick stuff in cpp11 and rebase

Author: vandenman

DESCRIPTION

@@ -40,4 +40,4 @@ Remotes:
   jasp-stats/jaspTTests,
   jasp-stats/jaspTools
 LinkingTo:
-  Rcpp
+  cpp11

NAMESPACE

@@ -1,3 +1,4 @@
+useDynLib(jaspRegression, .registration = TRUE)
 import(jaspBase)
 export(Correlation)
 export(RegressionLinear)

R/concordance.R

@@ -1,12 +1,6 @@
 concordance <- function(x, y) {
-
-  n <- length(x)
-  stopifnot(length(y) == n)
-  if (n == 0L) return(integer(0L))
-  if (n == 1L) return(0L)
-  if (n <= 130) concordance_naive(x, y)
-  concordance_fenwick(x, y)
-
+  stopifnot(length(x) == length(y))
+  concordance_fenwick_cpp(as.double(x), as.double(y))
 }
 
 concordance_naive <- function(x, y) {

R/cpp11.R

@@ -0,0 +1,9 @@
+# Generated by cpp11: do not edit by hand
+
+concordance_naive_cpp <- function(x, y) {
+  .Call(`_jaspRegression_concordance_naive_cpp`, x, y)
+}
+
+concordance_fenwick_cpp <- function(x, y) {
+  .Call(`_jaspRegression_concordance_fenwick_cpp`, x, y)
+}

benchmarks/concordance.html

@@ -9,7 +9,8 @@ execute:
 ---
 
 ```{r, echo=TRUE, include=FALSE}
-library(Rcpp)
+renv::activate(".")
+library(jaspRegression)
 # for benchmarking
 library(bench)
 # for manipulating bench output
@@ -108,10 +109,14 @@ This is the same trick used in fast Kendall’s tau algorithms, but adapted to r
 
 ## 4. Implementation of the optimized solution
 
+The Fenwick tree algorithm is implemented in C++ using `cpp11` in `src/concordance.cpp` and registered as `concordance_fenwick_cpp`.
+For reference, here is the equivalent pure-R implementation:
+
 ```{r}
 #| label: fenwick
-# in-place Fenwick (handles ties in x and y; minimal allocations)
-# the code is a bit messy because R does not allow mutation
+concordance_fenwick_cpp <- jaspRegression:::concordance_fenwick_cpp
+
+# Pure-R reference implementation (kept for documentation)
 concordance_fenwick_inplace <- function(x, y) {
   n <- length(x)
   stopifnot(length(y) == n)
@@ -266,26 +271,24 @@ We compare the naive and optimized versions using the `bench` package.
 #| label: benchmark
 #| cache: false
 
+concordance_naive_cpp <- function(x, y) jaspRegression:::concordance_naive_cpp(as.double(x), as.double(y))
+concordance_fenwick_cpp <-  function(x, y) jaspRegression:::concordance_fenwick_cpp(as.double(x), as.double(y))
+
 # results with ties
 x <- sample(-5:5, 100, TRUE)
 y <- sample(-5:5, 100, TRUE)
 naive     = concordance_naive(x, y)
-naive_cpp = concordanceVector_cpp(x, y)
-fenwick2  = concordance_fenwick_inplace(x, y)
-all(naive == fenwick2) && all(naive_cpp == fenwick2)
+naive_cpp = concordance_naive_cpp(x, y)
+fenwick   = concordance_fenwick_cpp(x, y)
+all(naive == fenwick) && all(naive_cpp == fenwick)
 
 # results without ties
 x <- rnorm(10)
 y <- rnorm(10)
 naive     = concordance_naive(x, y)
-naive_cpp = concordanceVector_cpp(x, y)
-fenwick2  = concordance_fenwick_inplace(x, y)
-all(naive == fenwick2) && all(naive_cpp == fenwick2)
-
-# profvis::profvis({
-#   for (i in 1:10000)
-#     concordance_fenwick_inplace(x, y)
-# })
+naive_cpp = concordance_naive_cpp(x, y)
+fenwick   = concordance_fenwick_cpp(x, y)
+all(naive == fenwick) && all(naive_cpp == fenwick)
 
 orders <- 3
 ns <- c(sapply(seq_len(orders), \(o) {
@@ -300,8 +303,8 @@ res <- suppressWarnings(bench::press(
     y <- rnorm(n)
     bench::mark(
       naive     = concordance_naive(x, y),
-      naive_cpp = concordanceVector_cpp(x, y),
-      fenwick   = concordance_fenwick_inplace(x, y),
+      naive_cpp = concordance_naive_cpp(x, y),
+      fenwick   = concordance_fenwick_cpp(x, y),
       check = TRUE, # ensure results are checked for equality
       iterations = 3
     )
@@ -334,7 +337,7 @@ lm_res <- res |>
     time_slope     = unname(sapply(time_fit, \(x) coef(x)["log10(n)"])),
     mem_intercept  = unname(sapply(mem_fit,  \(x) coef(x)["(Intercept)"])),
     mem_slope      = unname(sapply(mem_fit,  \(x) coef(x)["log10(n)"])),
-    # Remove the temporary columns if you don't need them
+    # Remove the temporary columns
     .keep = "unused"
   )
 
@@ -396,5 +399,6 @@ plot(plt_time + plt_memory + plot_layout(guides = "collect"))
 
 ## 7. Conclusions
 
-* On my machine, the Fenwick approach outperforms the naive approach around $n=$ `r intersection_n_time_rounded[1]` and the naive C++ approach around $n=$ `r intersection_n_time_rounded[2]`. Theoretically, the naive approach is $\mathcal{O}(n^2)$ in time, while the Fenwick approaches is $\mathcal{O}(n \log n)$.
-* The naive approach always uses more memory than the fenwick approach, which uses more memory than the C++ approach. Theoretically, the naive approach is $\mathcal{O}(n^2)$ in memory, while the Fenwick and C++ approaches are $\mathcal{O}(n)$.
+* On my machine, the Fenwick C++ approach outperforms the naive R approach around $n=$ `r intersection_n_time_rounded[1]` and the naive C++ approach around $n=$ `r intersection_n_time_rounded[2]`. Theoretically, the naive approaches are $\mathcal{O}(n^2)$ in time, while the Fenwick approach is $\mathcal{O}(n \log n)$.
+* The naive R approach always uses more memory than the Fenwick and naive C++ approaches. Theoretically, the naive R approach is $\mathcal{O}(n^2)$ in memory, while the Fenwick and naive C++ approaches are $\mathcal{O}(n)$.
+* All C++ implementations use `cpp11` (no Rcpp dependency) for faster compilation.

benchmarks/concordance.qmd

@@ -7881,57 +7881,11 @@
     },
     "renv": {
       "Package": "renv",
-      "Version": "1.1.5",
-      "Source": "Repository",
-      "Type": "Package",
-      "Title": "Project Environments",
-      "Authors@R": "c( person(\"Kevin\", \"Ushey\", role = c(\"aut\", \"cre\"), email = \"kevin@rstudio.com\", comment = c(ORCID = \"0000-0003-2880-7407\")), person(\"Hadley\", \"Wickham\", role = c(\"aut\"), email = \"hadley@rstudio.com\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
-      "Description": "A dependency management toolkit for R. Using 'renv', you can create and manage project-local R libraries, save the state of these libraries to a 'lockfile', and later restore your library as required. Together, these tools can help make your projects more isolated, portable, and reproducible.",
-      "License": "MIT + file LICENSE",
-      "URL": "https://rstudio.github.io/renv/, https://github.com/rstudio/renv",
-      "BugReports": "https://github.com/rstudio/renv/issues",
-      "Imports": [
-        "utils"
-      ],
-      "Suggests": [
-        "BiocManager",
-        "cli",
-        "compiler",
-        "covr",
-        "cpp11",
-        "devtools",
-        "generics",
-        "gitcreds",
-        "jsonlite",
-        "jsonvalidate",
-        "knitr",
-        "miniUI",
-        "modules",
-        "packrat",
-        "pak",
-        "R6",
-        "remotes",
-        "reticulate",
-        "rmarkdown",
-        "rstudioapi",
-        "shiny",
-        "testthat",
-        "uuid",
-        "waldo",
-        "yaml",
-        "webfakes"
-      ],
-      "Encoding": "UTF-8",
-      "RoxygenNote": "7.3.2",
-      "VignetteBuilder": "knitr",
-      "Config/Needs/website": "tidyverse/tidytemplate",
-      "Config/testthat/edition": "3",
-      "Config/testthat/parallel": "true",
-      "Config/testthat/start-first": "bioconductor,python,install,restore,snapshot,retrieve,remotes",
+      "Version": "1.2.1",
+      "OS_type": null,
       "NeedsCompilation": "no",
-      "Author": "Kevin Ushey [aut, cre] (ORCID: <https://orcid.org/0000-0003-2880-7407>), Hadley Wickham [aut] (ORCID: <https://orcid.org/0000-0003-4757-117X>), Posit Software, PBC [cph, fnd]",
-      "Maintainer": "Kevin Ushey <kevin@rstudio.com>",
-      "Repository": "CRAN"
+      "Repository": "CRAN",
+      "Source": "Repository"
     },
     "reshape2": {
       "Package": "reshape2",

renv.lock

@@ -0,0 +1,7 @@
+library/
+local/
+cellar/
+lock/
+python/
+sandbox/
+staging/

renv/.gitignore

@@ -2,7 +2,8 @@
 local({
 
   # the requested version of renv
-  version <- "1.1.5"
+  version <- "1.2.1"
+  attr(version, "md5") <- "4c1fc7ec8f70bf77013fa09fa31b3a4f"
   attr(version, "sha") <- NULL
 
   # the project directory
@@ -168,6 +169,16 @@ local({
     if (quiet)
       return(invisible())
 
+    # also check for config environment variables that should suppress messages
+    # https://github.com/rstudio/renv/issues/2214
+    enabled <- Sys.getenv("RENV_CONFIG_STARTUP_QUIET", unset = NA)
+    if (!is.na(enabled) && tolower(enabled) %in% c("true", "1"))
+      return(invisible())
+  
+    enabled <- Sys.getenv("RENV_CONFIG_SYNCHRONIZED_CHECK", unset = NA)
+    if (!is.na(enabled) && tolower(enabled) %in% c("false", "0"))
+      return(invisible())
+  
     msg <- sprintf(fmt, ...)
     cat(msg, file = stdout(), sep = if (appendLF) "\n" else "")
 
@@ -215,6 +226,20 @@ local({
     section <- header(sprintf("Bootstrapping renv %s", friendly))
     catf(section)
 
+    # ensure the target library path exists; required for file.copy(..., recursive = TRUE)
+    dir.create(library, showWarnings = FALSE, recursive = TRUE)
+  
+    # try to install renv from cache
+    md5 <- attr(version, "md5", exact = TRUE)
+    if (length(md5)) {
+      pkgpath <- renv_bootstrap_find(version)
+      if (length(pkgpath) && file.exists(pkgpath)) {
+        ok <- file.copy(pkgpath, library, recursive = TRUE)
+        if (isTRUE(ok))
+          return(invisible())
+      }
+    }
+  
     # attempt to download renv
     catf("- Downloading renv ... ", appendLF = FALSE)
     withCallingHandlers(
@@ -240,7 +265,6 @@ local({
 
     # add empty line to break up bootstrapping from normal output
     catf("")
-  
     return(invisible())
   }
 
@@ -257,12 +281,20 @@ local({
     repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA)
     if (!is.na(repos)) {
 
-      # check for RSPM; if set, use a fallback repository for renv
-      rspm <- Sys.getenv("RSPM", unset = NA)
-      if (identical(rspm, repos))
-        repos <- c(RSPM = rspm, CRAN = cran)
+      # split on ';' if present
+      parts <- strsplit(repos, ";", fixed = TRUE)[[1L]]
 
-      return(repos)
+      # split into named repositories if present
+      idx <- regexpr("=", parts, fixed = TRUE)
+      keys <- substring(parts, 1L, idx - 1L)
+      vals <- substring(parts, idx + 1L)
+      names(vals) <- keys
+  
+      # if we have a single unnamed repository, call it CRAN
+      if (length(vals) == 1L && identical(keys, ""))
+        names(vals) <- "CRAN"
+  
+      return(vals)
 
     }
 
@@ -511,6 +543,51 @@ local({
 
   }
 
+  renv_bootstrap_find <- function(version) {
+  
+    path <- renv_bootstrap_find_cache(version)
+    if (length(path) && file.exists(path)) {
+      catf("- Using renv %s from global package cache", version)
+      return(path)
+    }
+  
+  }
+  
+  renv_bootstrap_find_cache <- function(version) {
+  
+    md5 <- attr(version, "md5", exact = TRUE)
+    if (is.null(md5))
+      return()
+  
+    # infer path to renv cache
+    cache <- Sys.getenv("RENV_PATHS_CACHE", unset = "")
+    if (!nzchar(cache)) {
+      root <- Sys.getenv("RENV_PATHS_ROOT", unset = NA)
+      if (!is.na(root))
+        cache <- file.path(root, "cache")
+    }
+  
+    if (!nzchar(cache)) {
+      tools <- asNamespace("tools")
+      if (is.function(tools$R_user_dir)) {
+        root <- tools$R_user_dir("renv", "cache")
+        cache <- file.path(root, "cache")
+      }
+    }
+  
+    # start completing path to cache
+    file.path(
+      cache,
+      renv_bootstrap_cache_version(),
+      renv_bootstrap_platform_prefix(),
+      "renv",
+      version,
+      md5,
+      "renv"
+    )
+  
+  }
+  
   renv_bootstrap_download_tarball <- function(version) {
 
     # if the user has provided the path to a tarball via
@@ -979,7 +1056,7 @@ local({
 
   renv_bootstrap_validate_version_release <- function(version, description) {
     expected <- description[["Version"]]
-    is.character(expected) && identical(expected, version)
+    is.character(expected) && identical(c(expected), c(version))
   }
 
   renv_bootstrap_hash_text <- function(text) {
@@ -1158,6 +1235,21 @@ local({
   }
 
   renv_bootstrap_run <- function(project, libpath, version) {
+    tryCatch(
+      renv_bootstrap_run_impl(project, libpath, version),
+      error = function(e) {
+        msg <- paste(
+          "failed to bootstrap renv: the project will not be loaded.",
+          paste("Reason:", conditionMessage(e)),
+          "Use `renv::activate()` to re-initialize the project.",
+          sep = "\n"
+        )
+        warning(msg, call. = FALSE)
+      }
+    )
+  }
+  
+  renv_bootstrap_run_impl <- function(project, libpath, version) {
 
     # perform bootstrap
     bootstrap(version, libpath)
@@ -1181,6 +1273,18 @@ local({
 
   }
 
+  renv_bootstrap_cache_version <- function() {
+    # NOTE: users should normally not override the cache version;
+    # this is provided just to make testing easier
+    Sys.getenv("RENV_CACHE_VERSION", unset = "v5")
+  }
+  
+  renv_bootstrap_cache_version_previous <- function() {
+    version <- renv_bootstrap_cache_version()
+    number <- as.integer(substring(version, 2L))
+    paste("v", number - 1L, sep = "")
+  }
+  
   renv_json_read <- function(file = NULL, text = NULL) {
 
     jlerr <- NULL