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))))) 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 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))