R Under development (unstable) (2024-05-10 r86529 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.

> ##### several checks for function elementary_symmetric_functions()
> ##### 2012/09/07, BAEK
> 
> 
> ##### preliminaries
> library("psychotools")
> set.seed(1)
> 
> 
> ##################################################
> ##### dichotomous items (zero and first order derivatives)
> ##################################################
> di10 <- runif(10, -2.5, 2.5)
> di20 <- runif(20, -2.5, 2.5) 
> elementary_symmetric_functions(di10)
$`0`
 [1] 1.000000e+00 2.055532e+01 1.538662e+02 5.492526e+02 1.018398e+03
 [6] 1.017086e+03 5.636905e+02 1.734870e+02 2.864725e+01 2.360797e+00
[11] 7.610103e-02

> elementary_symmetric_functions(di20)
$`0`
 [1] 1.000000e+00 4.717688e+01 9.808555e+02 1.197632e+04 9.635106e+04
 [6] 5.424130e+05 2.212806e+06 6.680286e+06 1.510344e+07 2.571547e+07
[11] 3.299332e+07 3.179465e+07 2.286777e+07 1.216735e+07 4.734880e+06
[16] 1.326946e+06 2.618302e+05 3.511236e+04 3.015438e+03 1.481147e+02
[21] 3.135644e+00

> 
> ## with 10 items, everything is fine 
> all.equal(elementary_symmetric_functions(di10, order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di10, order = 1, engine = "C", diff = FALSE)) # R-bin sum vs. C sum
[1] TRUE
> all.equal(elementary_symmetric_functions(di10, order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di10, order = 1, engine = "C", diff = TRUE))  # R-bin sum vs. C diff
[1] TRUE
> all.equal(elementary_symmetric_functions(di10, order = 1, engine = "R", diff = TRUE), elementary_symmetric_functions(di10, order = 1, engine = "C", diff = FALSE))  # R-bin diff vs. C sum
[1] TRUE
> all.equal(elementary_symmetric_functions(di10, order = 1, engine = "R", diff = TRUE), elementary_symmetric_functions(di10, order = 1, engine = "C", diff = TRUE))   # R-bin diff vs. C diff
[1] TRUE
> all.equal(elementary_symmetric_functions(as.list(di10), order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di10, order = 1, engine = "R", diff = FALSE)) # R-poly sum vs. R-bin sum
[1] TRUE
> all.equal(elementary_symmetric_functions(as.list(di10), order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di10, order = 1, engine = "R", diff = TRUE)) # R-poly sum vs. R-bin diff
[1] TRUE
> all.equal(elementary_symmetric_functions(as.list(di10), order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di10, order = 1, engine = "R", diff = FALSE)) # R-poly diff vs. R-bin sum
[1] TRUE
> all.equal(elementary_symmetric_functions(as.list(di10), order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di10, order = 1, engine = "R", diff = TRUE)) # R-poly diff vs. R-bin diff
[1] TRUE
> 
> ## with 20 items we get (rounding) errors for difference algorithm :)
> all.equal(elementary_symmetric_functions(di20, order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di20, order = 1, engine = "C", diff = FALSE)) # R-bin sum vs. C sum
[1] TRUE
> all.equal(elementary_symmetric_functions(di20, order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di20, order = 1, engine = "C", diff = TRUE))  # R-bin sum vs. C diff
[1] "Component \"1\": Mean relative difference: 0.0003812731"
> all.equal(elementary_symmetric_functions(di20, order = 1, engine = "R", diff = TRUE), elementary_symmetric_functions(di20, order = 1, engine = "C", diff = FALSE))  # R-bin diff vs. C sum
[1] "Component \"1\": 'is.NA' value mismatch: 0 in current 1 in target"
Warning message:
In log(gamma1) : NaNs produced
> all.equal(elementary_symmetric_functions(di20, order = 1, engine = "R", diff = TRUE), elementary_symmetric_functions(di20, order = 1, engine = "C", diff = TRUE))   # R-bin diff vs. C diff
[1] "Component \"1\": 'is.NA' value mismatch: 0 in current 1 in target"
Warning message:
In log(gamma1) : NaNs produced
> all.equal(elementary_symmetric_functions(as.list(di20), order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di20, order = 1, engine = "R", diff = FALSE)) # R-poly sum vs. R-bin sum
[1] TRUE
> all.equal(elementary_symmetric_functions(as.list(di20), order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di20, order = 1, engine = "R", diff = TRUE)) # R-poly sum vs. R-bin diff
[1] "Component \"1\": 'is.NA' value mismatch: 1 in current 0 in target"
Warning message:
In log(gamma1) : NaNs produced
> all.equal(elementary_symmetric_functions(as.list(di20), order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di20, order = 1, engine = "R", diff = FALSE)) # R-poly diff vs. R-bin sum
[1] TRUE
> all.equal(elementary_symmetric_functions(as.list(di20), order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(di20, order = 1, engine = "R", diff = TRUE)) # R-poly diff vs. R-bin diff
[1] "Component \"1\": 'is.NA' value mismatch: 1 in current 0 in target"
Warning message:
In log(gamma1) : NaNs produced
> 
> ## second order derivatives (only implemented for R-bin sum/diff)
> all.equal(elementary_symmetric_functions(di10, order = 2, engine = "R", diff = FALSE), elementary_symmetric_functions(di10, order = 2, engine = "R", diff = TRUE)) # R-bin sum vs. R-bin diff
[1] TRUE
> all.equal(elementary_symmetric_functions(di20, order = 2, engine = "R", diff = FALSE), elementary_symmetric_functions(di10, order = 2, engine = "R", diff = TRUE)) # R-bin sum vs. R-bin diff
[1] "Component \"0\": Numeric: lengths (21, 11) differ"                                      
[2] "Component \"1\": Attributes: < Component \"dim\": Mean relative difference: 0.4878049 >"
[3] "Component \"1\": Numeric: lengths (420, 110) differ"                                    
[4] "Component \"2\": Attributes: < Component \"dim\": Mean relative difference: 0.4918033 >"
[5] "Component \"2\": Numeric: lengths (8400, 1100) differ"                                  
> 
> 
> ##################################################
> ##### polytomous items (zero and first order derivatives)
> ##################################################
> pi10 <- unname(split(runif(10, -2.5, 2.5), factor(rep(1:5, each = 2))))
> pi20 <- unname(split(runif(20, -2.5, 2.5), factor(rep(1:10, each = 2))))
> elementary_symmetric_functions(pi10)
$`0`
 [1]   1.000000   2.877547  17.409618  35.128538  93.142712 122.857021
 [7] 166.381830 135.480720  95.407269  37.673980  13.910708

> elementary_symmetric_functions(pi20)
$`0`
 [1] 1.000000e+00 2.644761e+01 2.657538e+02 1.418158e+03 5.094068e+03
 [6] 1.364425e+04 2.853812e+04 4.831630e+04 6.757728e+04 7.900700e+04
[11] 7.790678e+04 6.498572e+04 4.579809e+04 2.714372e+04 1.337284e+04
[16] 5.374640e+03 1.709608e+03 4.077618e+02 6.617534e+01 6.150293e+00
[21] 2.341581e-01

> 
> ## with 10 items, everything is fine.
> all.equal(elementary_symmetric_functions(pi10, order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(pi10, order = 1, engine = "C", diff = FALSE)) # R-poly sum vs. C sum
[1] TRUE
> all.equal(elementary_symmetric_functions(pi10, order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(pi10, order = 1, engine = "C", diff = TRUE))  # R-poly sum vs. C diff
[1] TRUE
> all.equal(elementary_symmetric_functions(pi10, order = 1, engine = "R", diff = TRUE), elementary_symmetric_functions(pi10, order = 1, engine = "C", diff = FALSE))  # R-poly diff vs. C sum
[1] TRUE
> all.equal(elementary_symmetric_functions(pi10, order = 1, engine = "R", diff = TRUE), elementary_symmetric_functions(pi10, order = 1, engine = "C", diff = TRUE))   # R-poly diff vs. C diff
[1] TRUE
> 
> ## with 20 items we get (rounding) errors for difference algorithm :)
> all.equal(elementary_symmetric_functions(pi20, order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(pi20, order = 1, engine = "C", diff = FALSE)) # R-poly sum vs. C sum
[1] TRUE
> all.equal(elementary_symmetric_functions(pi20, order = 1, engine = "R", diff = FALSE), elementary_symmetric_functions(pi20, order = 1, engine = "C", diff = TRUE))  # R-poly sum vs. C diff
[1] "Component \"1\": Mean relative difference: 0.008490914"
> all.equal(elementary_symmetric_functions(pi20, order = 1, engine = "R", diff = TRUE), elementary_symmetric_functions(pi20, order = 1, engine = "C", diff = FALSE))  # R-poly diff vs. C sum
[1] "Component \"1\": Mean relative difference: 0.004992452"
> all.equal(elementary_symmetric_functions(pi20, order = 1, engine = "R", diff = TRUE), elementary_symmetric_functions(pi20, order = 1, engine = "C", diff = TRUE))   # R-poly diff vs. C diff
[1] "Component \"1\": Mean relative difference: 0.003792352"
> 
> 
> ##################################################
> ##### check 'check'
> ##################################################
> all.equal(elementary_symmetric_functions(di10, order = 1), elementary_symmetric_functions(as.list(di10), order = 1)) # dichotomous items as list / vector
[1] TRUE
> inherits(try(elementary_symmetric_functions(di10, log = FALSE, engine = "C")), "try-error")                          # input on log scale for dichotmous items not possible (engine C)
Error in elementary_symmetric_functions(di10, log = FALSE, engine = "C") : 
  log is not TRUE
[1] TRUE
> inherits(try(elementary_symmetric_functions(pi10, log = FALSE, engine = "R")), "try-error")                          # input on log scale for polytomous items not possible (engine R)
Error in elementary_symmetric_functions(pi10, log = FALSE, engine = "R") : 
  log is not TRUE
[1] TRUE
> inherits(try(elementary_symmetric_functions(pi10, log = FALSE, engine = "C")), "try-error")                          # input on log scale for polytomous items not possible (engine C)
Error in elementary_symmetric_functions(pi10, log = FALSE, engine = "C") : 
  log is not TRUE
[1] TRUE
> inherits(try(elementary_symmetric_functions(di10, order = 2, engine = "C")), "try-error")                            # second order derivatives for dichotmous items not possible (engine C)
[1] FALSE
Warning message:
In elementary_symmetric_functions(di10, order = 2, engine = "C") :
  Second order ESFs are not available in C, changed to R.
> inherits(try(elementary_symmetric_functions(pi10, order = 2, engine = "R")), "try-error")                          # second order derivatives for polytomous items not possible (engine R)
Error in elementary_symmetric_functions(pi10, order = 2, engine = "R") : 
  Second order ESFs are not available for polytomous items.
[1] TRUE
> inherits(try(elementary_symmetric_functions(pi10, order = 2, engine = "C")), "try-error")                          # second order derivatives for polytomous items not possible (engine C)
Error in elementary_symmetric_functions(pi10, order = 2, engine = "C") : 
  Second order ESFs are not available for polytomous items.
[1] TRUE
> 
> proc.time()
   user  system elapsed 
   0.29    0.09    0.36