tests/bugfixes.R

In coin: Conditional Inference Procedures in a Permutation Test Framework

### Regression tests for fixed bugs

suppressWarnings(RNGversion("3.5.2"))
set.seed(290875)
library("coin")
isequal <- coin:::isequal
`%GE%` <- coin:::`%GE%`
options(useFancyQuotes = FALSE)

### I() returns objects of class "AsIs" causing errors in 'trafo'
df <- data.frame(x1 = rnorm(100), x2 = rnorm(100), x3 = gl(2, 50),
                 x4 = I(letters[1:20]))
df <- within(df, {
    x5 <- x1 / x2
    x6 <- x1 < 0
})
it1 <- independence_test(I(x1 / x2) ~ x3, data = df)
it2 <- independence_test(x5 ~ x3, data = df)
stopifnot(identical(statistic(it1), statistic(it2))) # was OK
it3 <- independence_test(I(x1 < 0) ~ x3, data = df)
it4 <- independence_test(x6 ~ x3, data = df)
stopifnot(identical(statistic(it3), statistic(it4))) # wrong sign
try(independence_test(x4 ~ x3, data = df))           # coercion to numeric

### expectation was wrong when varonly = TRUE in case both
### xtrafo and ytrafo were multivariate
if (require("multcomp")) {
    df <- data.frame(x = runif(30), y = runif(30), z = gl(3, 10))
    a <- independence_test(x + y ~ z, data = df,
         distribution = approximate(nresample = 19999),
         xtrafo = function(data) trafo(data, factor_trafo = function(x)
             model.matrix(~x - 1) %*% t(contrMat(table(x), "Tukey"))))
    b <- independence_test(x + y ~ z, data = df,
         xtrafo = function(data) trafo(data, factor_trafo = function(x)
             model.matrix(~x - 1) %*% t(contrMat(table(x), "Tukey"))))
    isequal(expectation(a), expectation(b))
}


### 'statistic' for linear and standardized statistics was wrong in case of
### scores
data("jobsatisfaction")
stopifnot(unique(dim(statistic(lbl_test(jobsatisfaction), "linear"))) == 1)
stopifnot(unique(dim(statistic(lbl_test(jobsatisfaction), "standardized"))) == 1)


### support() failed in most cases
df <- data.frame(x = runif(20), y = runif(20), z = gl(2, 10))
stopifnot(is.na(support(independence_test(x ~ z, data = df))))
stopifnot(is.na(support(independence_test(x ~ z, data = df, teststat = "quad"))))
ite <- independence_test(I(round(x, 1)) ~ z, data = df, dist = exact())
ae <- support(ite)
de <- dperm(ite, ae)
stopifnot(isequal(sum(de), 1))
pe <- pperm(ite, ae)
stopifnot(isequal(cumsum(de), pe))
ita <- independence_test(I(round(x, 1)) ~ z, data = df,
                         dist = approximate(nresample = 100000))
aa <- support(ita)
da <- dperm(ita, aa)
stopifnot(isequal(sum(da), 1))
pa <- pperm(ita, aa)
stopifnot(isequal(cumsum(da), pa))
mean(round(ae, 10) %in% round(aa, 10))

plot(aa, da, type = "s", lty = 1)
lines(ae, de, type = "s", lty = 2)
itas <- independence_test(I(round(x, 1)) ~ z, data = df)
lines(ae[-1], diff(sapply(ae, function(x) pperm(itas, x))), lty = 3)
legend("topleft", lty = 1:3, legend = c("approx", "exact", "asympt"), bty = "n")

### check correct handling of multiple censoring indicators (in modeltools)
### was never wrong, just in case...
data("photocar", package = "coin")
i1 <- independence_test(Surv(time, event) + Surv(dmin, tumor) + ntumor ~ group,
                  data = photocar)
i2 <- independence_test(Surv(time, event) ~ group, data = photocar)
i3 <- independence_test(Surv(dmin, tumor) ~ group, data = photocar)

stopifnot(max(abs(statistic(i1, "standardized")[,1] -
                  statistic(i2, "stand"))) < sqrt(.Machine$double.eps))
stopifnot(max(abs(statistic(i1, "standardized")[,2] -
                  statistic(i3, "stand"))) < sqrt(.Machine$double.eps))

### check new var_trafo argument
x <- rnorm(20)
y <- gl(2, 10)
a <- trafo(data.frame(x = x, y = y), numeric_trafo = normal_trafo)
b <- trafo(data.frame(x = x, y = y), var_trafo = list(x = normal_trafo))
stopifnot(isequal(a, b))

### check for multiple ordered factors
mydf <- data.frame(x = ordered(gl(4, 5)), y = ordered(gl(5, 4)),
                   z = rnorm(20))
it1 <- independence_test(x + y ~ z , data = mydf)
stopifnot(isequal(drop(statistic(it1, "linear")),
          c(statistic(independence_test(x ~ z , data = mydf), "linear"),
            statistic(independence_test(y ~ z , data = mydf), "linear"))))
it1 <- independence_test(x + z ~ y , data = mydf)
stopifnot(isequal(drop(statistic(it1, "linear")),
          c(statistic(independence_test(x ~ y , data = mydf), "linear"),
            statistic(independence_test(z ~ y , data = mydf), "linear"))))
it1 <- independence_test(z ~ x + y , data = mydf)
stopifnot(isequal(drop(statistic(it1, "linear")),
          c(statistic(independence_test(z ~ x , data = mydf), "linear"),
            statistic(independence_test(z ~ y , data = mydf), "linear"))))

### NA's and weights
mydf <- data.frame(x = 1:10, y = gl(2, 5), w = rep(2, 10))
s <- statistic(independence_test(x ~ y, data = mydf, weights = ~ w), "linear")
stopifnot(s == 30)
mydf$x[1] <- NA
s <- statistic(independence_test(x ~ y, data = mydf, weights = ~ w), "linear")
stopifnot(s == 28)

### two observations only
mydf <- data.frame(x = 1:10, y = factor(rep(c(1, 2), 5)))
independence_test(y ~ x, data = mydf, subset = c(1, 6))
independence_test(y ~ x, data = mydf, subset = c(1, 2))
try(independence_test(y ~ x, data = mydf, subset = 1))

### names of expectation and covariance
YOY <- data.frame(length = c(46, 28, 46, 37, 32, 41, 42, 45, 38, 44,
                             42, 60, 32, 42, 45, 58, 27, 51, 42, 52,
                             38, 33, 26, 25, 28, 28, 26, 27, 27, 27,
                             31, 30, 27, 29, 30, 25, 25, 24, 27, 30),
                  site = factor(c(rep("I", 10), rep("II", 10),
                                  rep("III", 10), rep("IV", 10))))

it <- independence_test(length ~ site, data = YOY,
    ytrafo = function(data) trafo(data, numeric_trafo = rank_trafo),
    teststat = "quad")
expectation(it)
covariance(it)

mydf <- data.frame(x = rnorm(10), y = rnorm(10), z = gl(2, 5))
it <- independence_test(x + y ~ z, data = mydf)
statistic(it, "linear")
expectation(it)
covariance(it)

### maxstat_trafo
n <- seq(from = 5, to = 100, by = 1)
for (i in n) {
   x <- round(rnorm(i) * 10, 1)
   xm <- maxstat_trafo(x)
   stopifnot(min(c(mean(xm[,1]), 1 - mean(xm[,ncol(xm)])) - 0.1) >
             -sqrt(.Machine$double.eps))
}

### formula evaluation in 'parent.frame()', spotted by Z
foo <- function(x, y) independence_test(y ~ x)
a <- 1:10
b <- 1:10
foo(a, b)
x <- 1
y <- 1
foo(a, b)

### factors with only one level
dat <- data.frame(y = rnorm(100), x1 = runif(100), x2 = factor(rep(0, 100)))
try(independence_test(y ~ x1  + x2, data = dat))

### user specified g: names, MC
me <- as.table(matrix(c( 6,  8, 10,
               32, 47, 20), byrow = TRUE, nrow = 2,
    dimnames = list(group = c("In situ", "Control"),
                    genotype = c("AA", "AG", "GG"))))
medf <- as.data.frame(me)

add <- c(0, 1, 2)
dom <- c(0, 1, 1)
rez <- c(0, 0, 1)
g <- function(x) {
    x <- unlist(x)
    cbind(add[x], dom[x], rez[x])
}
it <- independence_test(group ~ genotype,
    data = medf, weights = ~ Freq, xtrafo = g)
statistic(it, "linear")

it <- independence_test(group ~ genotype,
    data = medf, weights = ~ Freq, xtrafo = g,
    distribution = approximate(nresample = 49999))
pvalue(it)

stopifnot(all.equal(statistic(independence_test(t(me), xtrafo = g), "linear"),
                    statistic(it, "linear")))

### alternative trafo for ordered variables didn't work
### spotted by Ludwig Hothorn <hothorn@biostat.uni-hannover.de>
tmp <- data.frame(x = ordered(sample(1:3, 20, replace = TRUE)), y = rnorm(20))
it1 <- independence_test(y ~ x, data = tmp, scores = list(x = c(1, 1, 2)))
g <- function(x) c(1, 1, 2)[unlist(x)]
it2 <- independence_test(y ~ x, data = tmp, xtrafo = g)
it3 <- independence_test(y ~ x, data = tmp,
    xtrafo = function(data) trafo(data, ordered_trafo = g))
stopifnot(all.equal(statistic(it1), statistic(it2)))
stopifnot(all.equal(statistic(it1), statistic(it3)))

### precision problems in SR algorithm, >= <= issue
### spotted by "Fay, Michael (NIH/NIAID) [E]" <mfay@niaid.nih.gov>
x <- c(1,2,3.1,4,5,6)
g <- factor(c(0,0,0,1,1,1))
it <- independence_test(x ~ g, distribution = exact())
stopifnot(pvalue(it) == 0.1)
itMC <- independence_test(x ~ g, distribution = approximate(99999))
ci <- attr(pvalue(itMC), "conf.int")
stopifnot(ci[1] < pvalue(it) && ci[2] > pvalue(it))

### any() not applied to logicals
### spotted by R-2.7.0 and Kaspar Daniel Hansen
x <- c(1.83,  0.50,  1.62,  2.48, 1.68, 1.88, 1.55, 3.06, 1.30)
y <- c(0.878, 0.647, 0.598, 2.05, 1.06, 1.29, 1.06, 3.14, 1.29)
### must not give a warning
wilcoxsign_test(x ~ y, alternative = "greater",
                distribution = exact())

### inconsistencies with confidence intervals
### spotted by Fritz Scholz <fscholz@u.washington.edu>
Route = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L), .Label = c("A", "B"), class = "factor")
Route.Time = c(5.8, 5.8, 5.9, 6, 6, 6, 6.3, 6.3, 6.4, 6.5, 6.5, 6.5,
6.8, 7.1, 7.3, 10.2)
Route2 <- factor(as.character(Route), levels = c("B", "A"))

wilcox_test(Route.Time~Route,conf.int=TRUE)
wilcox_test(Route.Time~Route2,conf.int=TRUE)
wilcox_test(Route.Time~Route,conf.int=TRUE, distr = exact())
wilcox_test(Route.Time~Route2,conf.int=TRUE, distr = exact())

### evaluate all formulae in xxx_tests parent.frame
### spotted by Matthieu Dubois <matthdub@gmail.com>
y <- as.data.frame(matrix(rnorm(200), ncol=2))
group <- gl(2, 50)
lapply(y, function(var) wilcox_test(var ~ group))

### make sure a parallel design with
### n = 2 isn't confused with a block design
### spotted by Fritz Scholz <fscholz@u.washington.edu>
dat <- data.frame(y = c(1, 2), g = gl(2, 1))
wt <- wilcox_test(y ~ g, data = dat, distribution = exact())
s <- support(wt)
stopifnot(all(dperm(wt, s) == c(0.5, 0.5)))

### dpqperm
wte <- wilcox_test(Route.Time ~ Route, distribution = exact())
wta <- wilcox_test(Route.Time ~ Route, distribution = approximate())
de <- dperm(wte, support(wte))
pe <- pperm(wte, support(wte))
stopifnot(isequal(cumsum(de), pe))
da <- dperm(wta, support(wta))
pa <- pperm(wta, support(wta))
stopifnot(isequal(cumsum(da), pa))
qperm(wte, seq(from = 0.1, to = 0.9, by = 0.1))
qperm(wta, seq(from = 0.1, to = 0.9, by = 0.1))

### split-up and confint (spotted by Fritz Scholz <fscholz@u.washington.edu>)
iseed <- 25
n <- m <- 4
conf.level <- 0.98
alternative <- "greater"
set.seed(iseed)
x <- round(rnorm(m), 2)
y <- round(rnorm(n, 2), 2)
score.factor <- factor(c(rep("Y",n),rep("X",m)),
                       levels = c("Y","X"))
dat.fr <- data.frame(scores=c(y,x), fac = score.factor)
it <- normal_test(scores ~ fac, data = dat.fr,
    conf.int = TRUE, conf.level = conf.level,
    alternative = alternative, dist = exact())
confint(it)

### error messages
### first group completely empty
x <- c(NA, NA, NA)
y <- c(2,4, 3)
z <- factor(c(1,1,1,2,2,2))
u <- c(x,y)
try(wilcox_test(u ~ z))

### missing values
x <- c(NA, NA, 1)
y <- c(2,  NA, NA)
z <- factor(c(1,1,1,2,2,2))
u <- c(x,y)
wilcox_test(u ~ z)

x <- c(NA, 1, 2, 8)
y <- c(2, 4, NA, 3)
wilcoxsign_test(x ~ y)

### no observations left after removing NAs
x <- c(NA, NA)
y <- c(1, 1)
try(wilcoxsign_test(x ~ y))

### problem in coin 1.0-12 fixed
x <- c(1, 2, 3)
y <- c(0, 1, 0)
wilcoxsign_test(x ~ y)

### as.integer(round(x)) is safer than as.integer(x)
 water_transfer <- data.frame(
     pd = c(0.80, 0.83, 1.89, 1.04, 1.45, 1.38, 1.91,
            1.64, 0.73, 1.46, 1.15, 0.88, 0.90, 0.74, 1.21) * 100 - 72,
     age = factor(c(rep("At term", 10),
                    rep("12-26 Weeks", 5))))

### check this out
# water_transfer$pd[11]
# as.integer(water_transfer$pd[11])
# as.integer(round(water_transfer$pd[11]))

p1 <- pvalue(independence_test(pd ~ age, data = water_transfer,
                               alternative = "less",
                               distribution = exact(algorithm = "shift")))
p2 <- pvalue(independence_test(pd ~ age, data = water_transfer,
                               alternative = "less",
                               distribution = exact(algorithm = "split")))
stopifnot(isequal(p1, p2))

### monotonicity wasn't enforced for "step-down"
set.seed(290875)

gr <- gl(2, 50)
x1 <- rnorm(100) + (as.numeric(gr) - 1) * 0.5
x2 <- rnorm(100) - (as.numeric(gr) - 1) * 0.5

it <- independence_test(x1 + x2 ~ gr, distribution = approximate(nresample = 1000))

psd <- pvalue(it, "step-down") # wasn't monotone
stopifnot(psd[1] == psd[2])

### single-step p-values were too small
df <- data.frame(y1 = c(6, 7, 8, 5, 4, 3, 1, 2),
                 y2 = c(1, 2, 5, 4, 7, 3, 8, 6),
                 y3 = c(5, 7, 8, 6, 2, 3, 1, 4),
                 y4 = c(4, 8, 7, 3, 6, 5, 1, 2),
                 x = gl(2, 4, labels = c("I", "II")))

set.seed(711109)
it <- independence_test(y1 + y2 + y3 + y4 ~ x, data = df,
                        alternative = "greater",
                        distribution = approximate(nresample = 20))

pss <- pvalue(it, "single-step")
psd <- pvalue(it, "step-down")
stopifnot(isequal(all(pss %GE% psd), TRUE))

### fmaxstat_trafo 'drop'ed its dimensions
fmaxstat_trafo(gl(2, 2))

### fmaxstat_trafo didn't drop unused levels
a <- gl(4, 2)
a[5:6] <- NA
fmaxstat_trafo(a)

### wrong p-value in the one-sided case
median_test(y1 ~ x, data = df, alternative = "less")

### nullvalue never got printed
logrank_test(Surv(time, event) ~ stadium, data = ocarcinoma)

### partial matching of the scores argument didn't work
chisq_test(as.table(jobsatisfaction[, , "Female"]), sco = list(Income = 1:4))

### partial matching of the scores argument didn't work
tab <- as.table(matrix(c(1, 2, 3, 1, 2, 3, 1, 2, 3), ncol = 3))
mh_test(tab, sco = list(response = 1:3))

### erroneously claimed to be linear-by-linear tests
chisq_test(as.table(jobsatisfaction[, , "Female"]), scores = list(Income = 1:4))
cmh_test(as.table(jobsatisfaction[, , "Female"]), scores = list(Income = 1:4))

### multivariate trafos with blocks failed for ordered factors and survival data
z <- gl(2, 10)
trafo(data.frame(gl(4, 5, ordered = TRUE)),
      ordered_trafo = function(x) cbind(c(1, 2, 3, 4)[x], c(1, 2, 3, 5)[x]),
      block = z)

### wrong exact p-values for stratified tests when all blocks have length two
y <- 1:30
x <- factor(rep(1:2, 15))
id <- gl(15, 2)
it <- independence_test(y ~ x | id, distribution = "exact") # Wrong
wt <- wilcoxsign_test(y ~ x | id, distribution = "exact") # OK! p = 6.104e-5
wt@distribution@name
stopifnot(isequal(pvalue(it), pvalue(wt)))

### chisq_test standardized test statistic was wrong
ct <- chisq_test(as.table(matrix(1:4, ncol = 2)))
stopifnot(isequal(statistic(ct), statistic(ct, "standardized")^2))

### standardized signed-rank statistic had wrong sign
y1 <- seq(1, 30, 2)
y2 <- seq(2, 30, 2)
dta <- stack(list(y1 = y1, y2 = y2))
dta$block <- factor(rep(seq_along(y1), 2))

wt0 <- wilcox.test(y1, y2, paired = TRUE, exact = FALSE, correct = FALSE,
                   alternative = "greater")
wt1 <- wilcoxsign_test(y1 ~ y2, alternative = "greater")
wt2 <- wilcoxsign_test(values ~ ind | block, data = dta,
                       alternative = "greater")
it <- independence_test(values ~ ind | block, data = dta,
                        alternative = "less")

stopifnot(isequal(wt0$statistic, statistic(wt1, "linear"))) # Was OK
stopifnot(isequal(wt0$statistic, statistic(wt2, "linear")))
stopifnot(isequal(statistic(wt1), statistic(wt2)))
stopifnot(isequal(statistic(it), statistic(wt2)))

### maxstat_test didn't handle scores properly
mt0 <- maxstat_test(counts ~ age, data = treepipit)

fage <- factor(treepipit$age) # -> wrong estimates
mt1 <- maxstat_test(counts ~ fage, data = treepipit,
                    scores = list(fage = 1:4))
stopifnot(isequal(mt0@estimates$estimate$cutpoint,
                  max(as.numeric(mt1@estimates$estimate$cutpoint))))

oage <- ordered(treepipit$age) # -> error: oage is not a factor
mt2 <- maxstat_test(counts ~ oage, data = treepipit,
                    scores = list(oage = 1:4))
stopifnot(isequal(mt0@estimates$estimate$cutpoint,
                  max(as.numeric(mt2@estimates$estimate$cutpoint))))

### one-sided Ansari-Bradley test reported the wrong direction
y <- c(rnorm(10, sd = 1),  rnorm(10, sd = 5)) # sigma_1 < sigma_2 ==>> "less"
x <- gl(2, 10)
alt <- "less"
at <- ansari_test(y ~ x, alternative = alt)
stopifnot(isequal(at@statistic@alternative, alt))

### objects of class "SymmetryProblem" didn't check validity
dta <- data.frame(y = rnorm(20), y2 = rnorm(20),
                  x = factor(rep(1:4, 5)), x2 = gl(2, 10),
                  b = gl(5, 4),
                  w = rep(2, 20))
try(friedman_test(y + y2 ~ x | b, data = dta))
try(friedman_test(y ~ x + x2 | b, data = dta))
try(friedman_test(y ~ x2 | b, data = dta)) # was ok

### friedman_test didn't warn on weights
friedman_test(y ~ x | b, data = dta,  weights = ~ w)

### chisq_test ignored xtrafo and ytrafo
chisq_test(as.table(jobsatisfaction[, , "Female"]),
           xtrafo = function(data)
               trafo(data, factor_trafo = function(x)
                   of_trafo(x, scores = 1:4)))
chisq_test(as.table(jobsatisfaction[, , "Female"]),
           ytrafo = function(data)
               trafo(data, factor_trafo = function(y)
                   of_trafo(y, scores = 1:4)))
chisq_test(as.table(jobsatisfaction[, , "Female"]),
           xtrafo = function(data)
               trafo(data, factor_trafo = function(x)
                   of_trafo(x, scores = 1:4)),
           ytrafo = function(data)
               trafo(data, factor_trafo = function(y)
                   of_trafo(y, scores = 1:4)))

### dperm could fail for *exact* tests with blocks
### (this was due to the support values not being ordered and distinct)
dta <- data.frame(
    y = c(1.83,  0.50,  1.62,  2.48, 1.68, 1.88, 1.55, 3.06, 1.30,
          0.878, 0.647, 0.598, 2.05, 1.06, 1.29, 1.06, 3.14, 1.29),
    x = gl(2, 9),
    b = factor(rep(seq_len(9), 2)))
it <- independence_test(y ~ x | b, data = dta,
                        distribution = exact(algorithm = "shift"),
                        alternative = "greater")
stopifnot(is.numeric(dperm(it, support(it))))
### see 'regtest_distribution.R' for more extensive checks

### qperm with p = 1 could be NA for *exact* tests using the shift algorithm
TeaTasting <-
    matrix(c(3, 1, 1, 3),
           nrow = 2,
           dimnames = list(Guess = c("Milk", "Tea"),
                           Truth = c("Milk", "Tea")))
it <- independence_test(as.table(TeaTasting),
                        distribution = exact(algorithm = "shift"))
stopifnot(!is.na(qperm(it, p = 1)))

### dperm for *exact* tests returned a zero-length vector for values not
### included in the support
dp_it <- dperm(it, 1.5)
stopifnot(length(dp_it > 0) && dp_it == 0)

### dperm for *approximate* tests returned non-zero probabilities for values not
### included in the support
exfoliative <- matrix(c( 0, 16,
                        15, 57),
                      nrow = 2, byrow = TRUE)
set.seed(290875)
it <- independence_test(as.table(exfoliative),
                        distribution = approximate(nresample = 10000),
                        teststat = "scalar")
stopifnot(isequal(round(dperm(it, -statistic(it)), 4), 0.0000)) # 0.0747

### 'is_2sample' didn't drop unused levels, causing trouble with, e.g., subset
dta <- data.frame(y = rnorm(15), x = gl(3, 5), b = factor(rep(1:5, 3)))
subs <- dta$x %in% 1:2
wilcox_test(y ~ x | b, data = dta, subset = subs)

### problem with subsetting stratification variable
subs <- dta$x %in% 1:2 & dta$b %in% 1:4
wilcox_test(y ~ x | b, data = dta, subset = subs)

### 'dperm' returned non-sense for asymptotic max-type tests
y1 <- rnorm(10)
y2 <- rnorm(10)
x <- gl(2, 5)
it <- independence_test(y1 + y2 ~ x)
stopifnot(is.na(dperm(it, statistic(it))))

### 'p-'/'qperm' for asymptotic max-type test had issues with vector arguments
stopifnot(isequal(pperm(it, 1:3),
                  c(pperm(it, 1), pperm(it, 2), pperm(it, 3))))
stopifnot(isequal(qperm(it, c(0.9, 0.95, 0.99)),
                  c(qperm(it, 0.9), qperm(it, 0.95), qperm(it, 0.99))))

### could not distinguish censored and numeric responses
y1 <- rnorm(10)
y2 <- rnorm(10)
x <- gl(2, 5)
b <- factor(rep(1:5, 2))
try(oneway_test(Surv(y1) ~ x))
try(wilcox_test(Surv(y1) ~ x))
try(kruskal_test(Surv(y1) ~ x))
try(normal_test(Surv(y1) ~ x))
try(median_test(Surv(y1) ~ x))
try(savage_test(Surv(y1) ~ x))
try(kruskal_test(Surv(y1) ~ x))
try(taha_test(Surv(y1) ~ x))
try(klotz_test(Surv(y1) ~ x))
try(mood_test(Surv(y1) ~ x))
try(ansari_test(Surv(y1) ~ x))
try(fligner_test(Surv(y1) ~ x))
try(conover_test(Surv(y1) ~ x))
try(sign_test(Surv(y1) ~ x | b))
try(sign_test(Surv(y1) ~ Surv(y2)))
try(sign_test(Surv(y1) ~ y2))
try(sign_test(y1 ~ Surv(y2)))
try(wilcoxsign_test(Surv(y1) ~ x | b))
try(wilcoxsign_test(Surv(y1) ~ Surv(y2)))
try(wilcoxsign_test(Surv(y1) ~ y2))
try(wilcoxsign_test(y1 ~ Surv(y2)))
try(friedman_test(Surv(y1) ~ x))
try(quade_test(Surv(y1) ~ x))

### exact two-sample tests with scores gave wrong p-value
y <- 1:20
x <- gl(2, 10)
ox <- ordered(x)

it1 <- independence_test(y ~ x,  distr = exact(algorithm = "shift")) # p = 1e-05
it2 <- independence_test(y ~ x,  distr = exact(algorithm = "shift"), # was p = 1
                         scores = list(x = 1:2))
it3 <- independence_test(y ~ ox, distr = exact(algorithm = "shift")) # was p = 1
it4 <- independence_test(y ~ ox, distr = exact(algorithm = "shift"), # was p = NA
                         scores = list(ox = 3:4))
stopifnot(identical(pvalue(it1), pvalue(it2)))
stopifnot(identical(pvalue(it1), pvalue(it3)))
stopifnot(identical(pvalue(it1), pvalue(it4)))

it5 <- independence_test(y ~ x,  distr = exact(algorithm = "split")) # p = 1e-05
it6 <- independence_test(y ~ x,  distr = exact(algorithm = "split"), # was p = NA
                         scores = list(x = 1:2))
it7 <- independence_test(y ~ ox, distr = exact(algorithm = "split")) # was p = NA
it8 <- independence_test(y ~ ox, distr = exact(algorithm = "split"), # was p = NA
                         scores = list(ox = 3:4))
stopifnot(identical(pvalue(it5), pvalue(it6)))
stopifnot(identical(pvalue(it5), pvalue(it7)))
stopifnot(identical(pvalue(it5), pvalue(it8)))

### 'of_trafo' threw an error for 'x' of length one
of_trafo(gl(3, 1, ordered = TRUE)[1])

### 'setscores' assigned 0:1 for decreasing scores in 2-level cases
it1 <- independence_test(y ~ x,  scores = list(x = 1:2)) # was OK
it2 <- independence_test(y ~ x,  scores = list(x = 2:1)) # wrong sign
stopifnot(identical(statistic(it1), -statistic(it2)))

### 'of_trafo' didn't return normalized scores in 2-level cases using 'scores'
of <- gl(2, 1, ordered = TRUE)
stopifnot(identical(of_trafo(of),                            # was OK
                    matrix(c(0, 1), dimnames = list(1:2))))
stopifnot(identical(of_trafo(of, scores = 1:2),              # was 1:2
                    matrix(c(0, 1), dimnames = list(1:2))))
stopifnot(identical(of_trafo(of, scores = 2:1),              # was 2:1
                    matrix(c(1, 0), dimnames = list(1:2))))

### 'logrank_trafo' didn't make sure input was right-censored
s <- Surv(1:5, event = c(1, 0, 1, 0, 1), type = "left")
try(logrank_trafo(s))

### 'ofmaxstat_trafo' had the labeling wrong
of <- ordered(c(1, 1, 2, 3, 3, 4))
ofmaxstat_trafo(of, minprob = 0.34) # was {1} vs. {2, 3, 4}

### 'statistic(*, "standardized")' didn't work for "IndependenceLinearStatistic"
ils <- new("IndependenceLinearStatistic", it2@statistic)
statistic(ils, type = "standardized")

### exact appeared to work for multivariate quadratic two-sample tests
tab <- as.table(matrix(c(5, 14, 8, 4, 25, 5, 32, 6), nrow = 2))
try(independence_test(tab, distr = exact(), teststat = "quad"))

### partial matching of teststat
it <- independence_test(y ~ x, test = "quadratic")