libcoin/ 0000755 0001762 0000144 00000000000 14505002061 011662 5 ustar ligges users libcoin/NAMESPACE 0000644 0001762 0000144 00000000302 14341133054 013101 0 ustar ligges users
useDynLib(libcoin, .registration = TRUE)
importFrom("stats", complete.cases, vcov)
importFrom("mvtnorm", GenzBretz)
export(LinStatExpCov, doTest, ctabs, lmult)
S3method(vcov, LinStatExpCov)
libcoin/man/ 0000755 0001762 0000144 00000000000 14504772042 012451 5 ustar ligges users libcoin/man/LinStatExpCov.Rd 0000644 0001762 0000144 00000005661 14344071245 015452 0 ustar ligges users
\name{LinStatExpCov}
\alias{LinStatExpCov}
\alias{lmult}
\title{
Linear Statistics with Expectation and Covariance
}
\description{
Strasser-Weber type linear statistics and their expectation
and covariance under the independence hypothesis
}
\usage{
LinStatExpCov(X, Y, ix = NULL, iy = NULL, weights = integer(0),
subset = integer(0), block = integer(0), checkNAs = TRUE,
varonly = FALSE, nresample = 0, standardise = FALSE,
tol = sqrt(.Machine$double.eps))
lmult(x, object)
}
\arguments{
\item{X}{numeric matrix of transformations.}
\item{Y}{numeric matrix of influence functions.}
\item{ix}{an optional integer vector expanding \code{X}.}
\item{iy}{an optional integer vector expanding \code{Y}.}
\item{weights}{an optional integer vector of non-negative case weights.}
\item{subset}{an optional integer vector defining a subset of observations.}
\item{block}{an optional factor defining independent blocks of observations.}
\item{checkNAs}{a logical for switching off missing value checks. This
included switching off checks for suitable values of \code{subset}.
Use at your own risk.}
\item{varonly}{a logical asking for variances only.}
\item{nresample}{an integer defining the number of permuted statistics to draw.}
\item{standardise}{a logical asking to standardise the permuted statistics.}
\item{tol}{tolerance for zero variances.}
\item{x}{a contrast matrix to be left-multiplied in case \code{X} was a factor.}
\item{object}{an object of class \code{"LinStatExpCov"}.}
}
\details{
The function, after minimal preprocessing, calls the underlying C code
and computes the linear statistic, its expectation and covariance and,
optionally, \code{nresample} samples from its permutation distribution.
When both \code{ix} and \code{iy} are missing, the number of rows of
\code{X} and \code{Y} is the same, ie the number of observations.
When \code{X} is missing and \code{ix} a factor, the code proceeds as
if \code{X} were a dummy matrix of \code{ix} without explicitly
computing this matrix.
Both \code{ix} and \code{iy} being present means the code treats them
as subsetting vectors for \code{X} and \code{Y}. Note that \code{ix = 0}
or \code{iy = 0} means that the corresponding observation is missing
and the first row or \code{X} and \code{Y} must be zero.
\code{lmult} allows left-multiplication of a contrast matrix when \code{X}
was (equivalent to) a factor.
}
\value{
A list.
}
\references{
Strasser, H. and Weber, C. (1999). On the asymptotic theory of permutation
statistics. \emph{Mathematical Methods of Statistics} \bold{8}(2), 220--250.
}
\examples{
wilcox.test(Ozone ~ Month, data = airquality, subset = Month \%in\% c(5, 8),
exact = FALSE, correct = FALSE)
aq <- subset(airquality, Month \%in\% c(5, 8))
X <- as.double(aq$Month == 5)
Y <- as.double(rank(aq$Ozone, na.last = "keep"))
doTest(LinStatExpCov(X, Y))
}
\keyword{htest}
libcoin/man/ctabs.Rd 0000644 0001762 0000144 00000001711 14504772042 014034 0 ustar ligges users
\name{ctabs}
\alias{ctabs}
\title{
Cross Tabulation
}
\description{
Efficient weighted cross tabulation of two factors and a block
}
\usage{
ctabs(ix, iy = integer(0), block = integer(0), weights = integer(0),
subset = integer(0), checkNAs = TRUE)
}
\arguments{
\item{ix}{a integer of positive values with zero indicating a missing.}
\item{iy}{an optional integer of positive values with zero indicating a
missing.}
\item{block}{an optional blocking factor without missings.}
\item{weights}{an optional vector of case weights, integer or double.}
\item{subset}{an optional integer vector indicating a subset.}
\item{checkNAs}{a logical for switching off missing value checks.}
}
\details{
A faster version of \code{xtabs(weights ~ ix + iy + block, subset)}.
}
\value{
If \code{block} is present, a three-way table. Otherwise,
a one- or two-dimensional table.
}
\examples{
ctabs(ix = 1:5, iy = 1:5, weights = 1:5 / 5)
}
\keyword{univar}
libcoin/man/doTest.Rd 0000644 0001762 0000144 00000003172 14344071245 014204 0 ustar ligges users
\name{doTest}
\alias{doTest}
\title{
Permutation Test
}
\description{
Perform permutation test for a linear statistic
}
\usage{
doTest(object, teststat = c("maximum", "quadratic", "scalar"),
alternative = c("two.sided", "less", "greater"), pvalue = TRUE,
lower = FALSE, log = FALSE, PermutedStatistics = FALSE,
minbucket = 10L, ordered = TRUE, maxselect = object$Xfactor,
pargs = GenzBretz())
}
\arguments{
\item{object}{an object returned by \code{\link{LinStatExpCov}}.}
\item{teststat}{type of test statistic to use.}
\item{alternative}{alternative for scalar or maximum-type statistics.}
\item{pvalue}{a logical indicating if a p-value shall be computed.}
\item{lower}{a logical indicating if a p-value (\code{lower} is \code{FALSE})
or 1 - p-value (\code{lower} is \code{TRUE}) shall be returned.}
\item{log}{a logical, if \code{TRUE} probabilities are log-probabilities.}
\item{PermutedStatistics}{a logical, return permuted test statistics.}
\item{minbucket}{minimum weight in either of two groups for maximally selected
statistics.}
\item{ordered}{a logical, if \code{TRUE} maximally selected statistics assume
that the cutpoints are ordered.}
\item{maxselect}{a logical, if \code{TRUE} maximally selected statistics are
computed. This requires that \code{X} was an implicitly defined design
matrix in \code{\link{LinStatExpCov}}.}
\item{pargs}{arguments as in \code{\link[mvtnorm:algorithms]{GenzBretz}}.}
}
\details{
Computes a test statistic, a corresponding p-value and, optionally, cutpoints
for maximally selected statistics.
}
\value{
A list.
}
\keyword{htest}
libcoin/DESCRIPTION 0000644 0001762 0000144 00000002161 14505002057 013375 0 ustar ligges users Package: libcoin
Title: Linear Test Statistics for Permutation Inference
Date: 2023-09-26
Version: 1.0-10
Authors@R: c(person("Torsten", "Hothorn", role = c("aut", "cre"),
email = "Torsten.Hothorn@R-project.org",
comment = c(ORCID = "0000-0001-8301-0471")),
person("Henric", "Winell", role = "aut",
comment = c(ORCID = "0000-0001-7995-3047")))
Description: Basic infrastructure for linear test statistics and permutation
inference in the framework of Strasser and Weber (1999) .
This package must not be used by end-users. CRAN package 'coin' implements all
user interfaces and is ready to be used by anyone.
Depends: R (>= 3.4.0)
Suggests: coin
Imports: stats, mvtnorm
LinkingTo: mvtnorm
NeedsCompilation: yes
License: GPL-2
Packaged: 2023-09-27 09:57:53 UTC; hothorn
Author: Torsten Hothorn [aut, cre] (),
Henric Winell [aut] ()
Maintainer: Torsten Hothorn
Repository: CRAN
Date/Publication: 2023-09-27 10:30:07 UTC
libcoin/build/ 0000755 0001762 0000144 00000000000 14504776233 013003 5 ustar ligges users libcoin/build/vignette.rds 0000644 0001762 0000144 00000000377 14504776233 015351 0 ustar ligges users uPj0U.c0(co%_h)1(}u98.ouƣɲα B hn@ /Js-)QAMU+SESRS6
EA]C !="Q3YaTto\(﹦Bv
J* GKt)͓~զpƎˏvvaW0{btv]Kʕh%
aEVs
libcoin/tests/ 0000755 0001762 0000144 00000000000 14172231233 013031 5 ustar ligges users libcoin/tests/regtest_libcoin.Rout.save 0000644 0001762 0000144 00000053425 14172231233 020026 0 ustar ligges users
R Under development (unstable) (2020-12-20 r79658) -- "Unsuffered Consequences"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
>
> library("libcoin")
> library("coin")
Loading required package: survival
> set.seed(29)
>
> n <- 100
> p <- 4
> q <- 2
> X <- matrix(runif(p * n), nc = p)
> Y <- matrix(runif(q * n), nc = q)
> w <- as.integer(floor(runif(n, max = 4)))
> s <- sort(sample(1:n, floor(n/2), replace = TRUE))
> b <- sample(gl(2, 2, length = n))
>
> tol <- if (.Platform$OS.type == "unix") {
+ sqrt(.Machine$double.eps)
+ } else {
+ .Machine$double.eps^(1/5)
+ }
>
> cmp <- function(t1, t2) {
+ if (is.null(t1$Covariance)) {
+ var1 <- t1$Variance
+ var2 <- diag(covariance(t2))
+ } else {
+ var1 <- t1$Covariance
+ var2 <- covariance(t2)
+ var2 <- var2[!upper.tri(var2)]
+ }
+ stopifnot(all.equal(
+ list(t1$LinearStatistic,
+ t1$Expectation,
+ var1),
+ list(as.vector(statistic(t2, type = "linear")),
+ as.vector(expectation(t2)),
+ var2),
+ check.attributes = FALSE, tolerance = tol
+ ))
+ }
>
> cmp2 <- function(t1, t2) {
+ nm <- c("LinearStatistic", "Expectation",
+ if(t1$varonly == 1) "Variance" else "Covariance")
+ stopifnot(all.equal(t1[nm], t2[nm], tolerance = tol))
+ }
>
> cmp3 <- function(t1, t2, pvalue = FALSE) {
+ stopifnot(all.equal(statistic(t1), t2$TestStatistic, tolerance = tol))
+ if (pvalue)
+ stopifnot(all.equal(unclass(pvalue(t1)), t2$p.value, check.attributes = FALSE, tolerance = tol))
+ }
>
> cmp4 <- function(t1, t2)
+ stopifnot(all.equal(t1$TestStatistic, sqrt(t2$TestStatistic), tolerance = tol))
>
>
> t1 <- LinStatExpCov(X, Y)
> t1v <- LinStatExpCov(X, Y, varonly = TRUE)
> t2 <- independence_test(Y ~ X)
> cmp(t1, t2)
> cmp(t1v, t2)
> cmp3(t2, doTest(t1, teststat = "maximum"), pvalue = TRUE)
> t3 <- independence_test(Y ~ X, teststat = "maximum", alternative = "less")
> cmp3(t3, doTest(t1, teststat = "maximum", alternative = "less"), pvalue = TRUE)
> t3 <- independence_test(Y ~ X, teststat = "maximum", alternative = "greater")
> cmp3(t3, doTest(t1, teststat = "maximum", alternative = "greater"), pvalue = TRUE)
> t3 <- independence_test(Y ~ X, teststat = "quadratic")
> cmp3(t3, doTest(t1, teststat = "quadratic"), pvalue = TRUE)
>
> t1 <- LinStatExpCov(X, Y, weights = w)
> t1v <- LinStatExpCov(X, Y, weights = w, varonly = TRUE)
> t2 <- independence_test(Y ~ X, weights = ~ w)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, subset = s)
> t1v <- LinStatExpCov(X, Y, subset = s, varonly = TRUE)
> t2 <- independence_test(Y ~ X, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, weights = w, subset = s)
> t1v <- LinStatExpCov(X, Y, weights = w, subset = s, varonly = TRUE)
> t2 <- independence_test(Y ~ X, weights = ~w, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, block = b)
> t1v <- LinStatExpCov(X, Y, block = b, varonly = TRUE)
> t2 <- independence_test(Y ~ X | b)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, weights = w, block = b)
> t1v <- LinStatExpCov(X, Y, weights = w, block = b, varonly = TRUE)
> t2 <- independence_test(Y ~ X | b, weights = ~ w)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, subset = s, block = b)
> t1v <- LinStatExpCov(X, Y, subset = s, block = b, varonly = TRUE)
> t2 <- independence_test(Y ~ X | b, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, weights = w, subset = s, block = b)
> t1v <- LinStatExpCov(X, Y, weights = w, subset = s, block = b, varonly = TRUE)
> t2 <- independence_test(Y ~ X | b, weights = ~w, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> n <- 100
> n1 <- 5
> n2 <- 4
> p <- 4
> q <- 2
> X <- rbind(0, matrix(runif(p * n1), nc = p))
> Y <- rbind(0, matrix(runif(q * n2), nc = q))
> ix <- sample(1:n1, n, replace = TRUE)
> iy <- sample(1:n2, n, replace = TRUE)
> w <- as.integer(floor(runif(n, max = 4)))
> s <- sort(sample(1:n, floor(n/2), replace = TRUE))
> b <- sample(gl(2, 2, length = n))
>
> t1 <- LinStatExpCov(X, Y, ix, iy)
> t1v <- LinStatExpCov(X, Y, ix, iy, varonly = TRUE)
> t2 <- independence_test(Y[iy + 1,] ~ X[ix + 1,])
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, weights = w)
> t1v <- LinStatExpCov(X, Y, ix, iy, weights = w, varonly = TRUE)
> t2 <- independence_test(Y[iy + 1,] ~ X[ix + 1,], weights = ~ w)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, subset = s)
> t1v <- LinStatExpCov(X, Y, ix, iy, subset = s, varonly = TRUE)
> t2 <- independence_test(Y[iy + 1,] ~ X[ix + 1,], subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, weights = w, subset = s)
> t1v <- LinStatExpCov(X, Y, ix, iy, weights = w, subset = s, varonly = TRUE)
> t2 <- independence_test(Y[iy + 1,] ~ X[ix + 1,], weights = ~w, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, block = b)
> t1v <- LinStatExpCov(X, Y, ix, iy, block = b, varonly = TRUE)
> t2 <- independence_test(Y[iy + 1,] ~ X[ix + 1,] | b)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, weights = w, block = b)
> t1v <- LinStatExpCov(X, Y, ix, iy, weights = w, block = b, varonly = TRUE)
> t2 <- independence_test(Y[iy + 1,] ~ X[ix + 1,] | b, weights = ~ w)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, subset = s, block = b)
> t1v <- LinStatExpCov(X, Y, ix, iy, subset = s, block = b, varonly = TRUE)
> t2 <- independence_test(Y[iy + 1,] ~ X[ix + 1,] | b, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, weights = w, subset = s, block = b)
> t1v <- LinStatExpCov(X, Y, ix, iy, weights = w, subset = s, block = b, varonly = TRUE)
> t2 <- independence_test(Y[iy + 1,] ~ X[ix + 1,]| b, weights = ~w, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
>
> #### X factor
> n <- 10000
> p <- 40
> q <- 20
> X <- diag(p)[fx <- unclass(factor(sample(1:p, n, replace = TRUE))),]
> Y <- matrix(runif(q * n), nc = q)
> w <- as.integer(floor(runif(n, max = 4)))
> s <- sort(sample(1:n, floor(n/2), replace = TRUE))
> b <- sample(gl(2, 2, length = n))
>
> t1 <- LinStatExpCov(X, Y)
> t1v <- LinStatExpCov(X, Y, varonly = TRUE)
> t2 <- independence_test(Y ~ X)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(fx, Y)
> t1vf <- LinStatExpCov(fx, Y, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, weights = w)
> t1v <- LinStatExpCov(X, Y, weights = w, varonly = TRUE)
> t2 <- independence_test(Y ~ X, weights = ~ w)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(fx, Y, weights = w)
> t1vf <- LinStatExpCov(fx, Y, weights = w, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, subset = s)
> t1v <- LinStatExpCov(X, Y, subset = s, varonly = TRUE)
> t2 <- independence_test(Y ~ X, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(fx, Y, subset = s)
> t1vf <- LinStatExpCov(fx, Y, subset = s, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, weights = w, subset = s)
> t1v <- LinStatExpCov(X, Y, weights = w, subset = s, varonly = TRUE)
> t2 <- independence_test(Y ~ X, weights = ~w, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(fx, Y, weights = w, subset = s)
> t1vf <- LinStatExpCov(fx, Y, weights = w, subset = s, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, block = b)
> t1v <- LinStatExpCov(X, Y, block = b, varonly = TRUE)
> t2 <- independence_test(Y ~ X | b)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(fx, Y, block = b)
> t1vf <- LinStatExpCov(fx, Y, block = b, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
>
> t1 <- LinStatExpCov(X, Y, weights = w, block = b)
> t1v <- LinStatExpCov(X, Y, weights = w, block = b, varonly = TRUE)
> t2 <- independence_test(Y ~ X | b, weights = ~ w)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(fx, Y, weights = w, block = b)
> t1vf <- LinStatExpCov(fx, Y, weights = w, block = b, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, subset = s, block = b)
> t1v <- LinStatExpCov(X, Y, subset = s, block = b, varonly = TRUE)
> t2 <- independence_test(Y ~ X | b, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(fx, Y, subset = s, block = b)
> t1vf <- LinStatExpCov(fx, Y, subset = s, block = b, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, weights = w, subset = s, block = b)
> t1v <- LinStatExpCov(X, Y, weights = w, subset = s, block = b, varonly = TRUE)
> t2 <- independence_test(Y ~ X | b, weights = ~w, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(fx, Y, weights = w, subset = s, block = b)
> t1vf <- LinStatExpCov(fx, Y, weights = w, subset = s, block = b, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> n1 <- 5
> n2 <- 7
> X <- rbind(0, diag(n1))
> Y <- rbind(0, matrix(runif(q * n2), nc = q))
> ix <- sample(1:n1, n, replace = TRUE)
> iy <- sample(1:n2, n, replace = TRUE)
> w <- as.integer(floor(runif(n, max = 4)))
> s <- sort(sample(1:n, floor(n/2), replace = TRUE))
> b <- sample(gl(2, 2, length = n))
>
> YY <- Y[iy + 1,]
> XX <- X[ix + 1,]
>
> t1 <- LinStatExpCov(X, Y, ix, iy)
> t1v <- LinStatExpCov(X, Y, ix, iy, varonly = TRUE)
> t2 <- independence_test(YY ~ XX)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(numeric(0), Y, ix, iy)
> t1vf <- LinStatExpCov(numeric(0), Y, ix, iy, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, weights = w)
> t1v <- LinStatExpCov(X, Y, ix, iy, weights = w, varonly = TRUE)
> t2 <- independence_test(YY ~ XX, weights = ~ w)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(numeric(0), Y, ix, iy, weights = w)
> t1vf <- LinStatExpCov(numeric(0), Y, ix, iy, weights = w, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, subset = s)
> t1v <- LinStatExpCov(X, Y, ix, iy, subset = s, varonly = TRUE)
> t2 <- independence_test(YY ~ XX, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(numeric(0), Y, ix, iy, subset = s)
> t1vf <- LinStatExpCov(numeric(0), Y, ix, iy, subset = s, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
>
> t1 <- LinStatExpCov(X, Y, ix, iy, weights = w, subset = s)
> t1v <- LinStatExpCov(X, Y, ix, iy, weights = w, subset = s, varonly = TRUE)
> t2 <- independence_test(YY ~ XX, weights = ~w, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(numeric(0), Y, ix, iy, weights = w, subset = s)
> t1vf <- LinStatExpCov(numeric(0), Y, ix, iy, weights = w, subset = s, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, block = b)
> t1v <- LinStatExpCov(X, Y, ix, iy, block = b, varonly = TRUE)
> t2 <- independence_test(YY ~ XX | b)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(numeric(0), Y, ix, iy, block = b)
> t1vf <- LinStatExpCov(numeric(0), Y, ix, iy, block = b, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, weights = w, block = b)
> t1v <- LinStatExpCov(X, Y, ix, iy, weights = w, block = b, varonly = TRUE)
> t2 <- independence_test(YY ~ XX | b, weights = ~ w)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(numeric(0), Y, ix, iy, weights = w, block = b)
> t1vf <- LinStatExpCov(numeric(0), Y, ix, iy, weights = w, block = b, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, subset = s, block = b)
> t1v <- LinStatExpCov(X, Y, ix, iy, subset = s, block = b, varonly = TRUE)
> t2 <- independence_test(YY ~ XX | b, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(numeric(0), Y, ix, iy, subset = s, block = b)
> t1vf <- LinStatExpCov(numeric(0), Y, ix, iy, subset = s, block = b, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> t1 <- LinStatExpCov(X, Y, ix, iy, weights = w, subset = s, block = b)
> t1v <- LinStatExpCov(X, Y, ix, iy, weights = w, subset = s, block = b, varonly = TRUE)
> t2 <- independence_test(YY ~ XX| b, weights = ~w, subset = s)
> cmp(t1, t2)
> cmp(t1v, t2)
> t1f <- LinStatExpCov(numeric(0), Y, ix, iy, weights = w, subset = s, block = b)
> t1vf <- LinStatExpCov(numeric(0), Y, ix, iy, weights = w, subset = s, block = b, varonly = TRUE)
> cmp2(t1, t1f)
> cmp2(t1v, t1vf)
>
> ### and now maximally selected statistics
> n <- 100
> B <- 1000
> x <- round(runif(n), 2)
> y <- rnorm(n, mean = x < .5, sd = 2.6)
> y2 <- runif(n)
> blk <- gl(4, n/4)
> ux <- sort(unique(x))
> ix <- unclass(cut(x, breaks = c(-Inf, ux[-length(ux)] + diff(ux) / 2, Inf)))
>
> cmp3 <- function(t1, t2)
+ stopifnot(all.equal(statistic(t1), t2$TestStatistic, tolerance = tol))
>
> cmp4 <- function(t1, t2)
+ stopifnot(all.equal(t1$TestStatistic, sqrt(t2$TestStatistic), tolerance = tol))
>
> (mt <- maxstat_test(y ~ x , distrib = approximate(nresample = 1000)))
Approximative Generalized Maximally Selected Statistics
data: y by x
maxT = 2.1537, p-value = 0.26
alternative hypothesis: two.sided
sample estimates:
"best" cutpoint: <= 0.53
> lev <- LinStatExpCov(ix, y, nresample = 1000)
> (tst <- doTest(lev, teststat = "maximum"))
$TestStatistic
[1] 2.153664
$p.value
[1] 0.245
$index
[1] 36
> cmp3(mt, tst)
> ux[tst$index]
[1] 0.53
> (tst2 <- doTest(lev, teststat = "quadratic"))
$TestStatistic
[1] 4.63827
$p.value
[1] 0.245
$index
[1] 36
> cmp4(tst, tst2)
> ux[tst2$index]
[1] 0.53
> lev <- LinStatExpCov(ix, y, nresample = 1000, varonly = TRUE)
> (tst <- doTest(lev, teststat = "maximum"))
$TestStatistic
[1] 2.153664
$p.value
[1] 0.253
$index
[1] 36
> cmp3(mt, tst)
> ux[tst$index]
[1] 0.53
> (tst2 <- doTest(lev, teststat = "quadratic"))
$TestStatistic
[1] 4.63827
$p.value
[1] 0.253
$index
[1] 36
> cmp4(tst, tst2)
> ux[tst2$index]
[1] 0.53
>
> (mt <- maxstat_test(y ~ x | blk, distrib = approximate(nresample = 1000)))
Approximative Generalized Maximally Selected Statistics
data: y by x
stratified by blk
maxT = 2.2764, p-value = 0.221
alternative hypothesis: two.sided
sample estimates:
"best" cutpoint: <= 0.53
> lev <- LinStatExpCov(ix, y, block = blk, nresample = 1000)
> (tst <- doTest(lev, teststat = "maximum"))
$TestStatistic
[1] 2.276446
$p.value
[1] 0.192
$index
[1] 36
> cmp3(mt, tst)
> ux[tst$index]
[1] 0.53
> (tst2 <- doTest(lev, teststat = "quadratic"))
$TestStatistic
[1] 5.182204
$p.value
[1] 0.192
$index
[1] 36
> cmp4(tst, tst2)
> ux[tst$index]
[1] 0.53
> lev <- LinStatExpCov(ix, y, block = blk, nresample = 1000, varonly = TRUE)
> try(tst <- doTest(lev, teststat = "maximum"))
Error in doTest(lev, teststat = "maximum") :
need covariance for maximally statistics with blocks
>
> (mt <- maxstat_test(y + y2 ~ x , distrib = approximate(nresample = 1000)))
Approximative Generalized Maximally Selected Statistics
data: y, y2 by x
maxT = 2.1537, p-value = 0.445
alternative hypothesis: two.sided
sample estimates:
"best" cutpoint: <= 0.53
> lev <- LinStatExpCov(ix, cbind(y, y2), nresample = 1000)
> (tst <- doTest(lev, teststat = "maximum"))
$TestStatistic
[1] 2.153664
$p.value
[1] 0.471
$index
[1] 36
> cmp3(mt, tst)
> ux[tst$index]
[1] 0.53
> (tst <- doTest(lev, teststat = "quadratic"))
$TestStatistic
[1] 5.720153
$p.value
[1] 0.412
$index
[1] 40
> ux[tst$index]
[1] 0.57
> lev <- LinStatExpCov(ix, cbind(y, y2), nresample = 1000, varonly = TRUE)
> (tst <- doTest(lev, teststat = "maximum"))
$TestStatistic
[1] 2.153664
$p.value
[1] 0.476
$index
[1] 36
> cmp3(mt, tst)
> ux[tst$index]
[1] 0.53
> (tst <- doTest(lev, teststat = "quadratic"))
$TestStatistic
[1] 5.720153
$p.value
[1] 0.429
$index
[1] 40
> ux[tst$index]
[1] 0.57
>
> (mt <- maxstat_test(y + y2 ~ x | blk, distrib = approximate(nresample = 1000)))
Approximative Generalized Maximally Selected Statistics
data: y, y2 by x
stratified by blk
maxT = 2.2764, p-value = 0.38
alternative hypothesis: two.sided
sample estimates:
"best" cutpoint: <= 0.53
> lev <- LinStatExpCov(ix, cbind(y, y2), block = blk, nresample = 1000)
> (tst <- doTest(lev, teststat = "maximum"))
$TestStatistic
[1] 2.276446
$p.value
[1] 0.394
$index
[1] 36
> cmp3(mt, tst)
> ux[tst$index]
[1] 0.53
> (tst <- doTest(lev, teststat = "quadratic"))
$TestStatistic
[1] 5.406605
$p.value
[1] 0.504
$index
[1] 40
> ux[tst$index]
[1] 0.57
> lev <- LinStatExpCov(ix, cbind(y, y2), block = blk, nresample = 1000, varonly = TRUE)
> try(tst <- doTest(lev, teststat = "maximum"))
Error in doTest(lev, teststat = "maximum") :
need covariance for maximally statistics with blocks
>
> x <- sample(gl(5, n))
> y <- rnorm(length(x), mean = x %in% levels(x)[c(1, 3, 5)], sd = 4.5)
> y2 <- runif(length(x))
> ix <- unclass(x)
> blk <- gl(5, n)
>
> (mt <- maxstat_test(y ~ x , distrib = approximate(nresample = 1000)))
Approximative Generalized Maximally Selected Statistics
data: y by x (1, 2, 3, 4, 5)
maxT = 1.7088, p-value = 0.443
alternative hypothesis: two.sided
sample estimates:
"best" cutpoint: {1, 3} vs. {2, 4, 5}
> lev <- LinStatExpCov(ix, y, nresample = 1000)
> (tst <- doTest(lev, teststat = "maximum", ordered = FALSE))
$TestStatistic
[1] 1.708775
$p.value
[1] 0.485
$index
[1] 0 1 0 1 1
> cmp3(mt, tst)
> (tst2 <- doTest(lev, teststat = "quadratic", ordered = FALSE))
$TestStatistic
[1] 2.919912
$p.value
[1] 0.485
$index
[1] 0 1 0 1 1
> cmp4(tst, tst2)
> lev <- LinStatExpCov(ix, y, nresample = 1000, varonly = TRUE)
> (tst <- doTest(lev, teststat = "maximum", ordered = FALSE))
$TestStatistic
[1] 1.708775
$p.value
[1] 0.476
$index
[1] 0 1 0 1 1
> cmp3(mt, tst)
> (tst2 <- doTest(lev, teststat = "quadratic", ordered = FALSE))
$TestStatistic
[1] 2.919912
$p.value
[1] 0.476
$index
[1] 0 1 0 1 1
> cmp4(tst, tst2)
>
> (mt <- maxstat_test(y ~ x | blk, distrib = approximate(nresample = 1000)))
Approximative Generalized Maximally Selected Statistics
data: y by x (1, 2, 3, 4, 5)
stratified by blk
maxT = 1.6489, p-value = 0.543
alternative hypothesis: two.sided
sample estimates:
"best" cutpoint: {1, 3} vs. {2, 4, 5}
> lev <- LinStatExpCov(ix, y, block = blk, nresample = 1000)
> (tst <- doTest(lev, teststat = "maximum", ordered = FALSE))
$TestStatistic
[1] 1.648947
$p.value
[1] 0.464
$index
[1] 0 1 0 1 1
> cmp3(mt, tst)
> (tst2 <- doTest(lev, teststat = "quadratic", ordered = FALSE))
$TestStatistic
[1] 2.719028
$p.value
[1] 0.464
$index
[1] 0 1 0 1 1
> cmp4(tst, tst2)
> lev <- LinStatExpCov(ix, y, block = blk, nresample = 1000, varonly = TRUE)
> try(tst <- doTest(lev, teststat = "maximum", ordered = FALSE))
Error in doTest(lev, teststat = "maximum", ordered = FALSE) :
need covariance for maximally statistics with blocks
>
> (mt <- maxstat_test(y + y2 ~ x , distrib = approximate(nresample = 1000)))
Approximative Generalized Maximally Selected Statistics
data: y, y2 by x (1, 2, 3, 4, 5)
maxT = 2.358, p-value = 0.285
alternative hypothesis: two.sided
sample estimates:
"best" cutpoint: {1, 3, 5} vs. {2, 4}
> lev <- LinStatExpCov(ix, cbind(y, y2), nresample = 1000)
> (tst <- doTest(lev, teststat = "maximum", ordered = FALSE))
$TestStatistic
[1] 2.357973
$p.value
[1] 0.301
$index
[1] 0 1 0 1 0
> cmp3(mt, tst)
> (tst <- doTest(lev, teststat = "quadratic", ordered = FALSE))
$TestStatistic
[1] 8.373114
$p.value
[1] 0.143
$index
[1] 0 1 0 1 1
> lev <- LinStatExpCov(ix, cbind(y, y2), nresample = 1000, varonly = TRUE)
> (tst <- doTest(lev, teststat = "maximum", ordered = FALSE))
$TestStatistic
[1] 2.357973
$p.value
[1] 0.275
$index
[1] 0 1 0 1 0
> cmp3(mt, tst)
> (tst <- doTest(lev, teststat = "quadratic", ordered = FALSE))
$TestStatistic
[1] 8.373114
$p.value
[1] 0.134
$index
[1] 0 1 0 1 1
>
> (mt <- maxstat_test(y + y2 ~ x | blk, distrib = approximate(nresample = 1000)))
Approximative Generalized Maximally Selected Statistics
data: y, y2 by x (1, 2, 3, 4, 5)
stratified by blk
maxT = 2.4473, p-value = 0.218
alternative hypothesis: two.sided
sample estimates:
"best" cutpoint: {1, 3, 5} vs. {2, 4}
> lev <- LinStatExpCov(ix, cbind(y, y2), block = blk, nresample = 50)
> (tst <- doTest(lev, teststat = "maximum", ordered = FALSE))
$TestStatistic
[1] 2.447272
$p.value
[1] 0.2
$index
[1] 0 1 0 1 0
> cmp3(mt, tst)
> (tst2 <- doTest(lev, teststat = "quadratic", ordered = FALSE))
$TestStatistic
[1] 8.115438
$p.value
[1] 0.12
$index
[1] 0 1 0 1 0
>
> xx <- factor(x %in% levels(x)[tst2$index == 1])
> (it <- independence_test(y + y2 ~ xx | blk, teststat = "quadratic"))
Asymptotic General Independence Test
data: y, y2 by xx (FALSE, TRUE)
stratified by blk
chi-squared = 8.1154, df = 2, p-value = 0.01729
> cmp3(it, tst2)
>
> lev <- LinStatExpCov(ix, cbind(y, y2), block = blk, nresample = 1000, varonly = TRUE)
> try(tst <- doTest(lev, teststat = "maximum", ordered = FALSE))
Error in doTest(lev, teststat = "maximum", ordered = FALSE) :
need covariance for maximally statistics with blocks
>
> proc.time()
user system elapsed
4.17 0.34 4.56
libcoin/tests/Examples/ 0000755 0001762 0000144 00000000000 14341133054 014607 5 ustar ligges users libcoin/tests/Examples/libcoin-Ex.Rout.save 0000644 0001762 0000144 00000005275 14341133054 020421 0 ustar ligges users
R Under development (unstable) (2022-10-11 r83083 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2022 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
Natural language support but running in an English locale
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> pkgname <- "libcoin"
> source(file.path(R.home("share"), "R", "examples-header.R"))
> options(warn = 1)
> options(pager = "console")
> library('libcoin')
>
> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
> base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv')
> cleanEx()
> nameEx("LinStatExpCov")
> ### * LinStatExpCov
>
> flush(stderr()); flush(stdout())
>
> ### Name: LinStatExpCov
> ### Title: Linear Statistics with Expectation and Covariance
> ### Aliases: LinStatExpCov lmult
> ### Keywords: htest
>
> ### ** Examples
>
> wilcox.test(Ozone ~ Month, data = airquality, subset = Month %in% c(5, 8),
+ exact = FALSE, correct = FALSE)
Wilcoxon rank sum test
data: Ozone by Month
W = 127.5, p-value = 0.0001164
alternative hypothesis: true location shift is not equal to 0
>
> aq <- subset(airquality, Month %in% c(5, 8))
> X <- as.double(aq$Month == 5)
> Y <- as.double(rank(aq$Ozone, na.last = "keep"))
> doTest(LinStatExpCov(X, Y))
$TestStatistic
[1] 3.853635
$p.value
[1] 0.0001163773
>
>
>
> cleanEx()
> nameEx("ctabs")
> ### * ctabs
>
> flush(stderr()); flush(stdout())
>
> ### Name: ctabs
> ### Title: Cross Tabulation
> ### Aliases: ctabs
> ### Keywords: univar
>
> ### ** Examples
>
> ctabs(ix = 1:5, iy = 1:5, weights = 1:5 / 5)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0.0 0.0 0.0 0.0 0
[2,] 0 0.2 0.0 0.0 0.0 0
[3,] 0 0.0 0.4 0.0 0.0 0
[4,] 0 0.0 0.0 0.6 0.0 0
[5,] 0 0.0 0.0 0.0 0.8 0
[6,] 0 0.0 0.0 0.0 0.0 1
>
>
>
> ### *