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.

> suppressWarnings(RNGversion("3.5.2"))
> 
> library("partykit")
Loading required package: grid
Loading required package: libcoin
Loading required package: mvtnorm
> set.seed(1)
> 
> dat <- data.frame(v1 = as.double(1:100))
> 
> sv1 <- partysplit(as.integer(1), breaks = as.double(50))
> character_split(sv1, dat)
$name
[1] "v1"

$levels
[1] "<= 50" "> 50" 

> stopifnot(all(kidids_split(sv1, dat) == ((dat$v1 > 50) + 1)))
> 
> sv1 <- partysplit(as.integer(1), breaks = as.double(50), 
+                 index = as.integer(c(2, 1)))
> character_split(sv1, dat)
$name
[1] "v1"

$levels
[1] "> 50"  "<= 50"

> stopifnot(all(kidids_split(sv1, dat) == ((dat$v1 <= 50) + 1)))
> 
> sv1 <- partysplit(as.integer(1), breaks = as.double(50), right = FALSE)
> character_split(sv1, dat)
$name
[1] "v1"

$levels
[1] "< 50"  ">= 50"

> stopifnot(all(kidids_split(sv1, dat) == ((dat$v1 >= 50) + 1)))
> 
> sv1 <- partysplit(as.integer(1), breaks = as.double(50), 
+                 index = as.integer(c(2, 1)), right = FALSE)
> character_split(sv1, dat)
$name
[1] "v1"

$levels
[1] ">= 50" "< 50" 

> stopifnot(all(kidids_split(sv1, dat) == ((dat$v1 < 50) + 1)))
> 
> sv1 <- partysplit(as.integer(1), breaks = as.double(c(25, 75)))
> character_split(sv1, dat)
$name
[1] "v1"

$levels
[1] "(-Inf,25]" "(25,75]"   "(75, Inf]"

> stopifnot(all(kidids_split(sv1, dat) == 
+               as.integer(cut(dat$v1, c(-Inf, 25, 75, Inf)))))
> 
> sv1 <- partysplit(as.integer(1), breaks = as.double(c(25, 75)), right = FALSE)
> character_split(sv1, dat)
$name
[1] "v1"

$levels
[1] "[-Inf,25)" "[25,75)"   "[75, Inf)"

> stopifnot(all(kidids_split(sv1, dat) == 
+               as.integer(cut(dat$v1, c(-Inf, c(25, 75), Inf), right = FALSE))))
> 
> sv1 <- partysplit(as.integer(1), breaks = as.double(c(25, 75)), 
+                 index = as.integer(3:1), right = FALSE)
> character_split(sv1, dat)
$name
[1] "v1"

$levels
[1] "[75, Inf)" "[25,75)"   "[-Inf,25)"

> stopifnot(all(kidids_split(sv1, dat) == 
+               (3:1)[as.integer(cut(dat$v1, c(-Inf, c(25, 75), Inf), right = FALSE))]))
> 
> 
> dat$v2 <- gl(4, 25)
> 
> sv2 <- partysplit(as.integer(2), index = as.integer(c(1, 2, 1, 2)))
> character_split(sv2, dat)
$name
[1] "v2"

$levels
[1] "1, 3" "2, 4"

> kidids_split(sv2, dat)
  [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2
 [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [75] 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
> 
> sv2 <- partysplit(as.integer(2), breaks = as.integer(c(1, 3)))
> character_split(sv2, dat)
$name
[1] "v2"

$levels
[1] "1"    "2, 3" "4"   

> kidids_split(sv2, dat)
  [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2
 [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 [75] 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
> 
> 
> dat <- data.frame(x = gl(3, 30, labels = LETTERS[1:3]), y = rnorm(90), 
+                   z = gl(9, 10, labels = LETTERS[1:9], ordered = TRUE))
> csp <- partysplit(as.integer(1), index = as.integer(c(1, 2, 1)))
> kidids_split(csp, dat)
 [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2
[39] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[77] 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> #kidids_node(list(csp), dat)
> 
> nsp <- partysplit(as.integer(2), breaks = c(-1, 0, 1), index = as.integer(c(1, 2, 1, 3)))
> kidids_split(nsp, dat)
 [1] 2 1 2 3 1 2 1 1 1 2 3 1 2 1 3 2 2 1 1 1 1 1 1 1 1 2 2 1 2 1 3 2 1 2 1 2 2 2
[39] 3 1 2 2 1 1 2 2 1 1 2 1 1 2 1 1 3 3 2 1 1 2 3 2 1 1 2 1 1 3 1 3 1 2 1 2 1 1
[77] 2 1 1 2 2 2 3 1 1 1 3 2 1 1
> 
> osp <- partysplit(as.integer(3), breaks = as.integer(c(3, 6)), index = as.integer(c(2, 1, 2)))
> kidids_split(osp, dat)
 [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1
[39] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
[77] 2 2 2 2 2 2 2 2 2 2 2 2 2 2
> 
> nadat <- dat
> nadat$x[1:10] <- NA
> nadat$y[11:20] <- NA
> #kidids_node(list(csp, nsp, osp), nadat)
> 
> character_split(csp, dat)
$name
[1] "x"

$levels
[1] "A, C" "B"   

> character_split(nsp, dat)
$name
[1] "y"

$levels
[1] "(-Inf,-1] | (0,1]" "(-1,0]"            "(1, Inf]"         

> character_split(osp, dat)
$name
[1] "z"

$levels
[1] "D, E, F"          "A, B, C, G, H, I"

> 
> 
> proc.time()
   user  system elapsed 
   0.75    0.15    0.89