R Under development (unstable) (2024-11-07 r87302 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(DescTools)
> 
> # stopifnot(exprs = {
> #   all.equal(pretty10exp(10^expo, drop.1=TRUE, sub10 = c(-2, 2)),
> #             expression(10^-3, 0.01, 0.1, 1, 10, 100, 10^3, 10^4))
> #   
> #   identical(pretty10exp(10^expo, drop.1=TRUE, sub10 = c(-2, 2), lab.type="latex"),
> #             c("$10^{-3}$", "0.01", "0.1", "1", "10", "100",
> #               "$10^{3}$", "$10^{4}$"))
> #   ## gave exponential format for "latex" case.
> # })
> # 
> 
> set.seed(45)
> (z <- as.numeric(names(w <- table(x <- sample(-10:20, size=50, r=TRUE)))))
 [1] -9 -8 -7 -6 -5 -4 -3 -2  0  3  4  5  6  7  8  9 10 12 13 15 16 17 18 19 20
> 
> stopifnot(all(
+     identical(Mode(5), structure(NA_real_, freq = NA_integer_)) 
+   , identical(Mode(NA), structure(NA_real_, freq = NA_integer_)) 
+   , identical(Mode(c(NA, NA)), structure(NA_real_, freq = NA_integer_)) 
+   , identical(Mode(c(NA, 0:5)), structure(NA_real_, freq = NA_integer_)) 
+   , identical(Mode(c(NA, 0:5), na.rm=TRUE), structure(NA_real_, freq = NA_integer_)) 
+   , identical(Mode(c(NA, 0:5, 5), na.rm=TRUE), structure(5, freq = 2L)) 
+   , identical(Mode(c(0:5, 4, 5, 6)), structure(c(4, 5), freq = 2L)) 
+   , identical(Mode(c(0:8, rep(c(1,3, 8), each=5))), structure(c(1, 3, 8), freq = 6L)) 
+   
+   , all.equal(Kurt(x = z, weights = w, method = 1), Kurt(x = x, method = 1))
+   , all.equal(Kurt(x = z, weights = w, method = 2), Kurt(x = x, method = 2))
+   , all.equal(Kurt(x = z, weights = w, method = 3), Kurt(x = x, method = 3))
+   
+   , all.equal(Skew(x = z, weights = w, method = 1), Skew(x = x, method = 1))
+   , all.equal(Skew(x = z, weights = w, method = 2), Skew(x = x, method = 2))
+   , all.equal(Skew(x = z, weights = w, method = 3), Skew(x = x, method = 3))
+   
+   , all.equal(CoefVar(z, weights = w, unbiased = TRUE), CoefVar(x, unbiased = TRUE))
+   , all.equal(CoefVar(z, weights = w, unbiased = FALSE), CoefVar(x, unbiased = FALSE))
+   
+   , all.equal(MeanAD(x), MeanAD(z, w))
+   , all.equal(MeanAD(x, center = Median), MeanAD(z, w, center = Median))
+   , all.equal(MeanAD(x, center = 7), MeanAD(z, w, center = 7))
+   
+ ))
> 
> 
> 
> # test Desc base function
> 
> x <- c(rnorm(n = 100, sd = 10), NA) 
> z <- Desc(x)[[1]]
> 
> stopifnot(all(  
+   identical(z$length,    length(x))
+   , identical(z$NAs,     sum(is.na(x)))
+   , identical(z$unique,  length(unique(na.omit(x))))
+   , identical(z$`0s`,    sum(x==0, na.rm=TRUE))
+   , IsZero(z$mean - mean(x, na.rm=TRUE))
+   , identical(unname(z$quant), 
+               unname(quantile(x, na.rm=TRUE, probs=c(0,0.05,.1,.25,.5,.75,.9,.95,1))))
+   , identical(z$range,   diff(range(x, na.rm=TRUE)))
+   , IsZero(z$sd - sd(x, na.rm=TRUE))
+   , IsZero(z$vcoef - sd(x, na.rm=TRUE)/mean(x, na.rm = TRUE))
+   , identical(z$mad,     mad(x, na.rm=TRUE))
+   , identical(z$IQR,     IQR(x, na.rm=TRUE))
+ ))
> 
> 
> 
> 
> # test BinomDiffCI with https://www.lexjansen.com/wuss/2016/127_Final_Paper_PDF.pdf
> 
> # 5. Mee is given as 0.0533 in the literature, which probably is a rounding error
> # it's corrected from 0.533 to 0.534 in ‘lit1’ and from 0.7225 to 0.7224 in ‘lit2’ for comparison reasons
> # Mee 4 from  0.0857 to 0.0858
> 
> meth <- c("wald","waldcc","hal","jp","mee","mn","score","scorecc","ha","ac","blj")
> 
> # use all(IsZero(x - y)) to take into account numerical properties of 
> # certain operating systems (especially PowerPC)
> stopifnot(all(
+   all(IsZero(unname(round(BinomDiffCI(56, 70, 48, 80, method = meth), 4)[, -1]) - 
+              cbind(c(0.0575, 0.0441, 0.0535, 0.0531, 0.0534, 
+                      0.0528, 0.0524, 0.0428, 0.0494, 0.0525, 0.054), 
+                    c(0.3425, 0.3559, 0.3351, 0.3355, 0.3377, 
+                      0.3382, 0.3339, 0.3422, 0.3506, 0.3358, 0.34)))),
+   all(IsZero(unname(round(BinomDiffCI(9, 10, 3, 10, method = meth), 4)[, -1]) - 
+             cbind(c(0.2605, 0.1605, 0.1777, 0.176, 0.1821, 
+                     0.17, 0.1705, 0.1013, 0.1922, 0.16, 0.1869), 
+                   c(0.9395, 1, 0.8289, 0.8306, 0.837, 0.8406, 
+                     0.809, 0.8387, 1, 0.84, 0.904)))),
+   all(IsZero(unname(round(BinomDiffCI(10, 10, 0, 20, method = meth), 4)[, -1]) - 
+         cbind(c(1, 0.925, 0.7482, 0.7431, 0.7224, 0.7156, 
+                 0.6791, 0.6014, 0.95, 0.6922, 0.7854), 
+               c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)))), 
+   all(IsZero(unname(round(BinomDiffCI(84, 101, 89, 105, method = meth), 4)[, -1]) - 
+     cbind(c(-0.1162, -0.1259, -0.1152, -0.116, -0.1188, 
+             -0.1191, -0.1177, -0.1245, -0.1216, -0.1168, -0.117), 
+           c(0.0843, 0.094, 0.0834, 0.0843, 0.0858, 0.086, 0.0851, 
+             0.0918, 0.0898, 0.085, 0.0852))))
+ ))
> 
> 
> 
> # test for median, calculated by Quantile
> x <- sample(19, 30, replace = TRUE)
> z <- as.numeric(names(w <- table(x)))
> stopifnot(AllIdentical(Median(z, weights=w), Median(x), median(x), Median(c(x, NA, NA), na.rm=TRUE)))
> 
> x <- sample(40, 30, replace = TRUE)
> z <- as.numeric(names(w <- table(x)))
> stopifnot(AllIdentical(Median(z, weights=w), Median(x), median(x), Median(c(x, NA, NA), na.rm=TRUE)))
> 
> x <- runif(40)
> z <- as.numeric(names(w <- table(x)))
> stopifnot(AllIdentical(Median(z, weights=w), Median(x), median(x), Median(c(x, NA, NA), na.rm=TRUE)))
> 
> 
> ## LogStInv() was wrong for base != 10
> x <- seq(0, 10, by=1/4)
> tx <- LogSt(x, base=2, threshold=6)
> x. <- LogStInv(tx)
> all.equal(x, x., tol = 0) # gave 0.15144. before bug fix
[1] "Mean relative difference: 1.528616e-16"
> stopifnot(all.equal(x, x., tol = 1e-14))
> 
> 
> # Test for correct using of weights in .NormWeights() and Mean()
> stopifnot(AllIdentical(
+   Mean(x=c(0,2,4,6))
+   , Mean(x=c(0,2,4,6), na.rm=TRUE)
+   , Mean(x=c(0,2,4,6), zero.rm=TRUE)
+   , Mean(x=c(0,2,4,6), weights = rep(1, 4), zero.rm=TRUE)
+   , Mean(x=c(0,2,4,6), weights = rep(1, 4), na.rm=TRUE, zero.rm=TRUE)
+ ))
> 
> 
> stopifnot(IsZero(DescTools::HodgesLehmann(c(0.7,0.5,0.5)) - 0.55))
> 
> stopifnot(IsZero(
+             HodgesLehmann(c(50.6, 39.2, 35.2, 17, 11.2, 14.2, 24.2, 37.4, 35.2), 
+                           c(38, 18.6, 23.2, 19, 6.6, 16.4, 14.4, 37.6, 24.4) ) - 7.8))
> 
> 
> 
> 
> proc.time()
   user  system elapsed 
   1.78    0.54    2.26