The R Project SVN R

### ------ Kolmogorov Smirnov (KS) --------------

### ------ 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, "")))