multcomp/ 0000755 0001762 0000144 00000000000 14646214331 012116 5 ustar ligges users multcomp/tests/ 0000755 0001762 0000144 00000000000 14442105627 013261 5 ustar ligges users multcomp/tests/regtest-anova.Rout.save 0000644 0001762 0000144 00000005054 14172227611 017652 0 ustar ligges users
R version 3.2.3 (2015-12-10) -- "Wooden Christmas-Tree"
Copyright (C) 2015 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (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("multcomp")
Loading required package: mvtnorm
Loading required package: survival
Loading required package: TH.data
Loading required package: MASS
Attaching package: 'TH.data'
The following object is masked from 'package:MASS':
geyser
> tol <- sqrt(.Machine$double.eps)
> set.seed(29081975)
>
> df <- data.frame(y = rnorm(100),
+ x = runif(100),
+ z = runif(100))
>
> ### linear model
> fam <- gaussian()
> lm0 <- glm(y ~ 1, data = df, family = fam)
> lm1 <- glm(y ~ x, data = df, family = fam)
> lm2 <- glm(y ~ x + z, data = df, family = fam)
>
> gh <- glht(lm2, linfct = c("x = 0", "z = 0"))
> stopifnot(abs(anova(lm0, lm2, test = "F")[2, 6] -
+ summary(gh, test = Ftest())$test$pvalue) < tol)
> stopifnot(abs(anova(lm0, lm2, test = "Chisq")[2, 5] -
+ summary(gh, test = Chisqtest())$test$pvalue) < tol)
>
> gh <- glht(lm2, linfct = "z = 0")
> stopifnot(abs(anova(lm1, lm2, test = "F")[2, 6] -
+ summary(gh, test = Ftest())$test$pvalue) < tol)
> stopifnot(abs(anova(lm1, lm2, test = "Chisq")[2, 5] -
+ summary(gh, test = Chisqtest())$test$pvalue) < tol)
>
> ### logistic regression
> df$y <- factor(df$y < 0)
> fam <- binomial()
> lm0 <- glm(y ~ 1, data = df, family = fam)
> lm1 <- glm(y ~ x, data = df, family = fam)
> lm2 <- glm(y ~ x + z, data = df, family = fam)
>
> if (require("lmtest")) {
+
+ gh <- glht(lm2, linfct = c("x = 0", "z = 0"))
+ stopifnot(abs(waldtest(lm0, lm2, test = "Chisq")[2, 4] -
+ summary(gh, test = Chisqtest())$test$pvalue) < tol)
+
+ gh <- glht(lm2, linfct = "z = 0")
+ stopifnot(abs(waldtest(lm1, lm2, test = "Chisq")[2, 4] -
+ summary(gh, test = Chisqtest())$test$pvalue) < tol)
+ }
Loading required package: lmtest
Loading required package: zoo
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
>
>
> proc.time()
user system elapsed
0.284 0.016 0.298
multcomp/tests/regtest-interface-extended.Rout.save 0000644 0001762 0000144 00000032113 14172227611 022300 0 ustar ligges users
R version 3.2.4 (2016-03-10) -- "Very Secure Dishes"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (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.
> ### test the extended interpreter for the left hand side of linear hypotheses
> ### Features:
> ### - fully recursive expression parser built upon a small code fragment copied over from base::codetools
> ### - the parser stops if any of the following conditions is not met:
> ### - any variable must be addressed only once
> ### - all operators and functions must finally evaluate to a a real valued literal
> ### - function parameters must not denote an effect name
> ### - effects can not be multiplied or divided by another effect
> ### - additive or subtractive terms involving an effect and a numeric
> ### constants must not be specified
> ### - coefficients associated with named effects must not evaluate to zero
> ###
> ### Examples:
> ### x1 + x1 == 0 -> not accepted
> ### x1 + x2 -1 == 0 -> not accepted
> ### x1 * x2 == 0 -> not accepted
> ### x1 / x2 == 0 -> not accepted
> ### f(x1) == 0 -> not accepted if x1 denotes an effect
> ### 2*3 == 6 -> not accepted because no effect was named
> ### x1 + x2*0 == 0 -> not accepted because this is likely an oversight
> ### x1 + 3*(4-5+1)*x2 == 0 -> not accepted because this is likely an oversight
> ### x1*3/0 == 0 -> not accepted because coefficient would become infinite
> ### log(-1)*x1 == 0 -> not accepted, because the result is not finite
> ### x1 + x2 +0 == 0 -> accepted because adding zero does not make a difference
> ### sin(pi/2) * x1 == 0 -> accepted if 'pi' is not an effect
> ### sin(Pi/2) * x1 == 0 -> accepted if 'Pi' is not an effect. However, if the environment does not define Pi the evaluation may still fail.
>
>
> tmp <- multcomp:::chrlinfct2matrix( c( l01 = " x1 - x2 = 2"
+ , l02 = " x2 + 3 * x3 = 1"
+ , l03 = " (x1 - x2) - (x3 - x4) = 0"
+ , l04 = "+(x1 - x2)*-2 - (1/3+2)*( +x3 - 2*x4 ) = -1"
+ , l05 = "-(x1 - x2)*-2 - (1/3+2)*( -x3 - 2*x4 ) = -2"
+ , l06 = "-(x1 - x2)*-2 - (1/3+2)*( -x3 - 2*x4 )*7/-10 = -3"
+ , l07 = "-1*(x1:x2 - x1:x2:x3) - x3 = -4"
+ , l08 = "-(x1:x2 - x1:x2:x3) - x3 = -4"
+ , l09 = "-(x1:x2 - 3*x1:x2:x3)*-2 - x3 -5/3*-x4= -5"
+ , l10 = "--cos(pi/2)*x1 - 10*(log(10^-3)+1)*-x2 -10^-3*x3 + -exp(-2)*x4= -6"
+ , l11 = " x1 + x2 + 0 = -7"
+ ), c('x1','x2','x3','x4','x1:x2','x1:x2:x3') )
>
> stopifnot(max(abs( dK <- tmp$K -
+ rbind( c( 1, -1, 0, 0, 0, 0 )
+ , c( 0, 1, 3, 0, 0, 0 )
+ , c( 1, -1, -1, 1, 0, 0 )
+ , c( -2, 2, -(1/3+2), 2*(1/3+2), 0, 0 )
+ , c( 2, -2, (1/3+2), 2*(1/3+2), 0, 0 )
+ , c( 2, -2, (1/3+2)*-7/10, 2*(1/3+2)*-7/10, 0, 0 )
+ , c( 0, 0, -1, 0, -1, 1 )
+ , c( 0, 0, -1, 0, -1, 1 )
+ , c( 0, 0, -1, -5/3*-1, 2, -6 )
+ , c( --cos(pi/2), 10*(log(10^-3)+1), -10^-3, -exp(-2), 0, 0 )
+ , c( 1, 1, 0, 0, 0, 0 )
+ ))) < sqrt(.Machine$double.eps))
>
> stopifnot(max(abs( tmp$m -
+ c( 2
+ , 1
+ , 0
+ , -1
+ , -2
+ , -3
+ , -4
+ , -4
+ , -5
+ , -6
+ , -7
+ ))) < sqrt(.Machine$double.eps))
>
> expectFail <- function(testname, x) {
+ if ( class(x) != 'try-error' ) {
+ stop(testname, ' unexpectedly succeeded. Result is: ', paste(x, collapse = ', '),'\n')
+ }
+ message(testname, ' expectedly failed. Message is: ', attr(x,'condition')$message, '\n')
+ }
>
> expectSucc <- function(testname, x,expected) {
+ if ( class(x) == 'try-error' ) {
+ stop(testname, ' unexpectedly failed. Message is: ', attr(x,'condition')$message, '\n')
+ }
+ message(testname, ' expectedly succeeded.',
+ ' Expected result is: ', paste(x, collapse = ', '), ', ',
+ ' actual result is: ', paste(x, collapse = ', '), '\n')
+
+ stopifnot(all.equal(as.vector(x$K),expected$K))
+ stopifnot(all.equal(as.vector(x$m),expected$m))
+ stopifnot(all(as.vector(x$alternative) %in% expected$alternative))
+ }
>
> expectFail('test 01', try( multcomp:::chrlinfct2matrix( c('x1 - x1 = 0'), c('x1','x2')), silent = T))
test 01 expectedly failed. Message is: multcomp:::expression2coef::walkCode::sub: multiple occurence of 'x1' found within expression 'x1 - x1'
>
> expectFail('test 02', try( multcomp:::chrlinfct2matrix( c('x1 - X2 = 0'), c('x1','x2')), silent = T))
test 02 expectedly failed. Message is: multcomp:::chrlinfct2matrix: variable(s) 'X2' not found
>
> expectFail('test 03', try( multcomp:::chrlinfct2matrix( c('x1 - x2 -1 = 0'), c('x1','x2')), silent = T))
test 03 expectedly failed. Message is: multcomp:::expression2coef::walkCode::sub: forming a difference between a constant and an effect as in 'x1 - x2 - 1' is not supported
>
> expectFail('test 04', try( multcomp:::chrlinfct2matrix( c('x1 * x2 = 0'), c('x1','x2')), silent = T))
test 04 expectedly failed. Message is: multcomp:::expression2coef::walkCode::mul: the multiplication of effects 'x1', 'x2' as in 'x1 * x2' is not supported
>
> expectFail('test 05', try( multcomp:::chrlinfct2matrix( c('x1 / x2 = 0'), c('x1','x2')), silent = T))
test 05 expectedly failed. Message is: multcomp:::expression2coef::walkCode::div: cant't divide by effect 'x2' in 'x1/x2'
>
> expectFail('test 06', try( multcomp:::chrlinfct2matrix( c('x1 - exp(x2) = 0'), c('x1','x2')), silent = T))
test 06 expectedly failed. Message is: multcomp:::expression2coef::walkCode::eval: within 'exp(x2)', the term 'x2' must not denote an effect. Apart from that, the term must evaluate to a real valued constant
>
> expectFail('test 07', try( multcomp:::chrlinfct2matrix( c('sin(Pi)*x1 = 0'), c('x1','x2')), silent = T))
test 07 expectedly failed. Message is: multcomp:::expression2coef::walkCode::eval: the evaluation of the expression 'sin(Pi)' failed with "object 'Pi' not found"
>
> expectFail('test 08', try( multcomp:::chrlinfct2matrix( c('3*4 = 0'), c('x1','x2')), silent = T))
test 08 expectedly failed. Message is: multcomp:::expression2coef: The lhs expression '3 * 4' contains a numeric offset term evaluating to 12. This is either an internal error or a misspecification from your part. If so, please pull these offsets to the right-hand side of the equation
>
> expectFail('test 09', try( multcomp:::chrlinfct2matrix( c('x1 + 3*(4-5+1)*x2 = 0'), c('x1','x2')), silent = T))
test 09 expectedly failed. Message is: multcomp:::expression2coef::walkCode::mul: The constant part of the expression '3 * (4 - 5 + 1) * x2' evaluates to zero. This would zero out the effect(s) 'x2'
>
> expectFail('test 10', try( multcomp:::chrlinfct2matrix( c('x1*3/0 = 0'), c('x1','x2')), silent = T))
test 10 expectedly failed. Message is: multcomp:::expression2coef::walkCode::div: can't divide by '0' in 'x1 * 3/0'
>
> expectFail('test 11', try( multcomp:::chrlinfct2matrix( c('log(-1)*x1 = 0'), c('x1','x2')), silent = T))
test 11 expectedly failed. Message is: multcomp:::expression2coef::walkCode::eval: the expression 'log(-1)' did not evaluate to a real valued constant. Result is 'NaN'
Warning message:
In log(-1 * 1) : NaNs produced
>
> expectSucc('test 12', try( multcomp:::chrlinfct2matrix( c('x1 -x2 -1/2*(-x2:x3 + x4:x5) = 0'),
+ c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3','x4:x5')), silent = T),
+ expected = list( K = c( 1, -1, 0, 0, 0, 1/2, -1/2),
+ m = 0, alternative = 'two.sided'))
test 12 expectedly succeeded. Expected result is: c(1, -1, 0, 0, 0, 0.5, -0.5), 0, two.sided, actual result is: c(1, -1, 0, 0, 0, 0.5, -0.5), 0, two.sided
>
> expectSucc('test 13', try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(--x2:x3 + x4:x5) = 0'),
+ c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3','x4:x5')), silent = T),
+ expected = list( K = c( 1, -1, 0, 0, 0, -1/2, -1/2),
+ m = 0, alternative = 'two.sided'))
test 13 expectedly succeeded. Expected result is: c(1, -1, 0, 0, 0, -0.5, -0.5), 0, two.sided, actual result is: c(1, -1, 0, 0, 0, -0.5, -0.5), 0, two.sided
>
> expectSucc('test 14', try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(`-x2:x3` + x4:x5) = 0'),
+ c( 'x1', 'x2', 'x3', 'x4', 'x5', '-x2:x3','x4:x5')), silent = T),
+ expected = list( K = c( 1, -1, 0, 0, 0, -1/2, -1/2),
+ m = 0, alternative = 'two.sided'))
test 14 expectedly succeeded. Expected result is: c(1, -1, 0, 0, 0, -0.5, -0.5), 0, two.sided, actual result is: c(1, -1, 0, 0, 0, -0.5, -0.5), 0, two.sided
>
> expectSucc('test 15', try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(-(x2:x3) + x4:x5) = 0'),
+ c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3','x4:x5')), silent = T),
+ expected = list( K = c( 1, -1, 0, 0, 0, 1/2, -1/2),
+ m = 0, alternative = 'two.sided'))
test 15 expectedly succeeded. Expected result is: c(1, -1, 0, 0, 0, 0.5, -0.5), 0, two.sided, actual result is: c(1, -1, 0, 0, 0, 0.5, -0.5), 0, two.sided
>
> expectSucc('test 16', try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(-1*x2:x3 + x4:x5) = 0'),
+ c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3','x4:x5')), silent = T),
+ expected = list( K = c( 1, -1, 0, 0, 0, 1/2, -1/2),
+ m = 0, alternative = 'two.sided'))
test 16 expectedly succeeded. Expected result is: c(1, -1, 0, 0, 0, 0.5, -0.5), 0, two.sided, actual result is: c(1, -1, 0, 0, 0, 0.5, -0.5), 0, two.sided
>
>
>
> expectSucc('test 17', try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(+-+--x2:x3:x4 + x4:x5) = 0'),
+ c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3:x4','x4:x5')), silent = T),
+ expected = list( K = c( 1, -1, 0, 0, 0, 1/2, -1/2),
+ m = 0, alternative = 'two.sided'))
test 17 expectedly succeeded. Expected result is: c(1, -1, 0, 0, 0, 0.5, -0.5), 0, two.sided, actual result is: c(1, -1, 0, 0, 0, 0.5, -0.5), 0, two.sided
>
> expectFail('test 18', try( multcomp:::chrlinfct2matrix( c( 'x1 - x2 - 1/2 * ( x2:-x3 + x4:x5 ) = 0'),
+ c( 'x1','x2','x2:x3','x4:x5')), silent = T))
test 18 expectedly failed. Message is: multcomp:::chrlinfct2matrix: variable(s) 'x2:-x3' not found
>
>
>
> proc.time()
user system elapsed
0.916 0.016 0.930
multcomp/tests/regtest-mmm.R 0000644 0001762 0000144 00000011175 14172227611 015650 0 ustar ligges users
library("multcomp")
### compare results of mmod and glht.mlf
### code by Christian Ritz
"mmod" <- function(modelList, varName, seType = "san")
{
require(multcomp, quietly = TRUE)
require(sandwich, quietly = TRUE)
if (length(seType) == 1) {seType <- rep(seType, length(modelList))}
if (length(varName) == 1) {varName <- rep(varName, length(modelList))}
## Extracting score contributions from the individual model fits
makeIIDdecomp <- function(modelObject, varName)
{
numObsUsed <- ifelse(inherits(modelObject, "coxph"), modelObject$n, nrow(modelObject$model))
iidVec0 <- bread(modelObject)[varName, , drop = FALSE] %*% t(estfun(modelObject))
moNAac <- modelObject$na.action
numObs <- numObsUsed + length(moNAac)
iidVec <- rep(0, numObs)
if (!is.null(moNAac))
{
iidVec[-moNAac] <- sqrt(numObs/numObsUsed) * iidVec0
}
else {
iidVec <- iidVec0
}
list(iidVec = iidVec, numObsUsed = numObsUsed, numObs = numObs)
}
numModels <- length(modelList)
if (identical(length(varName), 1))
{
varName <- rep(varName, numModels)
}
iidList <- mapply(makeIIDdecomp, modelList, varName, SIMPLIFY = FALSE)
iidresp <- matrix(as.vector(unlist(lapply(iidList, function(listElt) {listElt[[1]]}))), nrow = numModels, byrow = TRUE)
pickFct <- function(modelObject, varName, matchStrings)
{
as.vector(na.omit((coef(summary(modelObject))[varName, ])[matchStrings]))
}
## Retrieving parameter estimates from the individual fits
estVec <- as.vector(unlist(mapply(pickFct, modelList, varName, MoreArgs = list(matchStrings = c("Estimate", "coef")))))
# "Estimate" or "coef" used in glm(), lm() and coxph() summary output, respectively
## Calculating the estimated variance-covariance matrix of the parameter estimates
numObs <- iidList[[1]]$numObs
covar <- (iidresp %*% t(iidresp)) / numObs
vcMat <- covar / numObs # Defining the finite-sample variance-covariance matrix
## Replacing sandwich estimates by model-based standard errors
modbas <- seType == "mod"
if (any(modbas))
{
corMat <- cov2cor(vcMat)
## Retrieving standard errors for the specified estimate from the individual fits
modSE <- as.vector(unlist(mapply(pickFct, modelList, varName, MoreArgs = list(matchStrings = c("Std. Error", "se(coef)")))))
sanSE <- sqrt(diag(vcMat))
sanSE[modbas] <- modSE[modbas]
vcMat <- diag(sanSE) %*% corMat %*% diag(sanSE)
}
## Naming the parameter vector (easier way to extract the names of the model fits provided as a list in the first argument?)
names1 <- sub("list", "", deparse(substitute(modelList)), fixed = TRUE)
names2 <- sub("(", "", names1, fixed = TRUE)
names3 <- sub(")", "", names2, fixed = TRUE)
names4 <- sub(" ", "", names3, fixed = TRUE)
names(estVec) <- unlist(strsplit(names4, ","))
return(parm(coef = estVec, vcov = vcMat, df = 0))
}
set.seed(29)
## Combining linear regression and logistic regression
y1 <- rnorm(100)
y2 <- factor(y1 + rnorm(100, sd = .1) > 0)
x1 <- gl(4, 25)
x2 <- runif(100, 0, 10)
m1 <- lm(y1 ~ x1 + x2)
m2 <- glm(y2 ~ x1 + x2, family = binomial())
## Note that the same explanatory variables are considered in both models
## but the resulting parameter estimates are on 2 different scales (original and log-odds scales)
## Simultaneous inference for the same parameter in the 2 model fits
simult.x12 <- mmod(list(m1, m2), c("x12", "x12"))
summary(glht(simult.x12))
## Simultaneous inference for different parameters in the 2 model fits
simult.x12.x13 <- mmod(list(m1, m2), c("x12", "x13"))
summary(glht(simult.x12.x13))
## Simultaneous inference for different and identical parameters in the 2 model fits
simult.x12x2.x13 <- mmod(list(m1, m1, m2), c("x12", "x13", "x13"))
summary(glht(simult.x12x2.x13))
confint(glht(simult.x12x2.x13))
## Examples for binomial data
## Two independent outcomes
y1.1 <- rbinom(100, 1, 0.5)
y1.2 <- rbinom(100, 1, 0.5)
group <- factor(rep(c("A", "B"), 50))
modely1.1 <- glm(y1.1 ~ group, family = binomial)
modely1.2 <- glm(y1.2 ~ group, family = binomial)
mmObj.y1 <- mmod(list(modely1.1, modely1.2), "groupB")
simult.y1 <- glht(mmObj.y1)
summary(simult.y1)
## Two perfectly correlated outcomes
y2.1 <- rbinom(100, 1, 0.5)
y2.2 <- y2.1
group <- factor(rep(c("A", "B"), 50))
modely2.1 <- glm(y2.1 ~ group, family = binomial)
modely2.2 <- glm(y2.2 ~ group, family = binomial)
mmObj.y2 <- mmod(list(modely2.1, modely2.2), "groupB")
simult.y2 <- glht(mmObj.y2)
summary(simult.y2)
multcomp/tests/regtest-Tukey.R 0000644 0001762 0000144 00000000617 14172227611 016162 0 ustar ligges users
library("multcomp")
set.seed(290875)
data("warpbreaks")
fm1 <- aov(breaks ~ wool + tension, data = warpbreaks)
TukeyHSD(fm1, "tension", ordered = FALSE)
confint(glht(fm1, linfct = mcp(tension = "Tukey")))
summary(glht(fm1, linfct = mcp(tension = "Tukey")))
TukeyHSD(fm1, "wool", ordered = FALSE)
confint(glht(fm1, linfct = mcp(wool = "Tukey")))
summary(glht(fm1, linfct = mcp(wool = "Tukey")))
multcomp/tests/angina.rda 0000644 0001762 0000144 00000002602 14172227611 015204 0 ustar ligges users RDX2
X
angina
2 levels 0 1 2 3 4 class factor þ 2@(\(õÂ@3\(õÂ@,záG®{@&W
=p£×@00£×
=q@%™™™™™š@*\(õÂ\@$³33333@/úáG®{@2\(õÃ@1Š=p£×
@.õÂ\(ö@5B\(õÃ@#B\(õÃ@-\(õÂ@/¸Që…@0333333@)¸Që…¸@7Ç®záH@.\(õÂ\@2øQë…¸@2õÂ\(ö@2ë…¸Qì@+¸Që…@0E¸Që…@1}p£×
=@/W
=p£×@,Ñë…¸R@1îzáG®@6Ü(õÂ\@4™™™™™š@30£×
=q@7aG®zá@2…¸Që…@1s33333@-Ü(õÂ\@5(õÂ\)@*\(õÂ@5‚\(õÃ@5333333@9J=p£×
@@(õÂ\)@8záG®@2@ @:úáG®{@