| #### Some examples of the KS and Wilcoxon tests |
| |
| ### ------ Kolmogorov Smirnov (KS) -------------- |
| |
| ## unrealistic one of PR#14561 |
| ds1 <- c(1.7,2,3,3,4,4,5,5,6,6) |
| ks.test(ds1, "pnorm", mean = 3.3, sd = 1.55216) |
| # how on earth can sigma = 1.55216 be known? |
| |
| # R >= 2.14.0 allows the equally invalid |
| ks.test(ds1, "pnorm", mean = 3.3, sd = 1.55216, exact = TRUE) |
| |
| ## Try out the effects of rounding |
| set.seed(123) |
| ds2 <- rnorm(1000) |
| ks.test(ds2, "pnorm") # exact = FALSE is default for n = 1000 |
| ks.test(ds2, "pnorm", exact = TRUE) |
| ## next two are still close |
| ks.test(round(ds2, 2), "pnorm") |
| ks.test(round(ds2, 2), "pnorm", exact = TRUE) |
| # now D has doubled, but p-values remain similar (if very different from ds2) |
| ks.test(round(ds2, 1), "pnorm") |
| ks.test(round(ds2, 1), "pnorm", exact = TRUE) |
| |
| |
| ### ------ Wilkoxon (Mann Whitney) -------------- |
| |
| options(nwarnings = 1000) |
| (alts <- setNames(, eval(formals(stats:::wilcox.test.default)$alternative))) |
| x0 <- 0:4 |
| (x.set <- list(s0 = lapply(x0, function(m) 0:m), |
| s. = lapply(x0, function(m) c(1e-9, seq_len(m))))) |
| stats <- setNames(nm = c("statistic", "p.value", "conf.int", "estimate")) |
| |
| ## Even with conf.int = TRUE, do not want errors : |
| RR <- |
| lapply(x.set, ## for all data sets |
| function(xs) |
| lapply(alts, ## for all three alternatives |
| function(alt) |
| lapply(xs, function(x) |
| ## try( |
| wilcox.test(x, exact=TRUE, conf.int=TRUE, alternative = alt) |
| ## ) |
| ))) |
| length(ww <- warnings()) # 52 (or 43 for x0 <- 0:3) |
| unique(ww) # 4 different ones |
| |
| cc <- lapply(RR, function(A) lapply(A, function(bb) lapply(bb, class))) |
| table(unlist(cc)) |
| ## in R <= 3.3.1, with try( .. ) above, we got |
| ## htest try-error |
| ## 23 7 |
| uc <- unlist(cc[["s0"]]); noquote(names(uc)[uc != "htest"]) ## these 7 cases : |
| ## two.sided1 two.sided2 two.sided3 |
| ## less1 less2 |
| ## greater1 greater2 |
| |
| ##--- How close are the stats of (0:m) to those of (eps, 1:m) ------------ |
| |
| ## a version that still works with above try(.) and errors there: |
| getC <- function(L, C) if(inherits(L,"try-error")) c(L) else L[[C]] |
| stR <- lapply(stats, function(COMP) |
| lapply(RR, function(A) |
| lapply(A, function(bb) |
| lapply(bb, getC, C=COMP) ))) |
| |
| ## a) P-value |
| pv <- stR[["p.value"]] |
| ## only the first is NaN, all others in [0,1]: |
| sapply(pv$s0, unlist) |
| sapply(pv$s., unlist) # not really close, but .. |
| |
| pv$s0$two.sided[1] <- 1 ## artificially |
| stopifnot(all.equal(pv$s0, pv$s., tol = 0.5 + 1e-6), # seen 0.5 |
| ## "less" are close: |
| all.equal(unlist(pv[[c("s0","less")]]), |
| unlist(pv[[c("s.","less")]]), tol = 0.03), |
| 0 <= unlist(pv), unlist(pv) <= 1) # <- no further NA .. |
| ## b) |
| sapply(stR[["statistic"]], unlist) |
| ## Conf.int.: |
| ## c) |
| sapply(stR[["estimate" ]], unlist) |
| ## d) confidence interval |
| formatCI <- function(ci) |
| sprintf("[%g, %g] (%g%%)", ci[[1]], ci[[2]], |
| round(100*attr(ci,"conf.level"))) |
| nx <- length(x0) |
| noquote(vapply(stR[["conf.int"]], function(ss) |
| vapply(ss, function(alt) vapply(alt, formatCI, ""), character(nx)), |
| matrix("", nx, length(alts)))) |
| |
| |
| ##-------- 2-sample tests (working unchanged) ------------------ |
| |
| R2 <- lapply(alts, ## for all three alternatives |
| function(alt) |
| lapply(seq_along(x0), function(k) |
| wilcox.test(x = x.set$s0[[k]], y = x.set$s.[[k]], |
| exact=TRUE, conf.int=TRUE, alternative = alt))) |
| length(w2 <- warnings()) # 27 |
| unique(w2) # 3 different ones |
| |
| table(uc2 <- unlist(c2 <- lapply(R2, function(A) lapply(A, class)))) |
| stopifnot(uc2 == "htest") |
| |
| stR2 <- lapply(stats, |
| function(COMP) |
| lapply(R2, function(A) lapply(A, getC, C=COMP))) |
| |
| lapply(stats[-3], ## -3: "conf.int" separately |
| function(ST) sapply(stR2[[ST]], unlist)) |
| |
| noquote(sapply(stR2[["conf.int"]], function(.) vapply(., formatCI, ""))) |
| |