R Under development (unstable) (2025-06-05 r88281 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> source("incl/start.R")
Loading required package: parallelly
Loading required package: future
> 
> library("datasets") ## cars data set
> library("stats")    ## lm(), poly(), xtabs()
> 
> plan(batchtools_local)
> 
> ## CRAN processing times:
> ## On Windows 32-bit, don't run these tests on batchtools
> if (!fullTest && isWin32) plan(sequential)
> 
> message("*** Globals - formulas ...")
*** Globals - formulas ...
> 
> message("*** Globals - lm(<formula>) ...")
*** Globals - lm(<formula>) ...
> 
> ## From example("lm", package = "stats")
> ctl <- c(4.17, 5.58, 5.18, 6.11, 4.50, 4.61, 5.17, 4.53, 5.33, 5.14)
> trt <- c(4.81, 4.17, 4.41, 3.59, 5.87, 3.83, 6.03, 4.89, 4.32, 4.69)
> group <- gl(2, 10, 20, labels = c("Ctl", "Trt"))
> weight <- c(ctl, trt)
> 
> ## Truth:
> fit0 <- lm(weight ~ group - 1)
> print(fit0)

Call:
lm(formula = weight ~ group - 1)

Coefficients:
groupCtl  groupTrt  
   5.032     4.661  

> 
> ## Explicit future
> f <- future({ lm(weight ~ group - 1) })
[04:38:18.795] Attaching 1 packages ('stats') ...
[04:38:18.812] Attaching 1 packages ('stats') ... done
[04:38:19.906] Launched future #1
> fit <- value(f)
> print(fit)

Call:
lm(formula = weight ~ group - 1)

Coefficients:
groupCtl  groupTrt  
   5.032     4.661  

> stopifnot(all.equal(fit, fit0))
> 
> ## Future assignment
> fit %<-% { lm(weight ~ group - 1) }
[04:38:20.092] Attaching 1 packages ('stats') ...
[04:38:20.103] Attaching 1 packages ('stats') ... done
[04:38:21.972] Launched future #1
> print(fit)

Call:
lm(formula = weight ~ group - 1)

Coefficients:
groupCtl  groupTrt  
   5.032     4.661  

> stopifnot(all.equal(fit, fit0))
> 
> message("*** Globals - lm(<formula>) ... DONE")
*** Globals - lm(<formula>) ... DONE
> 
> 
> message("*** Globals - one-side formulas, e.g. xtabs(~ x) ...")
*** Globals - one-side formulas, e.g. xtabs(~ x) ...
> 
> x <- c(1, 1, 2, 2, 2)
> 
> ## Truth:
> tbl0 <- xtabs(~ x)
> print(tbl0)
x
1 2 
2 3 
> 
> ## Explicit future
> f <- future({ xtabs(~ x) })
[04:38:22.116] Attaching 1 packages ('stats') ...
[04:38:22.127] Attaching 1 packages ('stats') ... done
[04:38:23.425] Launched future #1
> tbl <- value(f)
> print(tbl)
x
1 2 
2 3 
> stopifnot(all.equal(tbl, tbl0))
> 
> ## Future assignment
> tbl %<-% { xtabs(~ x) }
[04:38:23.551] Attaching 1 packages ('stats') ...
[04:38:23.567] Attaching 1 packages ('stats') ... done
[04:38:24.844] Launched future #1
> print(tbl)
x
1 2 
2 3 
> stopifnot(all.equal(tbl, tbl0))
> 
> message("*** Globals - one-side formulas, e.g. xtabs(~ x) ... DONE")
*** Globals - one-side formulas, e.g. xtabs(~ x) ... DONE
> 
> 
> message("*** Globals - lm(<formula>, data = cars) ...")
*** Globals - lm(<formula>, data = cars) ...
> 
> exprs <- list(
+   # "remove-intercept-term" form of no-intercept
+   a = substitute({ lm(dist ~ . - 1, data = cars) }),
+   # "make-intercept-zero" form of no-intercept
+   b = substitute({ lm(dist ~ . + 0, data = cars) }),
+   # doesn't do what we want here
+   c = substitute({ lm(dist ~ speed + speed ^ 2, data = cars) }),
+   # gets us a quadratic term
+   d = substitute({ lm(dist ~ speed + I(speed ^ 2), data = cars) }),
+   # avoid potential multicollinearity
+   e = substitute({ lm(dist ~ poly(speed, 2), data = cars) })
+ )
> 
> for (kk in seq_along(exprs)) {
+   expr <- exprs[[kk]]
+   name <- names(exprs)[kk]
+   mprintf("- Globals - lm(<formula #%d (%s)>, data = cars) ...\n",
+           kk, sQuote(name))
+ 
+   fit0 <- eval(expr)
+   print(fit0)
+ 
+   f <- future(expr, substitute = FALSE)
+   fit <- value(f)
+   print(fit)
+ 
+   stopifnot(all.equal(fit, fit0))
+ } ## for (kk ...)
- Globals - lm(<formula #1 ('a')>, data = cars) ...

Call:
lm(formula = dist ~ . - 1, data = cars)

Coefficients:
speed  
2.909  

[04:38:24.981] Attaching 2 packages ('stats', 'datasets') ...
[04:38:24.990] Attaching 2 packages ('stats', 'datasets') ... done
[04:38:26.142] Launched future #1

Call:
lm(formula = dist ~ . - 1, data = cars)

Coefficients:
speed  
2.909  

- Globals - lm(<formula #2 ('b')>, data = cars) ...

Call:
lm(formula = dist ~ . + 0, data = cars)

Coefficients:
speed  
2.909  

[04:38:26.287] Attaching 2 packages ('stats', 'datasets') ...
[04:38:26.301] Attaching 2 packages ('stats', 'datasets') ... done
[04:38:27.502] Launched future #1

Call:
lm(formula = dist ~ . + 0, data = cars)

Coefficients:
speed  
2.909  

- Globals - lm(<formula #3 ('c')>, data = cars) ...

Call:
lm(formula = dist ~ speed + speed^2, data = cars)

Coefficients:
(Intercept)        speed  
    -17.579        3.932  

[04:38:27.661] Attaching 2 packages ('stats', 'datasets') ...
[04:38:27.678] Attaching 2 packages ('stats', 'datasets') ... done
[04:38:29.098] Launched future #1

Call:
lm(formula = dist ~ speed + speed^2, data = cars)

Coefficients:
(Intercept)        speed  
    -17.579        3.932  

- Globals - lm(<formula #4 ('d')>, data = cars) ...

Call:
lm(formula = dist ~ speed + I(speed^2), data = cars)

Coefficients:
(Intercept)        speed   I(speed^2)  
    2.47014      0.91329      0.09996  

[04:38:29.279] Attaching 2 packages ('stats', 'datasets') ...
[04:38:29.288] Attaching 2 packages ('stats', 'datasets') ... done
[04:38:30.455] Launched future #1

Call:
lm(formula = dist ~ speed + I(speed^2), data = cars)

Coefficients:
(Intercept)        speed   I(speed^2)  
    2.47014      0.91329      0.09996  

- Globals - lm(<formula #5 ('e')>, data = cars) ...

Call:
lm(formula = dist ~ poly(speed, 2), data = cars)

Coefficients:
    (Intercept)  poly(speed, 2)1  poly(speed, 2)2  
          42.98           145.55            23.00  

[04:38:31.269] Attaching 2 packages ('stats', 'datasets') ...
[04:38:31.282] Attaching 2 packages ('stats', 'datasets') ... done
[04:38:32.579] Launched future #1

Call:
lm(formula = dist ~ poly(speed, 2), data = cars)

Coefficients:
    (Intercept)  poly(speed, 2)1  poly(speed, 2)2  
          42.98           145.55            23.00  

> 
> message("*** Globals - lm(<formula>, data = cars) ... DONE")
*** Globals - lm(<formula>, data = cars) ... DONE
> 
> 
> message("*** Globals - map(x, ~ expr) ...")
*** Globals - map(x, ~ expr) ...
> 
> ## A fake purrr::map() function with limited functionality
> map <- function(.x, .f, ...) {
+   if (inherits(.f, "formula")) {
+     expr <- .f[[-1]]
+     .f <- eval(bquote(function(...) {
+       .(expr)
+     }))
+   }
+   eval(lapply(.x, FUN = .f, ...))
+ }
> 
> inner_function <- function(x) { x + 1 }
> 
> outer_function <- function(x) {
+   map(1:2, ~ inner_function(.x))
+ }
> 
> y0 <- outer_function(1L)
> str(y0)
List of 2
 $ : num [1:2] 2 3
 $ : num [1:2] 2 3
> 
> f <- future({ outer_function(1L) })
[04:38:34.335] Launched future #1
> y <- value(f)
> str(y)
List of 2
 $ : num [1:2] 2 3
 $ : num [1:2] 2 3
> stopifnot(all.equal(y, y0))
> 
> y %<-% { outer_function(1L) }
[04:38:35.724] Launched future #1
> str(y)
List of 2
 $ : num [1:2] 2 3
 $ : num [1:2] 2 3
> stopifnot(all.equal(y, y0))
> 
> message("*** Globals - map(x, ~ expr) ... DONE")
*** Globals - map(x, ~ expr) ... DONE
> 
> 
> message("*** Globals - formulas ... DONE")
*** Globals - formulas ... DONE
> 
> source("incl/end.R")
> 
> proc.time()
   user  system elapsed 
   3.37    0.68   18.39