R Under development (unstable) (2024-08-16 r87026 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 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.

> 
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
> 
> n <- 100
> x <- runif(n)
> y <- rnorm(n, mean = sin(x), sd = .1)
> s <- gl(4, n / 4)
> 
> set.seed(29)
> ### estimate with honesty
> cf_ss <- cforest(y ~ x, strata = s, ntree = 5, mtry = 1,
+                  perturb = list(replace = FALSE, fraction = c(.5, .5)))
> ### sample used for tree induction
> stopifnot(sum(tapply(cf_ss$weights[[1]], s, sum)) == n / 2)
> ### sample used for parameter estimation
> stopifnot(sum(tapply(cf_ss$honest_weights[[1]], s, sum)) == n / 2)
> 
> p <- predict(cf_ss)
> 
> set.seed(29)
> ### w/o honesty
> cf_ss2 <- cforest(y ~ x, strata = s, ntree = 5, mtry = 1,
+                   perturb = list(replace = FALSE, fraction = .5))
> 
> stopifnot(sum(tapply(cf_ss2$weights[[1]], s, sum)) == n / 2)
> 
> # random diffs also on other platforms
> #if (.Platform$OS.type != "windows")
> #    stopifnot(all.equal(cf_ss$nodes, cf_ss2$nodes))
> stopifnot(all.equal(cf_ss$weights, cf_ss2$weights))
> stopifnot(all.equal(predict(cf_ss, type = "node"), 
+                     predict(cf_ss2, type = "node")))
> 
> tmp <- cf_ss2
> tmp$weights <- lapply(tmp$weights, function(x) 1L - x)
> pp <- predict(tmp)
> 
> stopifnot(all.equal(p, pp))
> 
> ### bootstrap ignores honesty
> cf_bs <- cforest(y ~ x, strata = s, ntree = 5,
+               perturb = list(replace = TRUE, fraction = c(.5, .5)))
> 
> stopifnot(sum(tapply(cf_bs$weights[[1]], s, sum)) == n)
> stopifnot(is.null(cf_bs$honest_weights))
> 
> proc.time()
   user  system elapsed 
   0.87    0.15    1.01