R Under development (unstable) (2025-02-03 r87683 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.

> library(Umpire)
> set.seed(97531)
> 
> ce <- ClinicalEngine(666, 4, FALSE)
> N <- nrow(ce)
> dset <- rand(ce, 300)
> cnm <- ClinicalNoiseModel(N) # default shape and scale
> noisy <- blur(cnm, dset$data)
> # next line used to throw a subtle rounding error
> dt <- makeDataTypes(dset$data, 1/3, 1/3, 1/3, 0.3,
+                    range = c(3, 9), exact = FALSE)
> 
> 
> testfun <- function(NF, exact) {
+   ce <- ClinicalEngine(NF, 4, FALSE)
+   N <- nrow(ce)
+   dset <- rand(ce, 300)
+   cnm <- ClinicalNoiseModel(N) # default shape and scale
+   noisy <- blur(cnm, dset$data)
+   dt <- makeDataTypes(dset$data, 1/3, 1/3, 1/3, 0.3,
+                      range = c(3, 9), exact = exact)
+   invisible(dt)
+ }
> 
> dt <- testfun(27, exact = FALSE)
> dim(dt$binned)
[1] 300  27
> table( sapply(dt$cutpoints, function(x) x$Type) )

asymmetric binary        continuous           nominal           ordinal 
                1                 7                 1                 9 
 symmetric binary 
                9 
> 
> dt <- testfun(27, exact = TRUE)
> dim(dt$binned)
[1] 300  27
> table( sapply(dt$cutpoints, function(x) x$Type) )

asymmetric binary        continuous           nominal           ordinal 
                2                 9                 4                 5 
 symmetric binary 
                7 
> 
> dt <- testfun(81, exact = TRUE)
> dim(dt$binned)
[1] 300  81
> table( sapply(dt$cutpoints, function(x) x$Type) )

asymmetric binary        continuous           nominal           ordinal 
                2                27                 6                21 
 symmetric binary 
               25 
> 
> dt <- testfun(28, exact = TRUE)
> dim(dt$binned)
[1] 300  28
> table( sapply(dt$cutpoints, function(x) x$Type) )

asymmetric binary        continuous           nominal           ordinal 
                2                10                 1                 8 
 symmetric binary 
                7 
> 
> dt <- testfun(29, exact = TRUE) # can only get 28 since all blocks are equal size
> dim(dt$binned)
[1] 300  28
> table( sapply(dt$cutpoints, function(x) x$Type) )

      continuous          nominal          ordinal symmetric binary 
              10                2                7                9 
> 
> dt <- testfun(500, exact = FALSE)
> dim(dt$binned)
[1] 300 483
> table( sapply(dt$cutpoints, function(x) x$Type) )

asymmetric binary        continuous           nominal           ordinal 
                8               163                46                94 
 symmetric binary 
              172 
> 
> 
> 
> proc.time()
   user  system elapsed 
   7.90    0.25    8.15