Revision 27bf2de0a4c0b5d80b795557f993419fde61c3d3 authored by Torsten Hothorn on 17 August 2011, 00:00:00 UTC, committed by Gabor Csardi on 17 August 2011, 00:00:00 UTC
1 parent 0bbdd83
IndependenceTest.R
ft <- function(test, formula, data = list(), subset = NULL,
weights = NULL, ...) {
d <- formula2data(formula, data, subset, weights = weights, ...)
ip <- new("IndependenceProblem", x = d$x, y = d$y, block = d$bl,
weights = d$w)
args <- list(...)
args$frame <- NULL
RET <- do.call(test, c(list(object = ip), args))
return(RET)
}
### a generic test procedure for classical (and not so classical) tests
independence_test <- function(object, ...) UseMethod("independence_test")
independence_test.formula <- function(formula, data = list(), subset = NULL,
weights = NULL, ...) {
ft("independence_test", formula, data, subset, weights,
frame = parent.frame(), ...)
}
independence_test.table <- function(object,
distribution = c("asymptotic", "approximate"), ...) {
distribution <- check_distribution_arg(distribution,
c("asymptotic", "approximate"))
ip <- table2IndependenceProblem(object)
RET <- do.call("independence_test",
c(list(object = ip, distribution = distribution),
list(...)))
return(RET)
}
independence_test.IndependenceProblem <- function(object,
teststat = c("max", "quad", "scalar"),
distribution = c("asymptotic", "approximate", "exact"),
alternative = c("two.sided", "less", "greater"),
xtrafo = trafo, ytrafo = trafo, scores = NULL, check = NULL, ...) {
addargs <- list(...)
if (length(addargs) > 0)
warning("additional arguments ",
paste(names(addargs), collapse = ", "),
" will be ignored")
### just for backward compatibility
teststat <- match.arg(teststat, choices = c("maxtype", "quadtype", "scalar"),
several.ok = TRUE)
if (teststat[1] == "maxtype") teststat <- "max"
if (teststat[1] == "quadtype") teststat <- "quad"
teststat <- match.arg(teststat)
alternative <- match.arg(alternative)
distribution <- check_distribution_arg(distribution)
### convert factors to ordered and attach scores if requested
object <- setscores(object, scores)
### transform data if requested and setup a test problem
itp <- new("IndependenceTestProblem", object, xtrafo = xtrafo,
ytrafo = ytrafo, ...)
if (!is.null(check)) {
if (is.function(check)) {
if (!check(itp))
stop(sQuote("check"), " failed")
} else {
stop(sQuote("check"), " is not a function")
}
}
### check type of test statistic and alternative
scalar <- is_scalar(itp)
if (!scalar) {
if (teststat == "scalar") {
warning("Length linear statistic > 1, using ",
sQuote("max"), "-type test statistic")
teststat <- "max"
}
} else {
if (teststat == "max") teststat <- "scalar"
}
if (alternative != "two.sided" && teststat == "quad")
warning(sQuote("alternative"), " is ignored for ",
teststat, " type test statistics")
### compute linear statistic, conditional expectation and
### conditional covariance
its <- new("IndependenceTestStatistic", itp, varonly = TRUE)
# varonly = class(distribution) == "approximate" && teststat == "max")
### compute test statistic and corresponding null distribution
RET <- switch(teststat,
"scalar" = {
ts <- new("ScalarIndependenceTestStatistic", its,
alternative = alternative)
nd <- distribution(ts)
new("ScalarIndependenceTest", statistic = ts, distribution = nd)
},
"max" = {
ts <- new("MaxTypeIndependenceTestStatistic", its,
alternative = alternative)
nd <- distribution(ts)
new("MaxTypeIndependenceTest", statistic = ts, distribution = nd)
},
"quad" = {
ts <- new("QuadTypeIndependenceTestStatistic", its)
nd <- distribution(ts)
new("QuadTypeIndependenceTest", statistic = ts,
distribution = nd)
})
### return object inheriting from class `IndependenceTest'
return(RET)
}
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...