libcoin/0000755000176200001440000000000014505002061011662 5ustar liggesuserslibcoin/NAMESPACE0000644000176200001440000000030214341133054013101 0ustar liggesusers useDynLib(libcoin, .registration = TRUE) importFrom("stats", complete.cases, vcov) importFrom("mvtnorm", GenzBretz) export(LinStatExpCov, doTest, ctabs, lmult) S3method(vcov, LinStatExpCov) libcoin/man/0000755000176200001440000000000014504772042012451 5ustar liggesuserslibcoin/man/LinStatExpCov.Rd0000644000176200001440000000566114344071245015452 0ustar liggesusers \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.Rd0000644000176200001440000000171114504772042014034 0ustar liggesusers \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.Rd0000644000176200001440000000317214344071245014204 0ustar liggesusers \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/DESCRIPTION0000644000176200001440000000216114505002057013375 0ustar liggesusersPackage: 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/0000755000176200001440000000000014504776233013003 5ustar liggesuserslibcoin/build/vignette.rds0000644000176200001440000000037714504776233015351 0ustar liggesusersuPj0 U.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/0000755000176200001440000000000014172231233013031 5ustar liggesuserslibcoin/tests/regtest_libcoin.Rout.save0000644000176200001440000005342514172231233020026 0ustar liggesusers 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/0000755000176200001440000000000014341133054014607 5ustar liggesuserslibcoin/tests/Examples/libcoin-Ex.Rout.save0000644000176200001440000000527514341133054020421 0ustar liggesusers 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 > > > > ### *