Binary files 2.27623/build/vignette.rds and 2.3001/build/vignette.rds differ
diff pruN 2.27623/debian/changelog 2.3001/debian/changelog
 2.27623/debian/changelog 20180605 08:13:53.000000000 +0000
+++ 2.3001/debian/changelog 20181203 10:34:49.000000000 +0000
@@ 1,3 +1,15 @@
+rcranlsmeans (2.3001) unstable; urgency=medium
+
+ [ Jelmer Vernooĳ ]
+ * Use secure URI in Homepage field.
+
+ [ Andreas Tille ]
+ * StandardsVersion: 4.2.1
+ * Remove trailing whitespace in debian/changelog
+ * Update BuildDepends
+
+  Andreas Tille Mon, 03 Dec 2018 11:34:49 +0100
+
rcranlsmeans (2.27623) unstable; urgency=medium
* Team upload.
@@ 69,19 +81,19 @@ rcranlsmeans (2.241) unstable; urgenc
rcranlsmeans (2.231) unstable; urgency=low
 * New upstream release
+ * New upstream release
 Jonathon Love Thu, 21 Apr 2016 14:29:47 +1000
rcranlsmeans (2.2111) unstable; urgency=low
 * New upstream release
+ * New upstream release
 Jonathon Love Sat, 19 Dec 2015 15:18:02 +1100
rcranlsmeans (2.211) unstable; urgency=low
 * New upstream release
+ * New upstream release
 Jonathon Love Sat, 05 Dec 2015 12:21:20 +0100
diff pruN 2.27623/debian/control 2.3001/debian/control
 2.27623/debian/control 20180605 08:13:53.000000000 +0000
+++ 2.3001/debian/control 20181203 10:34:49.000000000 +0000
@@ 7,17 +7,11 @@ Priority: optional
BuildDepends: debhelper (>= 11~),
dhr,
rbasedev,
 rcranestimability,
 rcrannlme,
 rcrancoda (>= 0.17),
 rcranmultcomp,
 rcranplyr,
 rcranmvtnorm,
 rcranxtable
StandardsVersion: 4.1.4
+ rcranemmeans (>= 1.3)
+StandardsVersion: 4.2.1
VcsBrowser: https://salsa.debian.org/rpkgteam/rcranlsmeans
VcsGit: https://salsa.debian.org/rpkgteam/rcranlsmeans.git
Homepage: http://cran.rproject.org/package=lsmeans
+Homepage: https://cran.rproject.org/package=lsmeans
Package: rcranlsmeans
Architecture: all
diff pruN 2.27623/DESCRIPTION 2.3001/DESCRIPTION
 2.27623/DESCRIPTION 20180511 11:03:05.000000000 +0000
+++ 2.3001/DESCRIPTION 20181102 23:50:11.000000000 +0000
@@ 1,23 +1,14 @@
Package: lsmeans
Type: Package
Title: LeastSquares Means
Version: 2.2762
Date: 20180510
+Version: 2.300
+Date: 20181102
Authors@R: c(person("Russell", "Lenth", role = c("aut", "cre", "cph"),
 email = "russelllenth@uiowa.edu"),
 person("Jonathon", "Love", role = "ctb"))
Depends: methods, R (>= 3.2)
Suggests: car, lattice, MCMCpack, mediation, multcompView, ordinal,
 pbkrtest (>= 0.41), CARBayes, coxme, gee, geepack, glmmADMB,
 lme4, lmerTest (>= 2.0.32), MASS, MCMCglmm, nnet, pscl, rsm,
 rstan, rstanarm, survival
Imports: estimability, graphics, stats, utils, nlme, coda (>= 0.17),
 multcomp, plyr, mvtnorm, xtable (>= 1.82)
Additional_repositories: http://glmmadmb.rforge.rproject.org/repos
BugReports: https://github.com/rvlenth/lsmeans/issues
LazyData: yes
+ email = "russelllenth@uiowa.edu"))
+Depends: emmeans (>= 1.3), methods, R (>= 3.2)
+Suggests:
ByteCompile: yes
Description: Obtain leastsquares means for many linear, generalized linear,
+Description: Obtain leastsquares means for linear, generalized linear,
and mixed models. Compute contrasts or linear functions of
leastsquares means, and comparisons of slopes.
Plots and compact letter displays. Leastsquares means were proposed in
@@ 26,13 +17,12 @@ Description: Obtain leastsquares means
further in Searle, Speed, and Milliken (1980) "Population marginal means
in the linear model: An alternative to least squares means",
The American Statistician 34(4), 216221 .
 NOTE: Users are encouraged to switch to the 'emmeans' package,
 as 'lsmeans' will be archived in the nottoodistant future.
+ NOTE: lsmeans now relies primarily on code in the 'emmeans' package.
+ 'lsmeans' will be archived in the near future.
License: GPL2  GPL3
NeedsCompilation: no
Packaged: 20180510 15:10:04 UTC; rlenth
Author: Russell Lenth [aut, cre, cph],
 Jonathon Love [ctb]
+Packaged: 20181102 19:06:49 UTC; rlenth
+Author: Russell Lenth [aut, cre, cph]
Maintainer: Russell Lenth
Repository: CRAN
Date/Publication: 20180511 11:03:05 UTC
+Date/Publication: 20181102 23:50:11 UTC
Binary files 2.27623/inst/doc/usinglsmeans.pdf and 2.3001/inst/doc/usinglsmeans.pdf differ
diff pruN 2.27623/inst/doc/usinglsmeans.R 2.3001/inst/doc/usinglsmeans.R
 2.27623/inst/doc/usinglsmeans.R 20180510 15:10:03.000000000 +0000
+++ 2.3001/inst/doc/usinglsmeans.R 19700101 00:00:00.000000000 +0000
@@ 1,696 +0,0 @@
### R code from vignette source 'usinglsmeans.rnw'

###################################################
### code chunk number 1: usinglsmeans.rnw:6971
###################################################
options(show.signif.stars=FALSE, prompt="R> ", continue=" ",
 useFancyQuotes=FALSE, width=100, digits=6)


###################################################
### code chunk number 2: usinglsmeans.rnw:155158
###################################################
library("lsmeans")
oranges.lm1 < lm(sales1 ~ price1 + price2 + day + store, data = oranges)
anova(oranges.lm1)


###################################################
### code chunk number 3: usinglsmeans.rnw:161162
###################################################
( oranges.rg1 < ref.grid(oranges.lm1) )


###################################################
### code chunk number 4: usinglsmeans.rnw:165166
###################################################
summary(oranges.rg1)


###################################################
### code chunk number 5: usinglsmeans.rnw:171172
###################################################
lsmeans(oranges.rg1, "day") ## or lsmeans(oranges.lm1, "day")


###################################################
### code chunk number 6: usinglsmeans.rnw:175176
###################################################
with(oranges, tapply(sales1, day, mean))


###################################################
### code chunk number 7: usinglsmeans.rnw:187189
###################################################
lsmeans(oranges.lm1, "day", at = list(price1 = 50,
 price2 = c(40,60), day = c("2","3","4")) )


###################################################
### code chunk number 8: usinglsmeans.rnw:198201
###################################################
org.lsm < lsmeans(oranges.lm1, "day", by = "price2",
 at = list(price1 = 50, price2 = c(40,60), day = c("2","3","4")) )
org.lsm


###################################################
### code chunk number 9: usinglsmeans.rnw:204207 (eval = FALSE)
###################################################
## lsmeans(oranges.lm1, ~ day  price, at = ... ) # Ex 1
## lsmeans(oranges.lm1, c("day","price2"), at = ... ) # Ex 2
## lsmeans(oranges.lm1, ~ day * price, at = ... ) # Ex 3


###################################################
### code chunk number 10: usinglsmeans.rnw:217218
###################################################
str(org.lsm)


###################################################
### code chunk number 11: usinglsmeans.rnw:224226
###################################################
( org.sum < summary(org.lsm, infer = c(TRUE,TRUE),
 level = .90, adjust = "bon", by = "day") )


###################################################
### code chunk number 12: usinglsmeans.rnw:231232
###################################################
class(org.sum)


###################################################
### code chunk number 13: usinglsmeans.rnw:236237
###################################################
transform(org.sum, lsrubles = lsmean * 34.2)


###################################################
### code chunk number 14: usinglsmeans.rnw:245247
###################################################
org.lsm2 < update(org.lsm, by.vars = NULL, level = .99)
org.lsm2


###################################################
### code chunk number 15: orgplot
###################################################
plot(org.lsm, by = "price2")


###################################################
### code chunk number 16: usinglsmeans.rnw:270271
###################################################
contrast(org.lsm, method = "eff")


###################################################
### code chunk number 17: usinglsmeans.rnw:276278
###################################################
days.lsm < lsmeans(oranges.rg1, "day")
( days_contr.lsm < contrast(days.lsm, "trt.vs.ctrl", ref = c(5,6)) )


###################################################
### code chunk number 18: usinglsmeans.rnw:283284 (eval = FALSE)
###################################################
## confint(contrast(days.lsm, "trt.vs.ctrlk"))


###################################################
### code chunk number 19: usinglsmeans.rnw:292293
###################################################
pairs(org.lsm)


###################################################
### code chunk number 20: usinglsmeans.rnw:296297
###################################################
cld(days.lsm, alpha = .10)


###################################################
### code chunk number 21: dayscmp
###################################################
plot(days.lsm, comparisons = TRUE, alpha = .10)


###################################################
### code chunk number 22: usinglsmeans.rnw:324325
###################################################
rbind(pairs(org.lsm)[1:3], pairs(org.lsm, by = "day")[1])


###################################################
### code chunk number 23: usinglsmeans.rnw:330331
###################################################
rbind(pairs(lsmeans(org.lsm, "day")), pairs(lsmeans(org.lsm, "price2")))


###################################################
### code chunk number 24: usinglsmeans.rnw:337340
###################################################
oranges.mlm < lm(cbind(sales1,sales2) ~ price1 + price2 + day + store,
 data = oranges)
ref.grid(oranges.mlm)


###################################################
### code chunk number 25: usinglsmeans.rnw:343345
###################################################
org.mlsm < lsmeans(oranges.mlm, ~ day  variety, mult.name = "variety")
cld(org.mlsm, sort = FALSE)


###################################################
### code chunk number 26: usinglsmeans.rnw:353354
###################################################
org.vardiff < update(pairs(org.mlsm, by = "day"), by = NULL)


###################################################
### code chunk number 27: usinglsmeans.rnw:357358
###################################################
cld(org.vardiff)


###################################################
### code chunk number 28: usinglsmeans.rnw:364366
###################################################
org.icon < contrast(org.mlsm, interaction = c("poly", "pairwise"))
org.icon


###################################################
### code chunk number 29: usinglsmeans.rnw:370371
###################################################
coef(org.icon)


###################################################
### code chunk number 30: usinglsmeans.rnw:379381
###################################################
# Ensure we see the same results each time
set.seed(123454321)


###################################################
### code chunk number 31: usinglsmeans.rnw:383386
###################################################
library("multcomp")
days.glht < as.glht(days_contr.lsm)
summary(days.glht, test = adjusted("Westfall"))


###################################################
### code chunk number 32: usinglsmeans.rnw:389391 (eval = FALSE)
###################################################
## days.glht1 < glht(oranges.lm1,
## lsm("day", contr = "trt.vs.ctrl", ref = c(5,6)))


###################################################
### code chunk number 33: usinglsmeans.rnw:395397 (eval = FALSE)
###################################################
## summary(days_contr.lsm, adjust = "mvt")
## summary(days.glht)


###################################################
### code chunk number 34: usinglsmeans.rnw:403404 (eval = FALSE)
###################################################
## summary(as.glht(pairs(org.lsm)))


###################################################
### code chunk number 35: usinglsmeans.rnw:407408 (eval = FALSE)
###################################################
## summary(as.glht(pairs(org.lsm), by = NULL))


###################################################
### code chunk number 36: usinglsmeans.rnw:411412 (eval = FALSE)
###################################################
## summary(as.glht(pairs(org.lsm, by = NULL)))


###################################################
### code chunk number 37: usinglsmeans.rnw:424429
###################################################
data("Oats", package = "nlme")
library("lme4")
Oats.lmer < lmer(log(yield) ~ Variety*factor(nitro) + (1Block/Variety),
 data = Oats)
anova(Oats.lmer)


###################################################
### code chunk number 38: oatcontr (eval = FALSE)
###################################################
## contrast(lsmeans(Oats.lmer, "nitro"), "poly")


###################################################
### code chunk number 39: usinglsmeans.rnw:436437
###################################################
cat("NOTE: Results may be misleading due to involvement in interactions")


###################################################
### code chunk number 40: usinglsmeans.rnw:439440
###################################################
contrast(lsmeans(Oats.lmer, "nitro"), "poly")


###################################################
### code chunk number 41: usinglsmeans.rnw:444446
###################################################
Oats.lmer2 < lmer(log(yield) ~ Variety + poly(nitro,2)
 + (1Block/Variety), data = Oats)


###################################################
### code chunk number 42: usinglsmeans.rnw:450451
###################################################
Oats.lsm2 < lsmeans(Oats.lmer2, ~ nitro  Variety, cov.reduce = FALSE)


###################################################
### code chunk number 43: usinglsmeans.rnw:463468
###################################################
library("xtable")
xtbl < xtable(Oats.lsm2, caption = "Example using \\texttt{xtable}",
 label = "xtable:example")
print(xtbl, table.placement = "t")
cat("See Table~\\ref{xtable:example}.\n")


###################################################
### code chunk number 44: oatslmer
###################################################
lsmip(Oats.lmer, Variety ~ nitro, ylab = "Observed log(yield)")


###################################################
### code chunk number 45: oatslmer2
###################################################
lsmip(Oats.lsm2, Variety ~ nitro, ylab = "Predicted log(yield)")


###################################################
### code chunk number 46: usinglsmeans.rnw:504505
###################################################
str(Oats.lsm2)


###################################################
### code chunk number 47: usinglsmeans.rnw:508509
###################################################
summary(Oats.lsm2, type = "response")


###################################################
### code chunk number 48: usinglsmeans.rnw:520524
###################################################
Oats.log1 < lmer(log(yield + 5) ~ Variety + factor(nitro)
 + (1Block/Variety), data = Oats)
( Oats.rg1 < update(ref.grid(Oats.log1),
 tran = make.tran("genlog", 5)) )


###################################################
### code chunk number 49: usinglsmeans.rnw:529530
###################################################
round(predict(Oats.rg1, type = "response"), 1)


###################################################
### code chunk number 50: usinglsmeans.rnw:535537
###################################################
my.tran < make.tran("boxcox", c(.567, 10))
my.tran$linkfun(10:15)


###################################################
### code chunk number 51: usinglsmeans.rnw:545549
###################################################
Oats.bc < with(my.tran, lmer(linkfun(yield) ~ Variety + factor(nitro)
 + (1Block/Variety), data = Oats))
( rg.bc < ref.grid(Oats.bc) )
round(predict(rg.bc, type = "response"), 1)


###################################################
### code chunk number 52: usinglsmeans.rnw:554555
###################################################
rg.bc.regrid < regrid(rg.bc)


###################################################
### code chunk number 53: usinglsmeans.rnw:558559
###################################################
round(rg.bc.regrid@bhat, 1)


###################################################
### code chunk number 54: usinglsmeans.rnw:564566
###################################################
summary(lsmeans(rg.bc, "Variety"), type = "response")
lsmeans(rg.bc.regrid, "Variety")


###################################################
### code chunk number 55: usinglsmeans.rnw:585589
###################################################
rg.log < regrid(rg.bc, "log")
lsm.log < lsmeans(rg.log, "Variety")
summary(lsm.log, type = "response")
summary(pairs(lsm.log), type = "response")


###################################################
### code chunk number 56: usinglsmeans.rnw:599601
###################################################
warp.glm < glm(sqrt(breaks) ~ wool * tension, family = gaussian(link = "log"),
 data = warpbreaks)


###################################################
### code chunk number 57: usinglsmeans.rnw:604606
###################################################
warp.rg < ref.grid(warp.glm)
warp.rg


###################################################
### code chunk number 58: usinglsmeans.rnw:609612
###################################################
predict(warp.rg, type = "linear") ### log(sqrt) scale  no backtransformation
predict(warp.rg, type = "unlink") ### sqrt scale
predict(warp.rg, type = "response") ### response scale


###################################################
### code chunk number 59: usinglsmeans.rnw:622624
###################################################
Oats.Vlsm = lsmeans(Oats.lmer2, "Variety")
test(Oats.Vlsm, null = log(100), type = "response")


###################################################
### code chunk number 60: usinglsmeans.rnw:636637
###################################################
test(Oats.Vlsm, null = log(100), delta = 0.20, type = "r")


###################################################
### code chunk number 61: usinglsmeans.rnw:644645
###################################################
test(contrast(Oats.Vlsm, "trt.vs.ctrlk"), side = ">")


###################################################
### code chunk number 62: usinglsmeans.rnw:649650
###################################################
test(contrast(Oats.Vlsm, "trt.vs.ctrlk"), side = "nonsup", delta = .25)


###################################################
### code chunk number 63: chickplot
###################################################
require("lattice")
xyplot(weight ~ Time  Diet, groups = ~ Chick, data = ChickWeight,
 type = "o", layout=c(4, 1))


###################################################
### code chunk number 64: usinglsmeans.rnw:672674
###################################################
Chick.lmer < lmer(sqrt(weight) ~ Diet * Time + (0 + Time  Chick),
 data = ChickWeight)


###################################################
### code chunk number 65: usinglsmeans.rnw:677678
###################################################
Chick.lst < lstrends (Chick.lmer, ~ Diet, var = "Time")


###################################################
### code chunk number 66: usinglsmeans.rnw:681682
###################################################
cld (Chick.lst)


###################################################
### code chunk number 67: usinglsmeans.rnw:687689
###################################################
lstrends(Chick.lmer, ~ Diet  Time, var = "Time",
 transform = "response", at = list(Time = c(5, 15)))


###################################################
### code chunk number 68: usinglsmeans.rnw:701704
###################################################
lsm.options(ref.grid = list(level = .90),
 lsmeans = list(),
 contrast = list(infer = c(TRUE, TRUE)))


###################################################
### code chunk number 69: usinglsmeans.rnw:709710
###################################################
get.lsm.option("estble.tol")


###################################################
### code chunk number 70: usinglsmeans.rnw:727728
###################################################
lsmeans(Oats.lmer2, pairwise ~ Variety)


###################################################
### code chunk number 71: usinglsmeans.rnw:732733
###################################################
lsm.options(ref.grid = NULL, contrast = NULL)


###################################################
### code chunk number 72: usinglsmeans.rnw:743746
###################################################
nutr.lm < lm(gain ~ (age + group + race)^2, data = nutrition)
library("car")
Anova(nutr.lm)


###################################################
### code chunk number 73: nutrintplot
###################################################
lsmip(nutr.lm, race ~ age  group)
lsmeans(nutr.lm, ~ group*race)


###################################################
### code chunk number 74: usinglsmeans.rnw:763765
###################################################
nutr.lsm < lsmeans(nutr.lm, ~ group * race, weights = "proportional",
 at = list(age = c("2","3"), race = c("Black","White")))


###################################################
### code chunk number 75: usinglsmeans.rnw:768771
###################################################
nutr.lsm
summary(pairs(nutr.lsm, by = "race"), by = NULL)
summary(pairs(nutr.lsm, by = "group"), by = NULL)


###################################################
### code chunk number 76: usinglsmeans.rnw:784788
###################################################
lsmeans(nutr.lm, "race", weights = "equal")
lsmeans(nutr.lm, "race", weights = "prop")
lsmeans(nutr.lm, "race", weights = "outer")
lsmeans(nutr.lm, "race", weights = "cells")


###################################################
### code chunk number 77: usinglsmeans.rnw:797799
###################################################
temp = lsmeans(nutr.lm, c("group","race"), weights = "prop")
lsmeans(temp, "race", weights = "prop")


###################################################
### code chunk number 78: usinglsmeans.rnw:804805
###################################################
with(nutrition, tapply(gain, race, mean))


###################################################
### code chunk number 79: usinglsmeans.rnw:816823
###################################################
cows = data.frame (
 route = factor(rep(c("injection", "oral"), c(5, 9))),
 drug = factor(rep(c("Bovineumab", "Charloisazepam",
 "Angustatin", "Herefordmycin", "Mollycoddle"), c(3,2, 4,2,3))),
 resp = c(34, 35, 34, 44, 43, 36, 33, 36, 32, 26, 25, 25, 24, 24)
)
cows.lm < lm(resp ~ route + drug, data = cows)


###################################################
### code chunk number 80: usinglsmeans.rnw:826827
###################################################
( cows.rg < ref.grid(cows.lm) )


###################################################
### code chunk number 81: usinglsmeans.rnw:831832
###################################################
( route.lsm < lsmeans(cows.rg, "route") )


###################################################
### code chunk number 82: usinglsmeans.rnw:835836
###################################################
( drug.lsm < lsmeans(cows.rg, "drug") )


###################################################
### code chunk number 83: usinglsmeans.rnw:839841
###################################################
pairs(route.lsm, reverse = TRUE)
pairs(drug.lsm, by = "route", reverse = TRUE)


###################################################
### code chunk number 84: usinglsmeans.rnw:846848 (eval = FALSE)
###################################################
## lsmeans(city.model, "county",
## nesting = list(county = "state", city = c("county", "state")))


###################################################
### code chunk number 85: usinglsmeans.rnw:857861
###################################################
library("mediation")
levels(framing$educ) = c("NA","Ref","< HS", "HS", "> HS","Coll +")
framing.glm = glm(cong_mesg ~ age + income + educ + emo + gender * factor(treat),
 family = binomial, data = framing)


###################################################
### code chunk number 86: framinga
###################################################
lsmip(framing.glm, treat ~ educ  gender, type = "response")


###################################################
### code chunk number 87: framingb
###################################################
lsmip(framing.glm, treat ~ educ  gender, type = "response",
 cov.reduce = emo ~ treat*gender + age + educ + income)


###################################################
### code chunk number 88: usinglsmeans.rnw:889891
###################################################
ref.grid(framing.glm,
 cov.reduce = emo ~ treat*gender + age + educ + income)@grid


###################################################
### code chunk number 89: usinglsmeans.rnw:922924 (eval = FALSE)
###################################################
## rg < ref.grid(my.model, at = list(x1 = c(5,10,15)),
## cov.reduce = list(x2 ~ x1, x3 ~ x1 + x2))


###################################################
### code chunk number 90: housingplot
###################################################
library("ordinal")
data(housing, package = "MASS")
housing.clm < clm(Sat ~ (Infl + Type + Cont)^2,
 data = housing, weights = Freq, link = "probit")
lsmip(housing.clm, Cont ~ Infl  Type, layout = c(4,1))


###################################################
### code chunk number 91: usinglsmeans.rnw:976977
###################################################
test(pairs(lsmeans(housing.clm, ~ Infl  Type)), joint = TRUE)


###################################################
### code chunk number 92: usinglsmeans.rnw:980981
###################################################
test(pairs(lsmeans(housing.clm, ~ Cont  Type)), joint = TRUE)


###################################################
### code chunk number 93: usinglsmeans.rnw:986987
###################################################
ref.grid(housing.clm, mode = "cum.prob")


###################################################
### code chunk number 94: usinglsmeans.rnw:990992
###################################################
lsmeans(housing.clm, ~ Infl, at = list(cut = "MediumHigh"),
 mode = "cum.prob")


###################################################
### code chunk number 95: usinglsmeans.rnw:995997
###################################################
summary(lsmeans(housing.clm, ~ Infl, at = list(cut = "MediumHigh"),
 mode = "linear.predictor"), type = "response")


###################################################
### code chunk number 96: usinglsmeans.rnw:10051013
###################################################
require("nlme")
options(contrasts = c("contr.treatment", "contr.poly"))
Chick.nlme = nlme(weight ~ SSlogis(Time, asym, xmid, scal),
 data = ChickWeight,
 fixed = list(asym + xmid ~ Diet, scal ~ 1),
 random = asym ~ 1  Chick,
 start = c(200, 100, 200, 100, 10, 0, 0, 0, 7))
Chick.nlme


###################################################
### code chunk number 97: usinglsmeans.rnw:10161018
###################################################
cld(lsmeans(Chick.nlme, ~ Diet, param = "asym"))
cld(lsmeans(Chick.nlme, ~ Diet, param = "xmid"))


###################################################
### code chunk number 98: usinglsmeans.rnw:10301035
###################################################
library("MCMCpack")
counts < c(18, 17, 15, 20, 10, 20, 25, 13, 12)
outcome < gl(3, 1, 9)
treatment < gl(3, 3)
posterior < MCMCpoisson(counts ~ outcome + treatment, mcmc = 1000)


###################################################
### code chunk number 99: usinglsmeans.rnw:10381039
###################################################
( post.lsm < lsmeans(posterior, "treatment") )


###################################################
### code chunk number 100: usinglsmeans.rnw:10421044
###################################################
library("coda")
summary(as.mcmc(post.lsm))


diff pruN 2.27623/inst/doc/usinglsmeans.rnw 2.3001/inst/doc/usinglsmeans.rnw
 2.27623/inst/doc/usinglsmeans.rnw 20170910 19:24:54.000000000 +0000
+++ 2.3001/inst/doc/usinglsmeans.rnw 19700101 00:00:00.000000000 +0000
@@ 1,1067 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %
% %

\documentclass[11pt]{article}
\usepackage[margin=1in]{geometry}
\usepackage{mathpazo}
\usepackage{hyperref}
\usepackage{fancyvrb}
\usepackage{multicol}
\usepackage{natbib}
\usepackage{Sweave}

\usepackage{makeidx}
\makeindex

\hypersetup{colorlinks=true,allcolors=black,urlcolor=blue}


\let\dq="
\DefineShortVerb{\"}

\def\pkg{\textbf}
\def\proglang{\textsf}

\def\lsm{\pkg{lsmeans}}

% doublequoted text
\def\dqt#1{\code{\dq{}#1\dq{}}}

% The objects I want to talk about
\def\rg{\dqt{ref.grid}}
\def\lsmo{\dqt{lsmobj}}

% for use in place of \item in a description env where packages are listed
\def\pitem#1{\item[\pkg{#1}]}


\def\R{\proglang{R}}
\def\SAS{\proglang{SAS}}
\def\code{\texttt}


\def\Fig#1{Figure~\ref{#1}}
\def\bottomfraction{.5}


% For indexing...
% Naming: \[w]ix[fmt]{#1}  always use lowercase for alphabetization.
% fmt defines format, use w prefix for intext refs (word is included)
\def\ix#1{\index{#1@\MakeUppercase#1}}
\def\wix#1{#1\ix{#1}}
\def\ixcode#1{\index{#1@\texttt{#1}}}
\def\wixcode#1{\texttt{#1}\ixcode{#1}}
\def\ixpkg#1{\index{#1@\textbf{#1} package}}
\def\wixpkg#1{\textbf{#1}\ixpkg{#1}}
% Add subheadings...
\def\ixsub#1#2{\index{#1@\MakeUppercase#1!#2}}
\def\wixsub#1#2{#1\ixsub{#1}{#2}}
\def\ixcodesub#1#2{\index{#1@\texttt{#1}!#2}}
\def\wixcodesub#1#2{\texttt{#1}\ixcodesub{#1}{#2}}

%\VignetteIndexEntry{Using lsmeans}
%\VignetteDepends{lsmeans}
%\VignetteKeywords{leastsquares means}
%\VignettePackage{lsmeans}


% Initialization
<>=
options(show.signif.stars=FALSE, prompt="R> ", continue=" ",
 useFancyQuotes=FALSE, width=100, digits=6)
@

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% almost as usual
\author{Russell V.~Lenth\\The University of Iowa}
\title{Using \lsm{}} %% without formatting

\ifx %xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
%% for pretty printing and a nice hypersummary also set:
\Plainauthor{Russell V.~Lenth} %% commaseparated
\Plaintitle{Leastsquares Means: The R Package lsmeans} %% without formatting
\Shorttitle{The R Package lsmeans} %% a short title (if necessary)
\fi %xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


\ifx % IGNORE xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
%% The address of (at least) one author should be given
%% in the following format:
\Address{
 Russell V.~Lenth, Professor Emeritus\\
 Department of Statistics and Actuarial Science\\
% 241 Schaeffer Hall\\
 The University of Iowa\\
 Iowa City, IA 52242 ~ USA\\
 Email: \email{russelllenth@uiowa.edu} %\\
% URL: \url{http://www.stat.uiowa.edu/~rlenth/}
}
%% It is also possible to add a telephone and fax number
%% before the email in the following format:
%% Telephone: +43/1/313365053
%% Fax: +43/1/31336734
\fi %xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

%% for those who use Sweave please include the following line (with % symbols):
%% need no \usepackage{Sweave.sty}

%% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


\begin{document}
\SweaveOpts{concordance=TRUE}
\maketitle{}

\begin{abstract}
 Leastsquares means are predictions from a linear model, or averages thereof. They are useful in the
 analysis of experimental data for summarizing the effects of factors, and for testing linear contrasts among predictions. The \lsm{} package provides a simple way of obtaining leastsquares means and contrasts thereof. It supports many models fitted by \R{} core packages (as well as a few key contributed ones) that fit linear or mixed models, and provides a simple way of extending it to cover more model classes.
\end{abstract}




\section{Introduction}
\wix{leastsquares means} (\wix{LS~means} for short) for a linear model are simply predictionsor averages thereofover a regular grid of predictor settings which I call the \emph{\wix{reference grid}}. They date back at least to \cite{Har60} and his associated computer program \proglang{LSML} \citep{Har77} and the contributed \SAS{} procedure named \pkg{HARVEY}\index{SAS!PROC HARVEY} \citep{Har76}. Later, they were incorporated via \code{LSMEANS}\index{SAS!LSMEANS} statements for various linear model procedures such as \pkg{GLM} in the regular \SAS{} releases. See also \cite{Goo97} and \cite{SAS12} for more information about the \SAS{} implementation.

In simple \wix{analysisofcovariance models}, LS~means are the same as covariate\wix{adjusted means}. In unbalanced factorial experiments, LS~means for each factor mimic the maineffects means but are adjusted for imbalance. The latter interpretation is quite similar to the ``\wix{unweighted means}'' method for unbalanced data, as presented in old design books.

LS~means are not always well understood, in part because the term itself is confusing. \cite{Sea80} discusses exactly how they are defined for various factorial, nested, and covariance models. \citeauthor{Sea80} suggest the term ``\wix{predicted marginal means}'' (or \wix{PMMs}) as a better descriptor. However, the term ``leastsquares means'' was already well established in the \SAS{} software, and it has stuck.

The most important things to remember are:\ixsub{leastsquares means}{defined}
\begin{itemize}
\item LS~means are computed relative to a \emph{reference grid}.
\item Once the reference grid is established, LS~means are simply predictions on this grid, or marginal averages of a table of these predictions.
\end{itemize}
A user who understands these points will know what is being computed, and thus can judge whether or not LS~means are appropriate for the analysis.




\section{The reference grid}
Since the reference grid\ixsub{reference grid}{defined} is fundamental, it is our starting point. For each predictor in the model, we define a set of one or more \emph{reference levels}. The reference grid is then the set of all combinations of reference levels. If not specified explicitly, the default reference levels are obtained as follows:
\begin{itemize}
\item For each predictor that is a factor, its reference levels are the unique levels of that factor.
\item Each numeric predictor has just one reference levelits mean over the dataset.
\end{itemize}
So the reference grid depends on both the model and the dataset.

\subsection{Example: Orange sales}\index{Examples!orange sales}
To illustrate, consider the \wixcode{oranges} data provided with \lsm{}. This dataset has sales of two varieties of oranges (response variables "sales1" and "sales2") at 6 stores (factor "store"), over a period of 6 days (factor "day"). The prices of the oranges (covariates "price1" and "price2") fluctuate in the different stores and the different days. There is just one observation on each store on each day.

For starters, let's consider an additive covariance model for sales of the first variety, with the two factors and both "price1" and "price2" as covariates (since the price of the other variety could also affect sales).
<<>>=
library("lsmeans")
oranges.lm1 < lm(sales1 ~ price1 + price2 + day + store, data = oranges)
anova(oranges.lm1)
@
The \wixcode{ref.grid} function in \lsm{} may be used to establish the reference grid. Here is the default one:
<<>>=
( oranges.rg1 < ref.grid(oranges.lm1) )
@
As outlined above, the two covariates "price1" and "price2" have their means as their sole reference level; and the two factors have their levels as reference levels. The reference grid thus consists of the $1\times1\times6\times6=36$ combinations of these reference levels. LS~means are based on predictions on this reference grid, which we can obtain using "predict" or "summary":
<<>>=
summary(oranges.rg1)
@

\subsection{LS means as \wix{marginal averages} over the reference grid}
The ANOVA indicates there is a significant "day" effect after adjusting for the covariates, so we might want to do a followup analysis that involves comparing the days. The \wixcode{lsmeans} function provides a starting point:
<<>>=
lsmeans(oranges.rg1, "day") ## or lsmeans(oranges.lm1, "day")
@
These results, as indicated in the annotation in the output, are in fact the averages of the predictions shown earlier, for each day, over the 6 stores. The above LS~means (often called ``\wix{adjusted means}'') are not the same as the overall means for each day:
<<>>=
with(oranges, tapply(sales1, day, mean))
@
These \wix{unadjusted means} are not comparable with one another because they are affected by the differing "price1" and "price2" values on each day, whereas the LS~means are comparable because they use predictions at uniform "price1" and "price2" values.

Note that one may call "lsmeans" with either the reference grid or the model. If the model is given, then the first thing it does is create the reference grid; so if the reference grid is already available, as in this example, it's more efficient to make use of it.

For users who dislike the term ``LS~means,'' there is also a \wixcode{pmmeans} function (for \wix{predicted marginal means}) which is an alias for "lsmeans" but relabels the "lsmean" column in the summary.

\subsection{Altering the reference grid}\ixsub{reference grid}{altering}
The wixcode{at} argument may be used to override defaults in the reference grid.
The user may specify this argument either in a "ref.grid" call or an "lsmeans" call; and should specify a "list" with named sets of reference levels. Here is a silly example:
<<>>=
lsmeans(oranges.lm1, "day", at = list(price1 = 50,
 price2 = c(40,60), day = c("2","3","4")) )
@
Here, we restricted the results to three of the days, and used different prices.
One possible surprise is that the predictions are averaged over the two "price2"
values. That is because "price2" is no longer a single reference level, and we average over the levels of all factors not used to splitout the LS~means.
This is probably not what we want.\footnote{%
The \emph{default} reference grid produces LS~means exactly as described in \cite{Sea80}.
However, an altered reference grid containing more than one value of a covariate, such as in this example, departs from (or generalizes, if you please) their definition by averaging with equal weights over those \wix{covariate levels}. It is not a good idea here, but there is an example later in this vignette where it makes sense.}
To get separate sets of predictions for each "price2", one must specify it as another factor or as a \wixcode{by} factor in the "lsmeans" call (we will save the result for later discussion):
<<>>=
org.lsm < lsmeans(oranges.lm1, "day", by = "price2",
 at = list(price1 = 50, price2 = c(40,60), day = c("2","3","4")) )
org.lsm
@
Note: We could have obtained the same results using any of these:
<>=
lsmeans(oranges.lm1, ~ day  price, at = ... ) # Ex 1
lsmeans(oranges.lm1, c("day","price2"), at = ... ) # Ex 2
lsmeans(oranges.lm1, ~ day * price, at = ... ) # Ex 3
@
Ex~1 illustrates the formula method for \wix{specifying factors}\ixsub{factors}{specifying}, which is more compact. The "" character replaces the "by" specification. Ex~2 and Ex~3 produce the same results, but their results are displayed as one table (with columns for "day" and "price") rather than as two separate tables.\ixsub{formula specs}{onesided}




\section{Working with the results}\index{ref.grid@\dqt{ref.grid} class}
\subsection{Objects}
The "ref.grid" function produces an object of class \rg{}, and the "lsmeans" function produces an object of class \lsmo{},\index{lsmobj@\dqt{lsmobj} class} which is a subclass of \rg. There is really no practical difference between these two classes except for their "show" methodswhat is displayed by defaultand the fact that an \lsmo{} is not (necessarily) a true reference grid as defined earlier in this article. Let's use the \wixcode{str} function to examine the \lsmo{} object just produced:
<<>>=
str(org.lsm)
@
We no longer see the reference levels for all predictors in the modelonly the levels of "day" and "price2". These \emph{act} like reference levels, but they do not define the reference grid upon which the predictions are based.

\subsection{Summaries}
There are several methods for \rg{} (and hence also for \lsmo{}) objects. One already seen is \wixcode{summary}. It has a number of argumentssee its help page. In the following call, we summarize "days.lsm" differently than before. We will also save the object produced by "summary" for further discussion.
<<>>=
( org.sum < summary(org.lsm, infer = c(TRUE,TRUE),
 level = .90, adjust = "bon", by = "day") )
@
The \wixcode{infer} argument causes both \wix{confidence intervals} and \wix{tests} to be produced; the default confidence level of $.95$ was overridden; a Bonferroni adjustment\ixcode{adjust}\ixcode{level}\ix{multiplicity adjustment}\ixsub{multiplicity adjustment}{Bonferroni} was applied to both the intervals and the $P$~values; and the tables are organized the opposite way from what we saw before.

What kind of object was produced by "summary"? Let's see:
<<>>=
class(org.sum)
@
The \dqt{\wixcode{summary.ref.grid}} class is an extension of \dqt{data.frame}. It includes some attributes that, among other things, cause additional messages to appear when the object is displayed. But it can also be used as a \dqt{data.frame} if the user just wants to use the results computationally. For example, suppose we want to convert the LS~means from dollars to Russian rubles (at the July 13, 2014 exchange rate):
{\small
<<>>=
transform(org.sum, lsrubles = lsmean * 34.2)
@
}
Observe also that the summary is just one data frame with six rows, rather than a collection of three data frames; and it contains a column for all reference variables, including any "by" variables.

Besides "str" and "summary", there is also a \wixcode{confint} method, which is the same as "summary" with "infer=c(TRUE,FALSE)", and a \wixcode{test} method (same as "summary" with "infer=c(FALSE,TRUE)", by default). The "test" method may in addition be called with "joint=TRUE"\ixsub{tests}{joint} to obtain a joint test that all or some of the linear functions are equal to zero or some other value.

There is also an \wixcode{update} method which may be used for changing the object's display settings. For example:
<<>>=
org.lsm2 < update(org.lsm, by.vars = NULL, level = .99)
org.lsm2
@

\subsection{Plots}\ix{plots}\ix{graphical displays}
Confidence intervals for LS~means may be displayed graphically, using the \wixcode{plot} method. For example:
<>=
plot(org.lsm, by = "price2")
@
The resulting display is shown in \Fig{orgplot}. This function requires that the \wixpkg{lattice} package be installed.
\begin{figure}
\begin{center}
\includegraphics{usinglsmeansorgplot.pdf}
\end{center}
\caption{Confidence intervals for LS~means in the \code{oranges} example.}\label{orgplot}
\end{figure}
Additional graphical presentations are covered later in this vignette.



\section{Contrasts and comparisons}
\subsection{Contrasts in general}\ix{contrasts}
Often, people want to do pairwise comparisons of LS~means, or compute other contrasts among them. This is the purpose of the \wixcode{contrast} function, which uses a \dqt{ref.grid} or \dqt{lsmobj} object as input. There are several standard contrast families such as \dqt{pairwise}, \dqt{trt.vs.ctrl}, and \dqt{\wixcode{poly}}.\ixsub{contrasts}{polynomial}\ixsub{contrasts}{effects (offsets from mean)}
In the following command, we request \dqt{\wixcode{eff}} contrasts, which are differences between each mean and the overall mean:
<<>>=
contrast(org.lsm, method = "eff")
@
Note that this preserves the "by" specification from before, and obtains the effects for each group. In this example, since it is an \wix{additive model}, we obtain exactly the same results in each group. This isn't wrong, it's just redundant.\index{Redundant results}

Another popular method is Dunnettstyle \wixsub{contrasts}{Dunnett}, where a particular LS~mean is compared with each of the others. This is done using \dqt{\wixcode{trt.vs.ctrl}}. In the following, we obtain (again) the LS~means for days, and compare each with the average of the LS~means on day~5 and~6.
<<>>=
days.lsm < lsmeans(oranges.rg1, "day")
( days_contr.lsm < contrast(days.lsm, "trt.vs.ctrl", ref = c(5,6)) )
@
For convenience, \dqt{\wixcode{trt.vs.ctrl1}} and \dqt{\wixcode{trt.vs.ctrlk}} methods are provided for use in lieu of "ref" for comparing with the first and the last LS~means. The \dqt{\wixcode{dunnettx}} adjustment is a good approximation to the exact Dunnett $P$~value adjustment. If the exact adjustment is desired, use \wixcode{adjust}" = "\dqt{\wixcode{mvt}}; but this can take a lot of computing time when there are several tests.

Note that by default, "lsmeans" results are displayed with confidence intervals while "contrast" results are displayed with $t$ tests. One can easily override this; for example,
<>=
confint(contrast(days.lsm, "trt.vs.ctrlk"))
@
(Results not shown.)

In the above examples, a default \wixsub{multiplicity adjustment}{default} is determined from the contrast method. This may be overridden by adding an \wixcode{adjust} argument.

\subsection{Pairwise comparisons}\ixsub{contrasts}{pairwise comparisons}
Often, users want \wix{pairwise comparisons} among the LS~means. These may be obtained by specifying \dqt{\wixcode{pairwise}} or \dqt{\wixcode{revpairwise}} as the "method" argument in the call to \wixcodesub{contrast}{method@\code{method}}. For group labels $A,B,C$, \dqt{pairwise} generates the comparisons $AB, AC, BC$ while \dqt{revpairwise} generates $BA, CA, CB$. As a convenience, a \wixcode{pairs} method is provided that calls "contrast" with "method="\dqt{pairwise}:\ixsub{pairwise comparisons}{using \code{pairs}}
<<>>=
pairs(org.lsm)
@
There is also a \wixcode{cld} (\wix{compact letter display}) method that lists the LS~means along with grouping symbols for pairwise contrasts. It requires the \wixpkg{multcompView} package \citep{mcview} to be installed.
<<>>=
cld(days.lsm, alpha = .10)
@
Two LS~means that share one or more of the same grouping symbols are not significantly different at the stated value of "alpha", after applying the multiplicity adjustment (in this case Tukey's HSD).
By default, the LS~means are ordered in this display, but this may be overridden with the argument "sort=FALSE". "cld" returns a \dqt{summary.ref.grid} object, not an "lsmobj".

Another way to display pairwise comparisons is via the "comparisons" argument of \wixcode{plot}.
\ixcodesub{plot}{\code{comparisons}}\ixsub{pairwise comparisons}{graphical}
When this is set to "TRUE", arrows are added to the plot, with lengths set so that the amount by which they overlap (or don't overlap) matches as closely as possible to the amounts by which corresponding confidence intervals for differences cover (or don't cover) the value zero.
\ix{comparison arrows}
This does not always work, and if there are discrepancies, a message is printed. But it usually works as long as the standard errors of differences are not too discrepant.
<>=
plot(days.lsm, comparisons = TRUE, alpha = .10)
@
\Fig{dayscmp} shows the result. Note that the pairs of means having overlapping arrows are the same as those grouped together in the "cld" display. However, these comparison arrows show more about the degree of significance in the comparisons. The lowest and highest LS~mean have arrows pointing only inward, as the others are not needed. If the confidence intervals and arrows together look too cluttered, one can add the argument \code{intervals = FALSE}, then only the arrows will be displayed.\ixcodesub{plot}{intervals@\code{intervals}}
\begin{figure}
\begin{center}
\includegraphics{usinglsmeansdayscmp.pdf}
\end{center}
\caption{Graphical comparisons of the LS~means for \code{days}.}\label{dayscmp}
\end{figure}

\subsection{Multiplicity adjustmentschanging the family}\ixsub{multiplicity adjustment}{combining/subsetting families}
You may have noticed that in the preceding examples where $P$value adjustments were implemented, those adjustments were made \emph{separately} for each subtable when a "by" variable is active. Some users prefer that all the adjusted tests together as one familyor even combine more than one family of tests into one family for purposes of adjustment. This may be done using the \wixcode{rbind} method (similar to using "rbind" to combine matrices.

On the flip side, perhaps we want to exclude some tests. This may be used using the \ixcode{[]} operator: simply specify the row indexes of the tests to include.

To illustrate, consider the previously obtained "org.lsm" object. In "pairs(org.lsm)", we obtain the same results twice (as seen above) because the model is additive. For the same reason, if we change the "by" variable to \dqt{day}, we'll obtain three copies of the same comparison of the two "price2"s. If we want to consider the three "day" comparisons and the one "price2" comparison together as one family of four tests, we can do:
<<>>=
rbind(pairs(org.lsm)[1:3], pairs(org.lsm, by = "day")[1])
@
Note that by default, the \dqt{mvt} adjustment level is used; for complicated families like this, ordinary Tukey and Dunnett adjustments are usually not appropriate.

We arrived at this point by a circuitous path. In the additive model, the above conditional results are the same as the marginal ones:
<<>>=
rbind(pairs(lsmeans(org.lsm, "day")), pairs(lsmeans(org.lsm, "price2")))
@


\section{Multivariate models}
The "oranges" data has two response variables. Let's try a \wix{multivariate model} for predicting the sales of the two varieties of oranges, and see what we get if we call "ref.grid":
<<>>=
oranges.mlm < lm(cbind(sales1,sales2) ~ price1 + price2 + day + store,
 data = oranges)
ref.grid(oranges.mlm)
@
What happens is that the multivariate response is treated like an additional factor, by default named \wixcode{rep.meas}. In turn, it can be used to specify levels for LS~means. Here we rename the multivariate response to \dqt{variety} and obtain "day" means (and a compact letter display for comparisons thereof) for each "variety":\ixcode{mult.name}
<<>>=
org.mlsm < lsmeans(oranges.mlm, ~ day  variety, mult.name = "variety")
cld(org.mlsm, sort = FALSE)
@




\section{Contrasts of contrasts (interaction contrasts)}
With the preceding model, we might want to compare the two varieties on each day:
<<>>=
org.vardiff < update(pairs(org.mlsm, by = "day"), by = NULL)
@
The results (not yet shown) will comprise the six "sales1sales2" differences, one for each day. The two "by" specifications seems odd, but the one in "pairs" specifies doing a separate comparison for each day, and the one in "update" asks that we convert it to one table with six rows, rather than 6 tables with one row each. Now, let's compare these differences to see if they vary from day to day.
<<>>=
cld(org.vardiff)
@
There is little evidence of variety differences, nor that these differences vary from day to day.

A newer feature of the \wixcodesub{contrast}{\code{interaction}} function is the optional "interaction" argument, which may be used to specify \wix{interaction contrasts}\ixsub{contrasts}{interaction}\ixsub{contrasts}{of contrasts}
by naming which contrast to use for each variable (in the order of appearance in the grid). In a similar example to the above, suppose we want to compare each polynomial contrast in "day" between the two varieties:\ixsub{contrasts}{polynomial}
<<>>=
org.icon < contrast(org.mlsm, interaction = c("poly", "pairwise"))
org.icon
@

Exactly what contrasts are being generated can become somewhat confusing, especially where interaction contrasts are concerned. The \wixcode{coef} method\ixsub{contrasts}{retrieving coefficients} helps with this; it returns a "data.frame" with the grid of factor levels that were contrasted, along with the contrast coefficients that were used:
<<>>=
coef(org.icon)
@
We can see more clearly that each contrast is the difference of a polynomial contrast on the first six rows of "org.mlsm", minus that same contrast of the last six rows. (Note: "coef" is only useful for objects generated by "contrast" or "pairs"; if called on some other "ref.grid" object, it simply returns "NULL".)

\section[Interfacing with multcomp]{Interfacing with \pkg{multcomp}}
The \wixpkg{multcomp} package \citep{multc} supports more options for simultaneous inference than are available in \lsm{}. Its \wixcode{glht} (general linear hypothesis testing) function and associated \dqt{glht} class are similar in some ways to "lsmeans" and \dqt{lsmobj} objects, respectively. So \lsm{} provides an \wixcode{as.glht} function to do the conversion.

To illustrate, let us convert the "days_contr.lsm" object (produced earlier) to a "glht" object, and use it to obtain adjusted $P$~values under \wix{Westfall's adjustment procedure} (not available in \lsm{}):
<>=
# Ensure we see the same results each time
set.seed(123454321)
@
<<>>=
library("multcomp")
days.glht < as.glht(days_contr.lsm)
summary(days.glht, test = adjusted("Westfall"))
@
In addition, \lsm{} provides an \wixcode{lsm} function (or its alias, \wixcode{pmm}) that may be called from within a call to "glht". Thus, another way to obtain the same "glht" object is to use
<>=
days.glht1 < glht(oranges.lm1,
 lsm("day", contr = "trt.vs.ctrl", ref = c(5,6)))
@

By the way, the following two statements will produce the same results:
<>=
summary(days_contr.lsm, adjust = "mvt")
summary(days.glht)
@
That is, the \dqt{mvt} adjust method in \lsm{} is the same as the default singlestep $P$~value adjustment in \pkg{multcomp}.\ixsub{multiplicity adjustment}{singlestep (\code{mvt})}


One additional detail: If there is a "by" variable in effect, "glht" or "as.glht" returns a "list" of "glht" objectsone for each "by" level. There are courtesy "coef", "confint", "plot", "summary", and "vcov" methods for this \dqt{\wixcode{glht.list}} class to make things a bit more userfriendly. Recall the earlier example result "org.lsm", which contains information for LS~means for three "day"s at each of two values of "price2". Suppose we are interested in pairwise comparisons of these LS~means, by "price2". If we call
<>=
summary(as.glht(pairs(org.lsm)))
@
(results not displayed) we will obtain two "glht" objects with three contrasts each, so that the results shown will incorporate multiplicity adjustments for each family of three contrasts. If, on the other hand, we want to consider those six contrasts as one family, use
<>=
summary(as.glht(pairs(org.lsm), by = NULL))
@
\ldots{} and note (look carefully at the parentheses) that this is \emph{not} the same as
<>=
summary(as.glht(pairs(org.lsm, by = NULL)))
@
which removes the "by" grouping \emph{before} the pairwise comparisons are generated, thus yielding ${6 \choose 2}=15$ contrasts instead of just six.\ixsub{multiplicity adjustment}{effect of \code{by} on family}




\section{A new example: Oat yields}\index{Examples!oat yields}\index{Examples!splitplot experiment}
Orangesales illustrations are probably getting tiresome. To illustrate some new features, let's turn to a new example.
The \wixcode{Oats} dataset in the \wixpkg{nlme} package \citep{nlme} has the results of a splitplot experiment discussed in \citet{Yat35}. The experiment was conducted on six blocks (factor "Block"). Each block was divided into three plots, which were randomized to three varieties (factor "Variety") of oats. Each plot was divided into subplots and randomized to four levels of nitrogen (variable "nitro"). The response, "yield", was measured once on each subplot after a suitable growing period.

We will fit a model using the "lmer" function in the \wixpkg{lme4} package \citep{lme4}. This will be a mixed model with random intercepts for "Block" and "Block:Variety" (which identifies the plots). A logarithmic transformation is applied to the response variable (mostly for illustration purposes, though it does produce a good fit to the data). Note that "nitro" is stored as a numeric variable, but we want to consider it as a factor in this initial model.
<<>>=
data("Oats", package = "nlme")
library("lme4")
Oats.lmer < lmer(log(yield) ~ Variety*factor(nitro) + (1Block/Variety),
 data = Oats)
anova(Oats.lmer)
@
Apparently, the interaction is not needed. But perhaps we can further simplify the model by using only a linear or quadratic trend in "nitro". We can find out by looking at polynomial contrasts:\ixsub{contrasts}{polynomial}
<>=
contrast(lsmeans(Oats.lmer, "nitro"), "poly")
@
%%% Fake the warning message
<>=
cat("NOTE: Results may be misleading due to involvement in interactions")
@
<>=
<>
@
\ixsub{warnings}{when interaction is in model}
(A message is issued when we average over predictors that interact with those that delineate the LS~means. In this case, it is not a serious problem because the interaction is weak.) Both the linear and quadratic contrasts are pretty significant. All this suggests fitting an additive model where "nitro" is included as a numeric predictor with a quadratic trend.
<<>>=
Oats.lmer2 < lmer(log(yield) ~ Variety + poly(nitro,2)
 + (1Block/Variety), data = Oats)
@
Remember that "nitro" is now used as a quantitative predictor.\ixsub{factors}{with quantitative levels}
But for comparing with the previous model, we want to see predictions at the four unique "nitro" values rather than at the average of "nitro". This may be done using "at" as illustrated earlier, or a shortcut is to specify \wixcode{cov.reduce} as "FALSE", which tells "ref.grid" to use all the unique values of numeric predictors.
<<>>=
Oats.lsm2 < lsmeans(Oats.lmer2, ~ nitro  Variety, cov.reduce = FALSE)
@
The results are displayed as an export table (see Section~\ref{xtsect}) in Table~\ref{xtable:example}, page~\pageref{xtable:example}.
These LS~means follow the same quadratic trend for each variety, but with different intercepts.\footnote{%
This is the promised example where our generalization of \cite{Sea80}'s definition of LS~means makes sense. Suppose we want to compare the LS~means for \code{Variety} with those in the original model \code{Oats.lmer} where \code{nitro} was a factor, we want to average equally over the four \code{nitro} levels, even though \code{nitro} is a covariate in this second model.}\ixsub{reference grid}{altered for quantitative factor}

Fractional \wixsub{degrees of freedom}{fractional} are displayed in these results. These are obtained by default using the Satterthwaite method, using routines in the \wixpkg{lmerTest} package \citep{lmert}. Adding the argument \code{mode = \dqt{kenwardroger}} to the \code{lsmeans} call will cause the degrees of freedom to be computed using instead the KenwardRoger (KR) method from the \wixpkg{pbkrtest} package \citep{pbkrt}, which also implements, as a sideeffect, a bias adjustment in the estimated covariances (and hence standard errors). The KR method is probably preferable, but it requires a lot more computation, and hence is no longer the default. A third option is to specify \code{mode = \dqt{asymptotic}}, for which all the degrees of freedom are set to \code{NA}producing $z$~tests rather than $t$~tests. You may change the default via \code{lsm.options(lmer.df = \emph{\dqt{desired default}})}. These \code{mode} settings are partially matched, so \code{mode = \dqt{k}} is actually good enough.


\section{Additional display methods}
\subsection{Export tables}\ix{export tables}\label{xtsect}
The \pkg{lsmeans} package provides an \wixcode{xtable} method \citep{xtable} that works with "lsmobj", "ref.grid", and "summary.ref.grid" objects. (It actually uses the \wixcode{xtableList} interface; see the \ixpkg{xtable} documentation for details.) This is quite useful if you want a nicely formatted table, especially using \wixcode{Sweave} or \wixcode{knitr}. To illustrate, we display the "Oats.lsm2" object just created.
<>=
library("xtable")
xtbl < xtable(Oats.lsm2, caption = "Example using \\texttt{xtable}",
 label = "xtable:example")
print(xtbl, table.placement = "t")
cat("See Table~\\ref{xtable:example}.\n")
@


\subsection{Displaying LS means graphically}\ixsub{graphical displays}{interaction plot}
We have already seen the use of the "plot" function to display confidence intervals and/or comparison arrows.
The \lsm{} package also includes a function \wixcode{lsmip} that displays predictions in an interactionplotlike manner.\ix{interaction plot} It uses a formula of the form
\begin{Sinput}
curve.factors ~ x.factors  by.factors
\end{Sinput}
This function also requires the \wixpkg{lattice} package.
In the above formula, "curve.factors" specifies factor(s) used to delineate one displayed curve from another (i.e., groups in \pkg{lattice}'s parlance). "x.factors" are those whose levels are plotted on the horizontal axis. And "by.factors", if present, break the plots into panels.

To illustrate, consider the first model we fitted to the "Oats" data. Let's do a graphical comparison of the two models we have fitted to the "Oats" data.
<>=
lsmip(Oats.lmer, Variety ~ nitro, ylab = "Observed log(yield)")
@
\vspace{12pt}
<>=
lsmip(Oats.lsm2, Variety ~ nitro, ylab = "Predicted log(yield)")
@
The plots are shown in \Fig{intplots}.
Note that the first model fits the cell means perfectly, so its plot is truly an interaction plot of the data. The other displays the parabolic trends we fitted in the revised model.
\begin{figure}
\includegraphics[width=3in]{usinglsmeansoatslmer.pdf}
\hfill
\includegraphics[width=3in]{usinglsmeansoatslmer2.pdf}
\caption{Interaction plots for the cell means and the fitted model, \code{Oats} example.}\label{intplots}
\end{figure}




\section{Transformations}\ix{transformations}
\subsection{Automatic support for transformations}\ixsub{transformations}{automatically detected}
When a transformation or link function is used in fitting a model, "ref.grid" (also called by "lsmeans") stores that information in the returned object, as seen in this example:
<<>>=
str(Oats.lsm2)
@
This allows us to conveniently unravel the transformation, via the \wixcode{type} argument in "summary" or related functions such as "lsmip" and "predict".\ixcodesub{summary}{type@\code{type = }\dqt{response}} Here are the predicted yields for (as opposed to predicted log yields) for the polynomial model:
<<>>=
summary(Oats.lsm2, type = "response")
@
It is important to realize that the statistical inferences are all done \emph{before} reversing the transformation. Thus, $t$ ratios are based on the linear predictors and will differ from those computed using the printed estimates and standard errors. Likewise, \wixsub{confidence intervals}{backtransformed} are computed on the linearpredictor scale, then the endpoints are backtransformed.

This kind of automatic support is available for most popular response transformations such as "log", "log10", and even transformations like "asin(sqrt())" and "sqrt(y)+sqrt(y+1)". The Details section for \verbhelp("make.tran") provides a complete list. It is also possible to support custom transformations via the "tran" argument in the "update" methodsee its help page.
\ixsub{transformations}{custom}

\subsection{Using \code{make.tran}}\ixsub{transformations}{using \code{make.tran}}\ixsub{transformations}{requiring parameter(s)}\ixsub{transformations}{BoxCox}
The \wixcode{make.tran} function provides support for yet more popular types of transformations, particularly those that require specifying one or more parameters. Examples are general power transformations, \wix{BoxCox transformations}, and transformations with a shifted origin such as "log(y + a)". Details may of course be found via \verbhelp("make.tran"). The function returns a "list" of functions, compatible with what is returned by "make.link" in the \pkg{stats} package. The latter is intended primarily for use with generalized linear models, and "make.tran" extends such capabilities to other response transformations.

There are two basic ways to use "make.tran": retrospectively on an existing model, and prospectively in fitting a new model. Here is an example of retrospective use, where the $\log(y+5)$ transformation was used. This transformation is not autodetected.
<<>>=
Oats.log1 < lmer(log(yield + 5) ~ Variety + factor(nitro)
 + (1Block/Variety), data = Oats)
( Oats.rg1 < update(ref.grid(Oats.log1),
 tran = make.tran("genlog", 5)) )
@
Here, we created a reference grid for the model, then updated it with its "tran" component set to the result of "make.tran" for a generalized log transformation with parameter 5.
\ixcodesub{update}{tran@\code{tran}}
This updated reference grid has all the information needed to backtransform the results to the original "yield" scale:
<<>>=
round(predict(Oats.rg1, type = "response"), 1)
@

\ixcodesub{tran}{using \code{linkfun}}\ixcodesub{make.tran}{as enclosing environment}
Using "make.tran" prospectively makes use of the fact that the transformation itself is included in the returned list as a function named "linkfun" (somewhat oddly named due to the fact that "make.tran" mimics the functionality of "make.link"). When a model is fitted with "linkfun" as the transformation, its \wix{enclosing environment} is automatically used to obtain the transformation definitions. For illustration, consider a rather farfetched transformation:
<<>>=
my.tran < make.tran("boxcox", c(.567, 10))
my.tran$linkfun(10:15)
@
This specifies a BoxCox transformation with the origin shifted to $10$:%
\footnote{To obtain an ordinary BoxCox transformation, provide just one parameter: \code{make.tran(\dqt{boxcox}, .567)}.}
\[
 h(y) = \frac{(y10)^{.567}  1}{1  .567}
\]
If we use "my.tran" as an enclosing environment for fitting the model, the transformation is saved automatically:
<<>>=
Oats.bc < with(my.tran, lmer(linkfun(yield) ~ Variety + factor(nitro)
 + (1Block/Variety), data = Oats))
( rg.bc < ref.grid(Oats.bc) )
round(predict(rg.bc, type = "response"), 1)
@

\subsection{Using \code{regrid}}\ixsub{reference grid}{regridding to response scale}
The \wixcode{regrid} function may be used to, in essence, give a new beginning to an existing reference grid (or "lsmobj"), most redefined on the response scale (i.e., backtransformed). Consider the preceding BoxCox example, after applying "regrid":
<<>>=
rg.bc.regrid < regrid(rg.bc)
@
By default, the estimates are backtransformed to the response scale. In a "regrid" result, the "linfct" slot (linear functions) become the identity matrix, and the "bhat" slot (regression coefficients) become the predictions at each grid point:
<<>>=
round(rg.bc.regrid@bhat, 1)
@
which matches the predictions shown previously.

The interesting thing is what happens if we subsequently obtain LS~means. Compare these results:
<<>>=
summary(lsmeans(rg.bc, "Variety"), type = "response")
lsmeans(rg.bc.regrid, "Variety")
@
\ixcodesub{regrid}{effect on LS~means}
Why are the answers somewhat different? Recall that LS~means are obtained via equallyweighted averages of predictions. In the first "lsmeans" call, the predictions, on the BoxCox scale, are averaged together and then backtransformed to the response scale; whereas in the second "lsmeans" call, the predictions being averaged were already on the response scale. (Hence, the results are the usual arithmetic means of the predictions on the grid.) Since the BoxCox transformation is nonlinear, averaging then backtransforming is not the same as backtransforming then averaging.\ixsub{mean}{arithmetic}

Even the degrees of freedom (d.f.) differ in the two results, because degreesoffreedom calculations take place on the linearpredictor scale. Once results are backtransformed, "regrid" ``freezes'' the calculated \wixsub{degrees of freedom}{containment method} for each prediction. Subsequently, a containment method is used whereby the returned d.f.\ is the minimum d.f.\ of predictions involved in each LS~mean.

Some users prefer averaging the predictions on the response scale as they are then the arithmentic means; and now you see that the way to make that happen is through the "regrid" function.

\subsection{Reverseengineering a log transformation}\ixsub{reference grid}{regridding to log scale}
When a response has been logtransformed, then there are useful special properties of backtransformed summaries:
\begin{itemize}
\item LS~means, when backtransformed to the response scale, are actually the \emph{geometric} means of the responsescale predictions.\ixsub{mean}{geometric}
\item A difference of two LS~means on the log scale, after backtransforming, becomes an estimate of the \emph{ratio} of the two geometric means. Such comparisons via ratios can be quite useful for positive responses.\ixsub{pairwise comparisons}{by ratios instead of differences}
\end{itemize}

The \wixcodesub{regrid}{log@\dqt{log} option} function provides a \dqt{log} option that recomputes the reference grid \emph{as if} the response transformation had been the natural logarithm. We can then take advantage of the above special properties of logtransformed responses. The only proviso is that, on the response scale, all of the referencegrid predictions must be positive.

To illustrate, we revisit the above BoxCox model once again, and regrid it on the log scale:
<<>>=
rg.log < regrid(rg.bc, "log")
lsm.log < lsmeans(rg.log, "Variety")
summary(lsm.log, type = "response")
summary(pairs(lsm.log), type = "response")
@
The LS~means shown are the geometric means of the predictions, as opposed to the arithmetic means obtained above from "rg.bc.regrid". And the pairwise comparisons come out as ratios of these.

\subsection{The \code{transform} argument}\ixcodesub{transform}{in \code{ref.grid} or \code{lsmeans}}
For convenience, the user may use a "transform" argument to regrid as part of a "ref.grid" or "lsmeans" call. For example, \verblsmeans(Oats.bc, "Variety", transform = "response") is equivalent to \verblsmeans(rg.bc.regrid, "Variety") but without needing the two code steps previously used to produce "rg.bc" and "rg.bc.regrid".


\subsection{Duplex transformations}\ix{duplex transformations}\ix{two transformations}\ixsub{transformations}{duplex}\ixsub{transformations}{two in same model}
It is possible to have both a response transformation and a link function in a generalized linear model. For example,
<<>>=
warp.glm < glm(sqrt(breaks) ~ wool * tension, family = gaussian(link = "log"),
 data = warpbreaks)
@
In such a case, both the link function and response transformation are autodetected, as can be seen here:
<<>>=
warp.rg < ref.grid(warp.glm)
warp.rg
@
Using predictions, summaries, or tests of type \dqt{response} will undo both transformations, so that in the above example, the results would be on the original scale (number of warp breaks). Some users may want to backtransform only halfwayundoing the link function but not the response transformation. For that purpose, prediction type of \dqt{mu} (or equivalently, \dqt{unlink}) is supported. In this example, here are predictions on three different scales:
<<>>=
predict(warp.rg, type = "linear") ### log(sqrt) scale  no backtransformation
predict(warp.rg, type = "unlink") ### sqrt scale
predict(warp.rg, type = "response") ### response scale
@


\section{More on tests}
\def\tj{\theta^{(j)}}%%% Notation for this section only
The default settings for "test" yield traditional twotailed $t$ (or $z$) tests of significance against zero. So if $\tj$ is the $j$th parameter (e.g., LS~mean or contrast) being estimated, we are testing the null hypothesis $H_0: \tj=0$ versus the alternative $H_1:\tj\ne 0$. We can, however, specify different types of tests in the \wixcode{test} or \wixcode{summary} functions.

\subsection{Nonzero null values}\ixsub{tests}{nonzero null}
If we wish to use nonzero null values, i,e., test $H_0:\tj=\tj_0$, use "test" or "summary" with the \wixcode{null} argument set to the desired $\tj_0$ values. For example, in the Oatyield example, suppose we want to test each of the "Variety" yields against 100 (actually $\log 100$ since the response was transformed):
<<>>=
Oats.Vlsm = lsmeans(Oats.lmer2, "Variety")
test(Oats.Vlsm, null = log(100), type = "response")
@
Note that "null" should always be given on the linearpredictor scale (in this case $\log$ yield), even when specifying \verbtype="response". We could have specified different null values for each hypothesis by providing a vector of three numbers.

\subsection{Equivalence tests}\ixsub{tests}{equivalence}\ix{equivalence tests}\ix{TOST method}
The preceding results say that none of the variety means differs significantly from 100, after transforming. But this is not the same as saying that we have evidence that the means are close to 100 (that is, absence of proof is not proof of absence). To make a strong statement that an effect is small, we should use an equivalence test, which moreorless turns the hypotheses around:
\[ H_0: \tj  \tj_0 \ge \delta \qquad\mbox{versus}\qquad H_1: \tj  \tj_0 < \delta \]
where $\delta$ is a specified threshold of equivalence. A common test procedure is the two onesided test (TOST) method \citep{Sch87}, whereby we obtain equivalence only if we can establish both that $\tj\tj_0>\delta$ and that $\tj\tj_0<\delta$. In "lsmeans", we do this by preidentifying the less significant of these two tests:
\[ t = \frac{\hat\tj\tj_0  \delta}{SE(\hat\tj)} \]
and the $P$~value is the \emph{left}tail probability of this quantity from the central $t$ distribution.

In "test" or "summary", an equivalence test is requested by specifying a nonzero \wixcode{delta} argument, which in turn is used as the threshold $\delta$. In the Oatyield example, the following results are obtained using a threshold of $\delta=0.20$:\ixcodesub{test}{delta@\code{delta} argument}
<<>>=
test(Oats.Vlsm, null = log(100), delta = 0.20, type = "r")
@
So two of the three Variety means are established as being within $.20$ of $\log100$. The natural log scale has the special property that small increments on the log scale translate to approximate percentage differences of the same size. That is, a threshold of $.20$ corresponds to about a 20\% difference: $\log 80  \log100 = \log.8 \approx .223$, and $\log120  \log100 = \log1.2 \approx .182$.

\subsection{Onesided tests, noninferiority, nonsuperiority}
\ixsub{tests}{onesided}
The \wixcode{side} argument is also available to specify \wix{onesided tests}. A righttailed alternative may be requested using "side" partially matching one of \dqt{+}, \dqt{right}, \verb">", "+1", "1", \dqt{superiority}, or (see later) \dqt{noninferiority}. Similarly, a lefttailed alternative may be specified using "side" equal to \dqt{}, \dqt{left}, \verb"<", "1", \dqt{inferiority}, or \dqt{nonsuperiority}. (And for completeness, a twosided alternative is specified using "0", "2", \verb"!=", \dqt{both}, \dqt{twosided}, \dqt{equivalence}, or \dqt{=}.) In the following example, we test to see if either Golden Rain or Marvellous has better yield than Victory:
<<>>=
test(contrast(Oats.Vlsm, "trt.vs.ctrlk"), side = ">")
@
\ixsub{tests}{noninferity or nonsuperiority}
The onesided version of an equivalence test is called a noninferiority or nonsuperiority test. It is obtained by specifying both "side" and a nonzero "delta". For example, to test whether Victory is as good as the other two within a 25\% threshold, use
<<>>=
test(contrast(Oats.Vlsm, "trt.vs.ctrlk"), side = "nonsup", delta = .25)
@
We find strong evidence that, with the stated threshold of .25, Golden Rain is nonsuperior to Victory (so that Victory is noninferior to Golden Rain); but not strong evidence that Victory is noninferior to Marvellous.





\section{Trends}\ix{trends, estimating and comparing}\ix{slopes, estimating and comparing}
\index{Examples!chick weights}\index{Examples!comparing trends}
The \lsm{} package provides a function \wixcode{lstrends} for estimating and comparing the slopes of fitted lines (or curves). To illustrate, consider the builtin R dataset \wixcode{ChickWeight} which has data on the growths of newly hatched chicks under four different diets. The following code produces the display in \Fig{chickplot}.
<>=
require("lattice")
xyplot(weight ~ Time  Diet, groups = ~ Chick, data = ChickWeight,
 type = "o", layout=c(4, 1))
@
\begin{figure}
\centerline{\includegraphics[width=6in]{usinglsmeanschickplot}}
\caption{Growth curves of chicks, dataset \texttt{ChickWeight}.}\label{chickplot}
\end{figure}

Let us fit a model to these data using random slopes for each chick and allowing for a different average slope for each diet (a squareroot transformation straightensout the curves somewhat):
<<>>=
Chick.lmer < lmer(sqrt(weight) ~ Diet * Time + (0 + Time  Chick),
 data = ChickWeight)
@
We can then call \wixcode{lstrends} (or, its antiSAS alias, \wixcode{pmtrends}) to estimate and compare the average slopes for each diet.
<<>>=
Chick.lst < lstrends (Chick.lmer, ~ Diet, var = "Time")
@
Now, let's summarize the estimated trends and pairwise comparisons of these slopes using a compact letter display.
<<>>=
cld (Chick.lst)
@
According to the Tukey~HSD comparisons (with default significance level of $.05$), there are two groupings of slopes: Diet~1's mean slope is significantly less than $3$ or $4$'s, Diet~2's slope is not distinguished from any other.

Because of the response transformation, the slopes we just computed are for trends on the squarerootweight scale. If you want the trends on the actual weight scale after backtransforming, that is possible via the "transform" argument:\ixcodesub{lstrends}{with response transformation}\ixcodesub{transform}{in \code{lstrends}}
<<>>=
lstrends(Chick.lmer, ~ Diet  Time, var = "Time",
 transform = "response", at = list(Time = c(5, 15)))
@
We specified two different "Time" values to emphasize that after backtransforming, the slopes are different at each "Time", whereas (by the model specification) the slopes don't depend on "Time" when we leave it on the squareroot scale.

Note: "lstrends" computes a difference quotient based on two slightly different reference grids. Thus, if it it must be called with a model object, not a "ref.grid" object.
\ixsub{reference grid}{difference quotient of two}




\section{User preferences}\ix{user preferences}
\lsm{} sets certain defaults for displaying resultsfor example, using $.95$ for the confidence coefficient, and showing intervals for "lsmeans" output and test statistics for "contrast" results. As discussed before, one may use arguments in "summary" to change what is displayed, or "update" to change the defaults for a given object. But suppose you want different defaults to begin with. These can be set using the \wixcode{lsm.options} statement. For example:
<<>>=
lsm.options(ref.grid = list(level = .90),
 lsmeans = list(),
 contrast = list(infer = c(TRUE, TRUE)))
@
This requests that any object created by "ref.grid" be set to have confidence levels default to $90$\%, and that "contrast" results are displayed with both intervals and tests. No new options are set for "lsmeans" results, and the "lsmeans" part could have been omitted. These options are stored with objects created by "ref.grid", "lsmeans", and "contrast". For example, even though no new defaults are set for "lsmeans", future calls to "lsmeans" \emph{on a model object} will be displayed with 90\% confidence intervals, because "lsmeans" calls "ref.grid". However, calling "lsmeans" on an existing \dqt{ref.grid} object will inherit that object's setting.

Certain other options are available; for example, the \dqt{\wixcode{estble.tol}} option sets the tolerance for determining estimability of linear contrasts. To see its current value:
<<>>=
get.lsm.option("estble.tol")
@
Defaults for this and some other parameters are saved in \wixcode{defaults.lsm}.
\ixcode{get.lsm.option}


%%%%%%%%%%%%%%%%% INDEXING COMPLETED TO HERE 3516 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%



\section{Twosided formulas}\ixsub{factors}{specifying}\ixsub{formula specs}{twosided}
In its original design, the only way to obtain contrasts and comparisons in \lsm{} was to specify a twosided formula, e.g., "pairwise ~ treatment", in the "lsmeans" call. The result is then a list of "lsmobj" objects (class \dqt{lsm.list}).
\index{lsm.list@\dqt{lsm.list} class}
In its newer versions, \lsm{} offers a richer family of objects that can be reused, and dealing with a list of objects can be awkward or confusing, so its continued use is not encouraged. Nonetheless, it is still available for backward compatibility.

Here is an example where, with one command, we obtain both the LS~means and pairwise comparisons for "Variety" in the model "Oats.lmer2":
{\small
<<>>=
lsmeans(Oats.lmer2, pairwise ~ Variety)
@
}
This example also illustrates the effect of the preceding "lsm.options" settings. Let us now return to the default display for contrast results.
<<>>=
lsm.options(ref.grid = NULL, contrast = NULL)
@




\section{Messy data}\ix{messy data}\index{Examples!nutrition study}\index{Examples!messy data}
To illustrate some more \code{lsmeans} capabilities, consider the dataset named \wixcode{nutrition} that is provided with the \lsm{} package. These data come from \citet{Mil92}, and contain the results of an observational study on nutrition education. Lowincome mothers are classified by race, age category, and whether or not they received food stamps (the \code{group} factor); and the response variable is a gain score (post minus pre scores) after completing a nutrition training program.

Consider the model that includes all main effects and twoway interactions. A TypeII (hierarchical) analysisofvariance table is also shown.
<<>>=
nutr.lm < lm(gain ~ (age + group + race)^2, data = nutrition)
library("car")
Anova(nutr.lm)
@
One main effect ("group") is quite significant, and there is possibly an interaction with "race". Let us look at the \code{group} by \code{race} LS~means:
<>=
lsmip(nutr.lm, race ~ age  group)
lsmeans(nutr.lm, ~ group*race)
@
\begin{figure}
\centerline{\includegraphics[scale=.75]{usinglsmeansnutrintplot}}
\caption{Predictions for the nutrition data}\label{nutrintplot}
\end{figure}

\Fig{nutrintplot} shows the predictions from this model. One thing the output illustrates is that \code{lsmeans} incorporates an \wix{estimability} check, and returns a missing value when a prediction cannot be made uniquely. In this example, we have very few Hispanic mothers in the dataset, resulting in \wix{empty cells}. This creates a \wix{rank deficiency} in the fitted model, and some predictors are thrown out.

We can avoid nonestimable cases by using \code{at} to restrict the reference levels to a smaller set. A useful summary of the results might be obtained by narrowing the scope of the reference levels to two races and the two middle age groups, where most of the data lie. However, always keep in mind that whenever we change the reference grid, we also change the definition of the LS~means. Moreover, it may be more appropriate to average the two ages using weights proportional to their frequencies in the data set. The simplest way to do this is to add a \wixcode{weights} argument.\footnote{
It may also be done by specifying a custom function in the \wixcode{fac.reduce} argument, but for simple weighting, \code{weights} is simpler.}
With those ideas in mind, here are the LS~means and comparisons within rows and columns:
<<>>=
nutr.lsm < lsmeans(nutr.lm, ~ group * race, weights = "proportional",
 at = list(age = c("2","3"), race = c("Black","White")))
@
So here are the results
<<>>=
nutr.lsm
summary(pairs(nutr.lsm, by = "race"), by = NULL)
summary(pairs(nutr.lsm, by = "group"), by = NULL)
@
The general conclusion from these analyses is that for age groups 2 and~3, the expected gains from the training are higher among families receiving food stamps.
Note that this analysis is somewhat different than the results we would obtain by subsetting the data before analysis, as we are borrowing information from the other observations in estimating and testing these LS~means.

\subsection{More on weighting}\label{weights}
The \wixcodesub{weights}{equal, proportional, outer, cells} argument can be a vector of numerical weights (it has to be of the right length), or one of five text values: \dqt{equal} (weight the predictions equally when averaging them, the default), \dqt{proportional} (weight them proportionally to the observed frequencies of the factor combinations being averaged over), \dqt{outer} (weight according to the outer products of the onefactor marginal counts), \dqt{cells} (weight each mean differently, according to the frequencies of the predictions being averaged), or \dqt{flat} (like \dqt{cells}, but give all nonemprty cells equal weight). \Fig{wtcomp} shows the LS~means for "race" using the first four different weighting schemes. (Note: If the model itself has weights, then the total weights are used instead of counts.)
\begin{figure}
\hspace{.06\linewidth}
\begin{minipage}{1.12\linewidth}
\hrule
\columnseprule=.2pt
\begin{multicols}{2}\footnotesize
<<>>=
lsmeans(nutr.lm, "race", weights = "equal")
lsmeans(nutr.lm, "race", weights = "prop")
lsmeans(nutr.lm, "race", weights = "outer")
lsmeans(nutr.lm, "race", weights = "cells")
@
\end{multicols}
\hrule
\end{minipage}
\caption{Comparison of four different weighting methods}\label{wtcomp}
\end{figure}

Note there are four different sets of answers. The \dqt{equal} weighting is selfexplanatory. But what's the distinction between \dqt{proportional} and \dqt{outer}? To clarify, consider:
<<>>=
temp = lsmeans(nutr.lm, c("group","race"), weights = "prop")
lsmeans(temp, "race", weights = "prop")
@
The previous results using \dqt{outer} weights are the same as those using \dqt{proportional} weights on one factor at a time. Thus, if only one factor is being averaged over, \dqt{outer} and \dqt{proportional} are the same. Another way to look at it is that outer weights are like the expected counts in a chisquare test; each factor is weighted independently of the others.

The results for \dqt{cells} weights stand out because everything is estimablethat's because the empty cells in the data were given weight zero. These results are the same as the unadjusted means:
<<>>=
with(nutrition, tapply(gain, race, mean))
@


\subsection{Nested fixed effects}\ix{nested models}
A factor $A$ is nested in another factor $B$ if the levels of $A$ have a different meaning in one level of $B$ than in another. Often, nested factors are random effectsfor example, subjects in an experiment may be randomly assigned to treatments, in which case subjects are nested in treatmentsand if we model them as random effects, these random nested effects are not among the fixed effects and are not an issue to "lsmeans". But sometimes we have fixed nested factors. For example, we may have data on different cities of particular interest, in three states of particular interest. Then cities are nested in states. We might want to compare the states because they have different social services policies or something; and we might want to compare the cities in each state. This nesting becomes particularly important when we have cities with the same name in different states: we need to be able to distinguish Springfield, Illinois and Springfield, Missouri.

In contrast to older versions of the package, "lsmeans" now tries to discover and accommodate nested structures in the fixed effects. It does this in two ways: first, by identifying factors whose levels appear in combination with only one level of another factor; and second, by examining the "terms" attribute of the fixed effects.

\index{Examples!cow treatments}\index{Examples!messy data}
Here is an example of a fictional study of five fictional treatments for some disease in cows. Two of the treatments are administered by injection, and the other three are administered orally. There are varying numbers of observations for each drug. The data and model follow:
<<>>=
cows = data.frame (
 route = factor(rep(c("injection", "oral"), c(5, 9))),
 drug = factor(rep(c("Bovineumab", "Charloisazepam",
 "Angustatin", "Herefordmycin", "Mollycoddle"), c(3,2, 4,2,3))),
 resp = c(34, 35, 34, 44, 43, 36, 33, 36, 32, 26, 25, 25, 24, 24)
)
cows.lm < lm(resp ~ route + drug, data = cows)
@
The "ref.grid" function finds a nested structure in this model:
<<>>=
( cows.rg < ref.grid(cows.lm) )
@

When there is nesting, "lsmeans" computes averages separately in each group\ldots
<<>>=
( route.lsm < lsmeans(cows.rg, "route") )
@
\ldots\ and insists on carrying along any grouping factors that a factor is nested in:
<<>>=
( drug.lsm < lsmeans(cows.rg, "drug") )
@
Here are the associated pairwise comparisons:
<<>>=
pairs(route.lsm, reverse = TRUE)
pairs(drug.lsm, by = "route", reverse = TRUE)
@
In the latter result, the contrast itself becomes a nested factor in the returned reference grid. That would not be the case if there had been no "by" variable.

It is possible for "lsmeans" or "ref.grid" to misdetect or overlook the nesting structure. If that happens, you may see a lot of "NA"s in the "lsmeans" results. The user can alter the nesting structure via the "update" function or the "nesting" argument to "ref.grid". The nesting is specified using a named "list" where each member's name is a factor name, and each member is a character vector of the names of other factors that it is nested in; for example,
<>=
lsmeans(city.model, "county",
 nesting = list(county = "state", city = c("county", "state")))
@


\subsection{Alternative covariate adjustments}\ix{covariate adjustments}
\index{Example!framing experiment}
The \wixcode{framing} data in the \pkg{mediation} package has the results of an experiment conducted by \cite{Bra08} where subjects were given the opportunity to send a message to Congress regarding immigration. However, before being offered this, some subjects ("treat=1") were first shown a news story that portrays Latinos in a negative way. Besides the binary response (whether or not they elected to send a message), we also measured "emo", the subjects' emotional state after the treatment was applied. There are various demographic variables as well.

Before fitting a logistic regression model, I will change the labels for "educ" to shorter strings.
<<>>=
library("mediation")
levels(framing$educ) = c("NA","Ref","< HS", "HS", "> HS","Coll +")
framing.glm = glm(cong_mesg ~ age + income + educ + emo + gender * factor(treat),
 family = binomial, data = framing)
@
The lefthand plot in \Fig{framing} displays the conventional \wix{adjusted means}, where predictions are made with the covariates "age", "income", and "emo" set to their mean values:
<>=
lsmip(framing.glm, treat ~ educ  gender, type = "response")
@
This plot is rather implausible because the displayed treatment effects are the opposite for females as for males, and the effect of education isn't monotone as one might expect.

\begin{figure}
\begin{center}
\begin{tabular}{c@{\qquad}c}
(a) & (b) \\
\includegraphics[width=3in]{usinglsmeansframinga.pdf} &
\includegraphics[width=3in]{usinglsmeansframingb.pdf}
\end{tabular}
\end{center}
\caption{Estimated responses for the \code{framing} data. (a)~Holding \code{emo} constant at its mean; (b)~Using predictions of \code{emo} for each \code{treat}.}\label{framing}
\end{figure}

\ix{covariate affected by treatments}\ix{mediating covariate}
However, "emo" is a posttreatment measurement. This means that the treatment could have affected it (it is a \emph{mediating} covariate). If it is indeed affected by "treat", then \Fig{framing}(a) would be misleading because "emo" is held constant.
Instead, consider making the predictions where "emo" is set to its predicted value at each combination of "treat" and the demographic variables. This is easily done by setting \wixcodesub{cov.reduce}{as a formula} to a formula for how to predict "emo":
<>=
lsmip(framing.glm, treat ~ educ  gender, type = "response",
 cov.reduce = emo ~ treat*gender + age + educ + income)
@
This plot is shown in \Fig{framing}(b). It is quite different, suggesting that "emo" does indeed play a strong mediating role. (The \pkg{mediation} package has functions for estimating the strength of these effects.) The predictions suggest that, taking emotional response into account, male subjects exposed to the negative news story are more likely to send the message than are females or those not seeing the negative news story. Also, the effect of "educ" is (almost) monotone.
You can see what values of "emo" are used in these predictions by looking at the "grid" slot in the reference grid:
<<>>=
ref.grid(framing.glm,
 cov.reduce = emo ~ treat*gender + age + educ + income)@grid
@
whereas the overall mean of \Sexpr{round(mean(framing$emo), 3)} is used as the value of "emo" in \Fig{framing}(a).



\ifx %%% Old covariate example is commentedout %%%%%%%%%%%%%%%%%%

\cite{urq82} reports data on slaughter weights of animals that entered a feedlot as yearling calves. The animals came from 11 different herds, and each animal was randomized to one of three diets. In addition, the weight of each yearling at entry was recorded. The "feedlot" dataset provided in \lsm{} contains these results. From the feedlot operator's perspective, both diets and herds are fixed effects. Let us fit a factorial model with slaughter weight "swt" as the response and entry weight "ewt" as a covariate.
%<<>>=
feedlot.lm < lm(swt ~ ewt + herd * diet, data = feedlot)
Anova(feedlot.lm)
@
The interaction tesrm doesn't make much of a contribution here, so we will work with an additive model instead (which also ameliorates some nonestimability issues due to missing cells).
%<<>>=
feedlot.add < update(feedlot.lm, . ~ .  herd:diet)
@
Here are the "LS~means" for the herds, and a compact letter display for comparisons thereof:
%<<>>=
cld(lsmeans(feedlot.add, "herd"))
@
No herds are found to be differentnot a surprise given that the $P$~value for "herd" is about the same as for the original model.
However, these predictions are made at the same entry weight for every herd. This is \emph{not} the right thing to do here, because the herds differ in genetic makeup, the way they were fed and managed, and so forthwhich affect the yearlings' entry weights. This is an example where a treatment affects a covariate. Each herd should have its own reference value for entry weight. This is done in "lsmeans" by providing a formula in the "cov.reduce" argument. The formula "ewt ~ herd" indicates that the reference grid should be constructed using the predicted value of "ewt", based on a linear model with "herd" as the predictor. Here are the results:
%<<>>=
cld(lsmeans(feedlot.add, "herd", cov.reduce = ewt ~ herd))
@
What a world of difference! We now see many significant differences in the comparisons. By the way, another approach would be to simply omit "ewt" from the model, to prevent making inappropriate adjustments in the traditional analysis. With such a model (not shown), the predictions are similar to those above; however, their standard errors are substantially higher, becauseas seen in the ANOVA tablethe covariate explains a lot of the variation.

\fi %%%%%%%%%%%%% end of commentedout section %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Another use of formulas in \wixcodesub{cov.reduce}{to reflect dependence} is to create representative values of some covariates when others are specified in \wixcode{at}. For example, suppose there are three covariates $x_1,x_2,x_3$ in a model, and we want to see predictions at a few different values of $x_1$. We might use
<>=
rg < ref.grid(my.model, at = list(x1 = c(5,10,15)),
 cov.reduce = list(x2 ~ x1, x3 ~ x1 + x2))
@
(When more than one formula is given, they are processed in the order given.)
The values used for $x_2$ and $x_3$ will depend on $x_1$ and should in some sense be more realistic values of those covariates as $x_1$ varies than would be the overall means of $x_2$ and $x_3$. Of course, it would be important to display the values usedavailable as "rg@grid"when reporting the analysis.





\section{Other types of models}\ix{models supported}
\subsection[Models supported by lsmeans]{Models supported by \lsm{}}
The \lsm{} package comes with builtin support for quite a number of packages and model classes,
including \dqt{lm}, \dqt{mlm}, \dqt{aov}, \dqt{aovlist}, and \dqt{glm} in the \wixpkg{stats} package, mixed models such as \dqt{lme}, \dqt{lmerMod}, and \dqt{glmerMod}, several survival models, GEEtype models, models having responses that are ordinal, multinomial, counts, and interval(0,1), and Bayesian models. For a complete list, use \code{help(\dqt{models})}.

\ifx % COMPLETEish LIST IS NOW COMMENTEDOUT 
\begin{quote}
\begin{description}
\pitem{stats}: \dqt{lm}, \dqt{mlm}, \dqt{aov}, \dqt{aovlist}, \dqt{glm}
\pitem{nlme}: \dqt{lme}, \dqt{gls}, \dqt{nlme}
\pitem{lme4}: \dqt{lmerMod}, \dqt{glmerMod}
\pitem{survival}: \dqt{survreg}, \dqt{coxph}
%%%\pitem{coxme}: \dqt{coxme}
\pitem{MASS}: \dqt{polr}
\pitem{gee, geepack}: \dqt{gee}, \dqt{geeglm}, \dqt{geese}
\pitem{ordinal}: \dqt{clm}, \dqt{clmm}
\pitem{rms}: \dqt{rms} and descendents such as \dqt{ols}, \dqt{lrm}, \dqt{orm}, etc.
\end{description}
\end{quote}
\fi % 

\lsm{} support for all these models works similarly to the examples we have presented. Note that generalized linear or mixed models, and several others such as survival models, typically employ link functions such as "log" or "logit". In most cases, the LS~means displayed are on the scale of the linear predictor, and any averaging over the reference grid is performed on the linearpredictor scale; but there are exceptions. Some objects have optional arguments that can be specified in the "ref.grid" or "lsmeans" call: see "?models" for details.

\subsection{Ordinaldata example}
The "clm" and "clmm" functions in \wixpkg{ordinal}, as well as the "polr" function in \wixpkg{MASS}, fit polytomous regression models to \wix{Likertscale data}. They do this by modeling the ordinal response as a categorization of a continuous latent variable $S$, then estimating thresholds for this categorization and fitting a generalized linear model to the cumulative probabilities for each threshold.
By default, "lsmeans" produces predictions of the \wix{latent variable}.

\index{Example!ordinal response}\index{Examples!housing data}
The example shown here is based on the \wixcode{housing} data in the \pkg{MASS} package, where the response variable is satisfaction ("Sat") on a threepoint scale of low, medium, high; and predictors include "Type" (type of rental unit, four levels), "Infl" (influence on management of the unit, three levels), and "Cont" (contact with other residents, two levels). We will assume that the latent variable is normally distributed (by specifying a probit link).
<>=
library("ordinal")
data(housing, package = "MASS")
housing.clm < clm(Sat ~ (Infl + Type + Cont)^2,
 data = housing, weights = Freq, link = "probit")
lsmip(housing.clm, Cont ~ Infl  Type, layout = c(4,1))
@
\begin{figure}
\begin{center}
\includegraphics[width=6in]{usinglsmeanshousingplot.pdf}
\end{center}
\caption{Interaction plot for the latent variable in the \code{housing} example.}\label{housingplot}
\end{figure}
The plot is shown in \Fig{housingplot}. Generally, the higher the influence, the higher the satisfaction. Overall $F$ tests of the "Infl" effect suggest that it is strong for all four housing types:
<<>>=
test(pairs(lsmeans(housing.clm, ~ Infl  Type)), joint = TRUE)
@
The tests are asymptotic (signaled by "df2 = NA"), so they are actually chisquare tests for the statistics $X^2 = df_1\cdot F$ with $df_1$ degrees of freedom. Higher contact also seems to be associated with higher satisfaction, but terrace apartments may be an exception. Let's see:
<<>>=
test(pairs(lsmeans(housing.clm, ~ Cont  Type)), joint = TRUE)
@
So the effect is inconclusive for both atria and terraces.

The \wixcode{mode} argument may be used to choose what to examine. Modes \dqt{linear.predictor} and \dqt{cum.prob} create an additional pseudofactor named "cut" for the thresholds at which the predictions are made.
<<>>=
ref.grid(housing.clm, mode = "cum.prob")
@
So here are our estimated marginal probabilities for "Infl" of being less than highly satisfied:
<<>>=
lsmeans(housing.clm, ~ Infl, at = list(cut = "MediumHigh"),
 mode = "cum.prob")
@
Compare these results with those for the backtransformed linear predictor:
<<>>=
summary(lsmeans(housing.clm, ~ Infl, at = list(cut = "MediumHigh"),
 mode = "linear.predictor"), type = "response")
@
The results are similar, but somewhat different because of the backtransformation\ix{transformations} coming before (first case) or after (second case) averaging or computing confidence limits.

\subsection{Chick weights, revisited}\index{Examples!chick weights}\index{Examples!nonlinear curves}
Previously, we used the \wixcode{ChickWeight} data to illustrate the use of "lstrends". That example made the simplifying assumption that the growth trends are linear, which is clearly questionable. To do a better job of fitting the data, consider instead the idea of fitting a \wix{logistic curve} to each chick's data. The \pkg{stats} package provides the "SSlogis" function for this purpose: it is an Sshaped curve (scaled from the cdf of a logistic distribution) having three parameters "asym" (the asymptotic value at which it levels off), "xmid" (the $x$ coordinate of its inflection point), and "scal" (roughly the difference between the median and the .73rd quantile). Also, the \wixpkg{nlme} package's \wixcode{nlme} function can fit a set of \wix{nonlinear curves} such that the parameters of those curves may be modeled using a mixedeffects linear model.

Accordingly, let us fit a model where each chick has a logistic curve for which the "asym" parameter varies randomly for each chick, and for which both "asym" and "xmid" depend on the chick's diet. We chose starting values by examining the curves and making a rough judgment of the typical asymptotic value, midpoint, and scale for each diet. We need to keep firmly in mind how factors are coded; so we explicitly show that we intend to use \dqt{contr.treatment} coding, by which the first mean is estimated directly, and the remaining estimates are offsets from that. We need a set of four starting values for "asym" and "xmid", and one for "scal".
<<>>=
require("nlme")
options(contrasts = c("contr.treatment", "contr.poly"))
Chick.nlme = nlme(weight ~ SSlogis(Time, asym, xmid, scal),
 data = ChickWeight,
 fixed = list(asym + xmid ~ Diet, scal ~ 1),
 random = asym ~ 1  Chick,
 start = c(200, 100, 200, 100, 10, 0, 0, 0, 7))
Chick.nlme
@
Now we can use "lsmeans" to compare the parameters based on "Diet":
<<>>=
cld(lsmeans(Chick.nlme, ~ Diet, param = "asym"))
cld(lsmeans(Chick.nlme, ~ Diet, param = "xmid"))
@
The result is that diet~3 has both a higher mean "asym" an a higher mean "xmid" than the other diets. This is compatible with the results of the earlier "lstrends" analysis, but grounded in terms of the parameters of the logistic curve.


\subsection{Extending to more models}\ix{extending the \pkg{lsmeans} package}
The functions "ref.grid" and "lsmeans" work by first reconstructing the dataset (so that the reference grid can be identified) and extracting needed information about the model, such as the regression coefficients, covariance matrix, and the linear functions associated with each point in the reference grid. For a fitted model of class, say, \dqt{modelobj}, these tasks are accomplished by defining S3 methods \wixcode{recover.data}".modelobj" and \wixcode{lsm.basis}".modelobj". The help page \dqt{extendinglsmeans} and the vignette by the same name provide details and examples.

Developers of packages that fit models are encouraged to include support for \lsm{} by incorporating (and exporting) "recover.data" and "lsm.basis" methods for their model classes.

\subsection{Bayesian models}\index{Examples!Bayesian Poisson regression}
Certain \wix{Bayesian models} are now supported by \lsm{}. For illustration, consider a twofactor Poisson regression example given in the \wixpkg{MCMCpack} package:
<<>>=
library("MCMCpack")
counts < c(18, 17, 15, 20, 10, 20, 25, 13, 12)
outcome < gl(3, 1, 9)
treatment < gl(3, 3)
posterior < MCMCpoisson(counts ~ outcome + treatment, mcmc = 1000)
@
The result is an "mcmc" object\index{mcmc@\code{mcmc} object} (defined in the \wixpkg{coda} package), but it has an added \dqt{call} attribute that enables "lsmeans" to do its work. Here are results for treatments, averaged over outcomes:
<<>>=
( post.lsm < lsmeans(posterior, "treatment") )
@
This is a frequentist summary, based on the mean and covariance of the regression parameters in the "posterior" sample. But \lsm{} provides an \wixcode{as.mcmc} method to obtain a sample from the posterior distribution of the LS~means\ix{posterior LS~means} (that is, the original posterior sample of regression coefficients, transformed by the appropriate linear functions.)
<<>>=
library("coda")
summary(as.mcmc(post.lsm))
@
Since "as.mcmc" produces an "mcmc" object, any of the other available methods may be used with it.



\section{Discussion}
The design goal of \lsm{} is primarily to provide the functionality of the "LSMEANS"\index{SAS!LSMEANS} statement in various \SAS{} procedures. Thus its emphasis is on tabular results which, of course, may also be used as data for further analysis or graphics. By design, it can be extended with relative ease to additional model classes.
A unique capability of \lsm{} is its explicit reliance on the concept of a reference grid, which I feel is a useful approach for understanding what is being computed.

Some \lsm{} capabilities exceed those of \SAS, including the "lstrends" capability, more flexibility in organizing the output, and more builtin contrast families. In addition, \SAS{} does not allow LS~means for factor combinations when the model does not include the interaction of those factors; or creating a grid of covariate values using "at".

There are a few other \R{} packages that provide capabilities that overlap with those of \lsm{}. The \wixpkg{effects} package \citep{effects,fox09} can compute LS~means. However, for an unbalanced dataset, it does not use equal \wix{weights}, but rather it appears to use ``outer'' weights, as described in Section~\ref{weights}. Also, it does not check \wix{estimability}, so some results could be questionable.
The emphasis of \pkg{effects} is on graphical rather than tabular displays.
It has special strengths for curvefitting models such as splines. In contrast, \lsm{}'s strengths are more in the area of factorial models where one wants traditional summaries in the form of estimates, contrasts, and interaction plots.

The \wixpkg{doBy} package \citep{doBy} provides an "LSmeans" function that has some of the capabilities of "lsmeans", but it produces a data frame rather than a reusable object. In earlier versions of the package, this function was named "popMeans". The package also has an "LSmatrix" function to obtain the linear functions needed to obtain LS~means. Also, the \wixpkg{lmerTest} package also offers an "lsmeans" function, as well as "difflsmeans" for differences of LS~means. These are designed particularly for "lmerMod" objects.


\bibliography{lsmeans}\bibliographystyle{jss}

\printindex

\end{document}
diff pruN 2.27623/inst/NEWS 2.3001/inst/NEWS
 2.27623/inst/NEWS 20180510 15:08:30.000000000 +0000
+++ 2.3001/inst/NEWS 20181101 00:46:23.000000000 +0000
@@ 1,12 +1,15 @@
Changelog for 'lsmeans' package
22762
+2.300
+ Deferred almost all functionality to the 'emmeans' package.
+
+2.2762
Corrected a misleading statement in ?transition
22761
+2.2761
Fixes to vcov calls to pass checks against Rdevel
22760
+2.2760
Startup message and Description encouraging users to switch to 'emmeans'
Removed 'extending' vignette as we won't be encouraging anyone to
add lsmeans support. An updated version exists in 'emmeans'
diff pruN 2.27623/man/auto.noise.Rd 2.3001/man/auto.noise.Rd
 2.27623/man/auto.noise.Rd 20170930 17:46:30.000000000 +0000
+++ 2.3001/man/auto.noise.Rd 20181026 20:14:02.000000000 +0000
@@ 1,48 +1,19 @@
% Copyright (c) 20122016 Russell V. Lenth %
+% Copyright (c) 20122018 Russell V. Lenth %
\name{auto.noise}
\alias{auto.noise}
\docType{data}
\title{Auto Pollution Filter Noise}
\description{Threefactor experiment comparing pollutionfilter noise for two filters, three sizes of cars, and two sides of the car.}
\usage{auto.noise}

\format{
 A data frame with 36 observations on the following 4 variables.
 \describe{
 \item{\code{noise}}{Noise level in decibels  a numeric vector.}
 \item{\code{size}}{The size of the vehicle  an ordered factor with levels \code{S}, \code{M}, \code{L}.}
 \item{\code{type}}{Type of antipollution filter  a factor with levels \code{Std} and \code{Octel}}
 \item{\code{side}}{The side of the car where measurement was taken  a factor with levels \code{L} and \code{R}.}
 }
}

\details{
The data are from a statement by Texaco, Inc., to the Air and Water Pollution
Subcommittee of the Senate Public Works Committee on June 26, 1973.
Mr. John McKinley, President of Texaco, cited an automobile filter developed
by Associated Octel Company as effective in reducing pollution. However,
questions had been raised about the effects of filters on vehicle performance,
fuel consumption, exhaust gas back pressure, and silencing. On the last
question, he referred to the data included here as evidence that the silencing
properties of the Octel filter were at least equal to those of standard silencers.}
+\alias{feedlot}
+\alias{fiber}
+\alias{MOats}
+\alias{nutrition}
+\alias{oranges}
\source{The dataset was imported from the Data and Story Library  \url{http://lib.stat.cmu.edu/DASL/Datafiles/airpullutionfiltersdat.html} (sic). However,
the factor levels were assigned meaningful names, and the observations were sorted
in random order as if this were the run order of the experiment.
}

\references{
A.Y. Lewin and M.F. Shakun (1976) \emph{Policy Sciences: Methodology and Cases}. Pergammon Press. p.313.
}
\examples{
require(lsmeans)
noise.lm < lm(noise ~ size * type * side, data = auto.noise)
+\docType{data}
+\title{Data sets}
+\description{The datasets \sQuote{auto.noise}, \sQuote{feedlot}, \sQuote{fiber},
+\sQuote{MOats}, \sQuote{nutrition}, and \sQuote{oranges} are provided in case a user customarily loads the data from \pkg{lsmeans}. But the same datasets are provided in the \pkg{emmeans} package, and they are documented there.}
# Interaction plot of predictions
lsmip(noise.lm, type ~ size  side)
+\usage{auto.noise}
# Confidence intervals
plot(lsmeans(noise.lm, ~ size  side*type))
}
+\author{Russell V. Lenth}
\keyword{datasets}
diff pruN 2.27623/man/cld.Rd 2.3001/man/cld.Rd
 2.27623/man/cld.Rd 20170930 17:46:30.000000000 +0000
+++ 2.3001/man/cld.Rd 19700101 00:00:00.000000000 +0000
@@ 1,63 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{cld}
\alias{cld}
\alias{cld.ref.grid}
\alias{cld.lsm.list}

\title{Compact letter display of pairwise comparisons}

\description{
Extract and display information on all pairwise comparisons of leastsquares means.}

\usage{
\method{cld}{ref.grid}(object, details = FALSE, sort = TRUE, by, alpha = 0.05,
 Letters = c("1234567890", LETTERS, letters), reversed = FALSE, ...)
\method{cld}{lsm.list}(object, ..., which = 1)
}

\arguments{
 \item{object}{An object of class \code{ref.grid}}
 \item{details}{Logical value determining whether detailed
 information on tests of pairwise comparisons is displayed}
 \item{sort}{Logical value determining whether the LS means are
 sorted before the comparisons are produced. When \code{sort} is \code{TRUE}, the results are displayed in increasing order if \code{reversed} is \code{FALSE} (the default), or in decreasing order if \code{reversed} is \code{TRUE}.}
 \item{by}{Character value giving the name or names of variables by which separate
 families of comparisons are tested.
 If \code{NULL}, all means are compared. If missing, and a \code{by} variable was used in creating \code{object}, it is used as the \code{by} variable in \code{cld}.}
 \item{alpha}{Numeric value giving the significance level for the comparisons}
 \item{Letters}{Character vector of letters to use in the display.
 Any strings of length greater than 1 are expanded into individual characters}
 \item{reversed}{Logical value (passed to \code{\link[multcompView]{multcompLetters}} in the \pkg{multcompView} package.) If \code{TRUE}, the order of use of the letters is reversed. In addition, if both \code{sort} and \code{reversed} are \code{TRUE}, the sort order of results is reversed.}
 \item{\dots}{Arguments passed to \code{\link{contrast}} (for example, an \code{adjust} method)}
 \item{which}{When \code{object} is a list, this determines which element is analyzed.}
}
\details{
This function uses the Piepho (2004) algorithm (as implemented in the \pkg{multcompView} package) to generate a compact letter display of all pairwise comparisons of leastsquares means. The function obtains (possibly adjusted) \emph{P} values for all pairwise comparisons of means, using the \code{\link{contrast}} function with \code{method = "pairwise"}. When a \code{P} value exceeds \code{alpha}, then the two means have at least one letter in common.
}
\value{
When \code{details == FALSE}, an object of class \code{summary.ref.grid} (which inherits from \code{data.frame}) showing the summary of LS means with an added column named \code{.groups} with the cld information. When \code{details == TRUE}, a list the object just described, as well as the summary of the \code{contrast} results showing each comparison, its estimate, standard error, \eqn{t} ratio, and adjusted \eqn{P} value.
}
\references{
HansPeter Piepho (2004) An algorithm for a letterbased representation of all pairwise comparisons, \emph{Journal of Computational and Graphical Statistics}, 13(2), 456466.
}
\author{Russell V. Lenth}
\note{This function requires the \pkg{multcompView} package to be installed. Otherwise an error message is produced.}

%% ~Make other sections like Warning with \section{Warning }{....} ~

\seealso{
\code{\link[multcomp]{cld}} in the \pkg{multcomp} package
}
\examples{
warp.lm < lm(breaks ~ wool * tension, data = warpbreaks)
warp.lsm < lsmeans(warp.lm, ~ tension  wool)
cld(warp.lsm) # implicitly uses by = "wool"
cld(warp.lsm, by = "tension") # overrides implicit 'by'

# Mimic grouping bars and compare all 6 means
cld(warp.lsm, by = NULL, Letters = "", alpha = .01)
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ htest }
diff pruN 2.27623/man/contrast.Rd 2.3001/man/contrast.Rd
 2.27623/man/contrast.Rd 20170930 17:46:30.000000000 +0000
+++ 2.3001/man/contrast.Rd 19700101 00:00:00.000000000 +0000
@@ 1,139 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{contrast}
\alias{contrast}
\alias{contrast.ref.grid}
\alias{contrast.lsm.list}
\alias{test}
\alias{test.ref.grid}
\alias{confint}
\alias{confint.ref.grid}
\alias{pairs}
\alias{pairs.ref.grid}
\alias{coef}
\alias{coef.ref.grid}



\title{
Methods for obtaining analyses \code{ref.grid} and \code{lsmobj} objects
}
\description{
These methods provide for analyses of \code{ref.grid} objects, or followup analyses of \code{lsmobj} objects: Contrasts, pairwise comparisons, tests, and confidence intervals.
}
\usage{
\method{contrast}{ref.grid}(object, method = "eff", interaction = FALSE,
 by, offset = NULL, name = "contrast",
 options = getOption("lsmeans")$contrast, adjust, ...)
\method{contrast}{lsm.list}(object, ..., which = 1)

\method{test}{ref.grid}(object, null = 0, joint = FALSE,
 verbose = FALSE, rows, by, ...)

\method{confint}{ref.grid}(object, parm, level = 0.95, ...)

\method{pairs}{ref.grid}(x, reverse = FALSE, ...)

\method{coef}{ref.grid}(object, ...)
}
% maybe also 'usage' for other objects documented here.
\arguments{
 \item{object, x}{
An object of class \code{"ref.grid"} or its extension, \code{"lsmobj"}.
}
 \item{method}{
Character value giving the root name of a contrast method (e.g. \code{"pairwise"}). Alternatively, a named list of contrast coefficients that must each conform to the number of leastsquares means in each \code{by} group. This is just like the \code{contr} argument in \code{\link{lsmeans}}. To identify the available methods, see \preformatted{ls("package:lsmeans", pat=".lsmc")} You may define your own \code{.lsmc} function and use its root name as \code{method}. If \code{interaction} is of character type, this argument is ignored.
}
 \item{interaction}{
Character vector or logical value. In multifactor situations with \code{interaction = FALSE}, the factor combinations are treated as levels of a single \dQuote{uberfactor}, and the contrast specified in \code{method} is applied to it. Otherwise, interaction contrasts are computed: Contrasts are generated for each factor separately, one at a time; and these contrasts are applied to the object (the first time around) or to the previous result (subsequently). (Any factors specified in \code{by} are skipped.) The final result comprises contrasts of contrasts, or, equivalently, products of contrasts for the factors involved. Processing is done in the order of appearance in \code{object@levels}. With \code{interaction = TRUE}, \code{method} (if specified as character) is used for each contrast. If \code{interaction} is a character vector, the elements specify the respective contrast method(s); they are recycled as needed.
}
 \item{by}{
Character names of variable(s) to be used for ``by'' groups. The contrasts or joint tests will be evaluated separately for each combination of these variables. If \code{object} was created with by groups, those are used unless overridden. Use \code{by = NULL} to use no by groups at all.
}
 \item{offset}{Numeric vector of the same length as each \code{by} group. These values are added to their respective linear estimates. This argument is ignored when\code{interaction} is not \code{FALSE}.
}
 \item{name}{Name to use to label the contrasts in table headings
 or subsequent contrasts of the returned object. This argument is ignored
 when\code{interaction} is not \code{FALSE}.
}
 \item{options}{If non\code{NULL}, a named \code{list} of arguments to pass to \code{\link{update}}, just after the object is constructed.}

 \item{adjust}{
Method to use for adjusting \emph{P} values. This is passed to \code{\link[lsmeans]{summary}}. This argument is available in \code{contrast} for historical reasons; but it is better style to specify the adjustment method, along with other testing options such as \code{side}, as part of \code{options}.
}
 \item{joint}{Logical value. If \code{FALSE}, the arguments are passed to \code{\link{summary}} with \code{infer=c(FALSE,TRUE)}. If \code{TRUE}, a joint test of the hypothesis L beta = null is performed, where L is \code{object@linfct} and beta is the vector of fixed effects estimated by \code{object@betahat}. This will be either an \emph{F} test or a chisquare (Wald) test depending on whether degrees of freedom are available.}
 \item{rows}{Integer values. The rows of L to be tested in the joint test. If missing, all rows of L are used. If not missing, \code{by} variables are ignored.}
 \item{null}{Numeric value specifying the null value(s) being tested against. It may be either a single value, in which case it is used as the null value for all linear functions under test; or a numeric vector of length equal to the number of linear functions.}
 \item{parm}{This is ignored, but it is a required argument of the generic \code{confint} method.)}
 \item{verbose}{Logical value. If \code{TRUE} and \code{joint==TRUE}, a table of the effects being tested is printed.}
 \item{level}{
Numeric value of the desired confidence level.}
 \item{which}{When \code{object} is a list of \code{lsmobj} objects, this specifies which member of the list is analyzed.}
 \item{reverse}{Logical value determining whether \code{"pairwise"} or \code{"revpairwise"} pairwise comparisons are generated.}
 \item{\dots}{
Additional arguments passed to \code{\link[lsmeans]{summary}} or to a contrast function.}
}
\details{
Though \code{contrast} is ordinarily used to create true contrasts (whose coefficients sum to zero), it may be used to estimate any linear function of the LS means; and \code{offset} expands this capability further by allowing additive constants.
\code{pairs} is equivalent to \code{contrast} with \code{method = "pairwise"}.

\code{confint} and \code{test} (when \code{JOINT==FALSE}) are equivalent to calling \code{\link[lsmeans]{summary}} with \code{infer=c(TRUE,FALSE)} and \code{infer=c(FALSE,TRUE)}, respectively.

When using \code{test} to do a joint test of L beta = null, an error is thrown if any row of L is nonestimable. It is permissible for the rows of L to be linearly dependent as long as \code{null == 0}; a reduced set of contrasts is tested. Linear dependence and nonzero \code{null} cause an error.
}
\value{
\code{contrast} and \code{pairs} return an object of class \code{"lsmobj"}, which is an extension of \code{"ref.grid"}. Consequently, they may be used as arguments to other \code{"lsmobj"} or \code{"ref.grid"} methods. The user may, for example, compute contrasts of contrasts, or resummarize a set of confidence intervals with a different \code{by} grouping or confidence level.
The ``grid'' for the returned value is simply the set of variables that identify the results. For example, \code{contrast}'s return value is a reference grid for one factor named \code{contrast}.

\code{confint} and \code{test} (when \code{Joint==FALSE}) return an object of class \code{summary.ref.grid}. When \code{JOINT==TRUE}, \code{test} returns a \code{"summary.ref.grid"} object (extends \code{"data.frame"}) with the test statistic, degrees of freedom, and \emph{P} value for each \code{by} group.

When \code{object} is the result of a call to \code{contrast} or \code{pairs}, the \code{coef} method returns a\code{data.frame}. The initial columns are the factor combinations that were contrasted (i.e. the grid for the \code{object} originally specified in the call to \code{contrast}), and the remaining columns (named \code{c.1}, \code{c.2}, \ldots) contain the contrast coefficients that were applied to the corresponding predictions. If \code{object} was not produced via \code{contrast}, \code{NULL} is returned, along with a message.
}
%\references{}
\author{
Russell V. Lenth
}
%\note{}

%% ~Make other sections like Warning with \section{Warning }{....} ~

\seealso{
Additional \code{"lsmobj"} methods having their own help pages are \code{\link[lsmeans]{cld}} and \code{\link[lsmeans]{glht}}. Also, the \code{\link[lsmeans]{summary}} and other methods for \code{"ref.grid"} objects also work for \code{"lsmobj"} objects.
}
\examples{
require(lsmeans)
warp.lm < lm(breaks ~ wool*tension, data = warpbreaks)
warp.lsm < lsmeans(warp.lm, ~ tension  wool)

# Polynomial contrasts of tension, by wool
(warp.pl < contrast(warp.lsm, "poly", name = "order"))
# Same results with a different adjustment
summary(warp.pl, adjust = "fdr")

# Jointly test the tension effects for each wool
test(warp.pl, joint = TRUE, by = "wool")

# Compare the two contrasts for each order
contrast(warp.pl, "revpairwise", by = "order")

# Userprovided contrasts, ignoring the previous by grouping
contrast(warp.lsm,
 list(c1=c(1,0,0,1,0,0), c2=c(1,1,1,1,1,1)/3),
 by = NULL)

# Compare consecutive tension*wool comb's as treatment with 6 levels
contrast(warp.lsm, "consec", by = NULL)

# Interaction contrasts (comparisons of linear and quadratic contrasts)
(int.con < contrast(warp.lsm, interaction = c("poly", "consec"), by = NULL))

# See the contrast coefficients used by the previous call
coef(int.con)

}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ models }
\keyword{ regression }
\keyword{ htest }

diff pruN 2.27623/man/extending.Rd 2.3001/man/extending.Rd
 2.27623/man/extending.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/extending.Rd 19700101 00:00:00.000000000 +0000
@@ 1,114 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{recover.data}
\alias{recover.data}
\alias{recover.data.call}
\alias{lsm.basis}
%%\alias{.all.vars} % documented in the vignette
%%\alias{nonest.basis} % moved to estimability package
%%\alias{is.estble}

% additional ref topic
\alias{extendinglsmeans}


\title{Support functions for creating a reference grid}
\description{
This documents the methods used to create a \code{\link[=ref.gridclass]{ref.grid}} object from a fitted model.
}
\usage{
recover.data(object, ...)
\S3method{recover.data}{call}(object, trms, na.action,
 data = NULL, params = NULL, ...)

lsm.basis(object, trms, xlev, grid, ...)
%%%
%%%.all.vars(expr, retain = c("\\\\$", "\\\\[\\\\[", "\\\\]\\\\]"), ...)
}
% maybe also 'usage' for other objects documented here.
\arguments{
 \item{object}{
An object returned from a modelfitting function.}
 \item{trms}{The \code{\link{terms}} component of \code{object}}
 \item{xlev}{Named list of levels of factors in the model frame. This should \emph{not} include levels of factors created in the model itself, e.g., by including a \code{factor} call in the model formula.}
 \item{grid}{A \code{data.frame} containing predictor values at which predictions are needed.}
 \item{na.action}{Integer vector of indices of observations to ignore; or \code{NULL} if none}
 \item{data}{Data frame. Usually, this is \code{NULL}. However, if nonnull, this is used in place of the reconstructed dataset. It must have all of the predictors used in the model, and any factor levels must match those used in fitting the model.}
 \item{params}{Character vector giving the names of any variables in the
 model formula that are \emph{not} predictors. An example would be a
 variable \code{knots} specifying the knots to use in a spline model.
}
% \item{expr}{A formula}
% \item{retain}{Character vector of operators to retain (escaped as for \code{\link{gsub}})}
 \item{\dots}{Additional arguments passed to other methods.}
}

\details{
To create a reference grid, the \code{ref.grid} function needs to reconstruct the data used in fitting the model, and then obtain a matrix of linear functions of the regression coefficients for a given grid of predictor values. These tasks are performed by calls to \code{recover.data} and \code{lsm.basis} respectively.

To extend \pkg{lsmeans}'s support to additional model types, one need only write S3 methods for these two functions. The existing methods serve as helpful guidance for writing new ones. Most of the work for \code{recover.data} can be done by its method for class \code{"call"}, providing the \code{terms} component and \code{na.action} data as additional arguments. Writing an \code{lsm.basis} method is more involved, but the existing methods (e.g., \code{lsmeans:::lsm.basis.lm}) can serve as models. See the ``Value'' section below for details on what it needs to return. Also, certain \code{recover.data} and \code{lsm.basis} methods are exported from \pkg{lsmeans}, so if your object is based on another modelfitting object, it may be that all that is needed is to call one of these exported methods and perhaps make modifications to the results. Contact the developer if you need others of these exported.

If the model has a multivariate response, \code{bhat} needs to be \dQuote{flattened} into a single vector, and \code{X} and \code{V} must be constructed consistently.

In models where a nonfullrank result is possible (often you can tell by seeing if there is a \code{singular.ok} argument in the modelfitting function), \code{summary} and \code{predict} check the estimability of each prediction, using the \code{\link[estimability]{nonest.basis}} function in the \pkg{estimability} package.

The models already supported are detailed in \code{\link{models}}. Some packages may provide additional \pkg{lsmeans} support for its object classes.
}


\value{
\code{recover.data} should return a \code{data.frame} containing all the variables in the original data that appear as predictors in the model. Several attributes need to be included as well; see the code for \code{lsmeans:::recover.data.lm}.

\code{lsm.basis} should return a \code{list} with the following elements:
\item{X}{The matrix of linear functions over \code{grid}, having the same number of rows as \code{grid} and the number of columns equal to the length of \code{bhat}.}
\item{bhat}{The vector of regression coefficients for fixed effects. This should \emph{include} any \code{NA}s that result from rank deficiencies.}
\item{nbasis}{A matrix whose columns form a basis for nonestimable functions of beta, or a 1x1 matrix of \code{NA} if there is no rank deficiency.}
\item{V}{The estimated covariance matrix of \code{bhat}.}
\item{dffun}{A function of \code{(k, dfargs)} that returns the degrees of freedom associated with \code{sum(k * bhat)}.}
\item{dfargs}{A \code{list} containing additional arguments needed for \code{dffun}.}

%%%\code{.all.vars} is an enhancement of \code{\link{all.vars}}, whereby the operators specified in \code{retain} are left intact. Thus, \code{All.vars(foo$y ~ bar[[2]])} returns \code{"foo$y", "bar[[2]]"}, whereas \code{all.vars} returns \code{"foo", "y", "bar"}
}

%\references{}

\section{Optional hooks}{
Some models may need something other than standard linear estimates and standard errors. If so, custom functions may be pointed to via the items \code{misc$estHook}, \code{misc$vcovHook} and \code{misc$postGridHook}. If just the name of the hook function is provided as a character string, then it is retrieved using \code{\link{get}}.

The \code{estHook} function should have arguments \samp{(object, do.se, tol, ...)} where \code{object} is the \code{ref.grid} or \code{lsmobj} object, \code{do.se} is a logical flag for whether to return the standard error, and \code{tol} is the tolerance for assessing estimability. It should return a matrix with 3 columns: the estimates, standard errors (\code{NA} when \code{do.se==FALSE}), and degrees of freedom (\code{NA} for asymptotic). The number of rows should be the same as \samp{object@linfct}. The \code{vcovHook} function should have arguments \samp{(object, tol, ...)} as described. It should return the covariance matrix for the estimates. Finally, \code{postGridHook}, if present, is called at the very end of \code{ref.grid}; it takes one argument, the constructed \code{object}, and should return a suitably modified\code{ref.grid} object.
}

\section{Additional functions}{
A few additional functions used in the \pkg{lsmeans} codebase are exported as they may be useful to package developers. See details near the end of the vignette \code{"extending"}.
}

\author{
Russell V. Lenth
}
%\note{}

%% ~Make other sections like Warning with \section{Warning }{....} ~

\seealso{
\code{\link{models}}, \code{\link{ref.grid}}, \code{\link{ref.gridclass}}
}
\examples{
\dontrun{
 require(lsmeans)

 # Fit a 2factor model with two empty cells
 warpsing.lm < lm(breaks ~ wool*tension,
 data = warpbreaks, subset = (16:40))

 lsmeans:::recover.data.lm(warpsing.lm, data = NULL)
 grid = with(warpbreaks,
 expand.grid(wool = levels(wool), tension = levels(tension)))
 lsmeans:::lsm.basis.lm(warpsing.lm, delete.response(terms(warpsing.lm)),
 warpsing.lm$xlevels, grid)
} % end dontrun

}


\keyword{ models }
\keyword{ regression }
diff pruN 2.27623/man/feedlot.Rd 2.3001/man/feedlot.Rd
 2.27623/man/feedlot.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/feedlot.Rd 19700101 00:00:00.000000000 +0000
@@ 1,39 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{feedlot}
\alias{feedlot}
\docType{data}
\title{
Feedlot data
}
\description{
This is an unbalanced analysisofcovariance example, where one covariate is affected by a factor. Feeder calves from various herds enter a feedlot, where they are fed one of three diets. The weight of the animal at entry is the covariate, and the weight at slaughter is the response.
}
\usage{data(feedlot)}
\format{
 A data frame with 67 observations on the following 4 variables.
 \describe{
 \item{\code{herd}}{a factor with levels \code{9} \code{16} \code{3} \code{32} \code{24} \code{31} \code{19} \code{36} \code{34} \code{35} \code{33}, designating the herd that a feeder calf came from.}
 \item{\code{diet}}{a factor with levels \code{Low} \code{Medium} \code{High}: the energy level of the diet given the animal.}
 \item{\code{swt}}{a numeric vector: the weight of the animal at slaughter.}
 \item{\code{ewt}}{a numeric vector: the weight of the animal at entry to the feedlot.}
 }
}
\details{
The data arise from a Western Regional Research Project conducted at New Mexico State University. Calves born in 1975 in commercial herds entered a feedlot as yearlings. Both diets and herds are of interest as factors. The covariate, \code{ewt}, is thought to be dependent on \code{herd} due to different genetic backgrounds, breeding history, etc. The levels of \code{herd} ordered to similarity of genetic background.

Note: There are some empty cells in the crossclassification of \code{herd} and \code{diet}.
}
\source{
Urquhart NS (1982) Adjustment in covariates when one factor affects the covariate. \emph{Biometrics} 38, 651660.
}

\examples{
require(lsmeans)
feedlot.lm < lm(swt ~ ewt + herd*diet, data = feedlot)

# Obtain LS~means with a separate reference value of ewt for each
# herd. This reproduces the last part of Table 2 in the reference
lsmeans(feedlot.lm, ~ diet  herd, cov.reduce = ewt ~ herd)
}
\keyword{datasets}
diff pruN 2.27623/man/fiber.Rd 2.3001/man/fiber.Rd
 2.27623/man/fiber.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/fiber.Rd 19700101 00:00:00.000000000 +0000
@@ 1,36 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{fiber}
\alias{fiber}
\docType{data}
\title{
Fiber data
}
\description{
Fiber data from Montgomery Design (8th ed.), p.656 (Table 15.10). Useful as a simple analysisofcovariance example.
}
\usage{fiber}
\format{
 A data frame with 15 observations on the following 3 variables.
 \describe{
 \item{\code{machine}}{a factor with levels \code{A} \code{B} \code{C}. The primary factor of interest.}
 \item{\code{strength}}{a numeric vector. The response variable.}
 \item{\code{diameter}}{a numeric vector. A covariate.}
 }
}
\details{
The goal of the experiment is to compare the mean breaking strength of fibers produced by the three machines. When testing this, the technician also measured the diameter of each fiber, and this measurement may be used as a concomitant variable to improve precision of the estimates.
}
\source{
Montgomery, D. C. (2013) \emph{Design and Analysis of Experiments} (8th ed.). John Wiley and Sons, ISBN 9781118146927.
}

\examples{
require(lsmeans)
fiber.lm < lm(strength ~ diameter + machine, data=fiber)
ref.grid(fiber.lm)

# Covariateadjusted means and comparisons
lsmeans(fiber.lm, pairwise ~ machine)
}
\keyword{datasets}
diff pruN 2.27623/man/glht.Rd 2.3001/man/glht.Rd
 2.27623/man/glht.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/glht.Rd 19700101 00:00:00.000000000 +0000
@@ 1,87 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{glht}
\alias{glht}
\alias{lsm}
\alias{glht.ref.grid}
\alias{as.glht}
\alias{as.glht.ref.grid}
\alias{as.glht.lsm.list}
\alias{coef.glht.list}
\alias{confint.glht.list}
\alias{plot.glht.list}
\alias{summary.glht.list}
\alias{vcov.glht.list}
\alias{pmm}

% Also NEED an '\alias' for EACH other topic documented here.
\title{
\pkg{lsmeans} support for \code{glht}
}
\description{
These functions and methods provide an interface between \pkg{lsmeans} and the \code{\link[multcomp]{glht}} function for simultaneous inference in the \pkg{multcomp} package.
}
\usage{
\method{as.glht}{ref.grid}(object, ...)
\method{as.glht}{lsm.list}(object, ..., which = 1)

\method{coef}{glht.list}(object, ...)
\method{confint}{glht.list}(object, ...)
\method{plot}{glht.list}(x, ...)
\method{summary}{glht.list}(object, ...)
\method{vcov}{glht.list}(object, ...)

lsm(...)
pmm(...)
}
\arguments{
 \item{object, x}{
An object of the required class.
}
 \item{which}{Numeric index of which element of the \code{lsm.list} to use.}
 \item{\dots}{
Additional arguments to other methods.
}
}
\details{
\code{lsm} (and \code{pmm}, which is identical) are meant to be called only \emph{from} \code{"glht"} as its second (\code{linfct}) argument. It works similarly to \code{\link[multcomp]{mcp}} except with \code{specs} (and optionally \code{by} and \code{contr} arguments) provided as in a call to \code{\link{lsmeans}} or \code{pmmeans}.

When there is a non\code{NULL} \code{by} variable (either explicitly or implicitly), each ``by'' group is passed separately to \code{glht} and returned as a \code{list} of \code{"glht"} objects. For convenience, this is classed as \code{"glht.list"}, and appropriate methods \code{coef}, \code{confint}, \code{plot}, \code{summary}, and \code{vcov} are provided.
}
\value{
\code{as.glht} returns an object of class \code{\link[multcomp]{glht}}, or of class \code{glht.list} if \code{by} is non\code{NULL}. The latter is simply a list of \code{glht} objects, and the provided methods \code{coef}, \code{confint}, \code{plot}, \code{summary}, and \code{vcov} simply \code{\link{lapply}} the corresponding methods for class \code{"glht"}.
}
%\references{}
\author{
Russell V. Lenth
}
\note{
There is also a \code{glht} method for class \code{ref.grid}, but it is far preferable to use \code{as.glht} instead, as its \code{model} argument is redundant.
}

%% ~Make other sections like Warning with \section{Warning }{....} ~

\seealso{
\code{\link{lsmeans}}, \code{\link[multcomp]{glht}}
}
\examples{
require(lsmeans)
require(multcomp)

warp.lm < lm(breaks ~ wool*tension, data = warpbreaks)

# Using 'lsm'
summary(glht(warp.lm, lsm(pairwise ~ tension  wool)))

# Same, but using an existing 'lsmeans' result
warp.lsmobj < lsmeans(warp.lm, ~ tension  wool)
summary(as.glht(pairs(warp.lsmobj)))

# Same contrasts, but treat as one family
summary(as.glht(pairs(warp.lsmobj), by = NULL))
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ regression }
\keyword{ models }
\keyword{ htest }
diff pruN 2.27623/man/grouping.Rd 2.3001/man/grouping.Rd
 2.27623/man/grouping.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/grouping.Rd 19700101 00:00:00.000000000 +0000
@@ 1,54 +0,0 @@
\name{add_grouping}
\alias{add_grouping}


\title{
Create a grouping factor
}
\description{
A new factor \code{G} can be defined having levels based on those of an existing factor \code{A}. This adds \code{G} to the reference grid and redefines \code{A} as being nested in \code{G}.
}
\usage{
add_grouping(object, newname, refname, newlevs)
}
\arguments{
 \item{object}{A \code{\link{ref.grid}} object}
 \item{newname}{Character name of the grouping factor to be created}
 \item{refname}{Character name of an existing factor in \code{object} whose levels are to be grouped}
 \item{newlevs}{Character vector or factor of the same length as the levels for \code{refname}. Each element specifies the corresponding level for \code{newname}}
}
\details{
This function is useful when one wants to group certain levels of some treatment factor together and summarize by those groups  without fitting a new model. For example, suppose a factor \code{hosp} refers to five hospitals. A call like
\code{newgrid < add_grouping(refgrid, "envir", "hosp", c("rural", "urban", "urban", "rural", "urban"))} would add a twolevel grouping factor named \code{envir} in which the first and fourth hospitals are rural and the others are urban. Subsequently, we may use \code{lsmeans(newgrid, "envir")} to obtain the marginal means for the rural and urban environments.

If \code{newlevs} is specified as a factor, the user can use its \code{levels} attribute to control the order in which levels are presented. Otherwise, it will be alphabetical.
}
\value{A \code{ref.grid} object with the factor \code{newname} added. It will include a nesting structure such that \code{refname} is nested in \code{newname}, and with \code{newname} added to any existing nesting that involves \code{refname}.}

\author{
Russell V. Lenth
}
\note{If \code{object} already has \code{refname} nested in some other factors, this creates a conflict and therefore it is not allowed; an error is returned.
}



\seealso{\code{\link{ref.grid}}}

\examples{
require("lsmeans")

fiber.lm < lm(strength ~ diameter + machine, data = fiber)
frg < ref.grid(fiber.lm)

## Suppose the machines are of two types
gfrg < add_grouping(frg, newname = "type", refname = "machine",
 newlevs = c("computerized", "computerized", "manual"))
gfrg

lsmeans(gfrg, "type", contr = "pairwise")

}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ models }% use one of RShowDoc("KEYWORDS")
diff pruN 2.27623/man/lsmeanspackage.Rd 2.3001/man/lsmeanspackage.Rd
 2.27623/man/lsmeanspackage.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/lsmeanspackage.Rd 20181026 19:41:36.000000000 +0000
@@ 10,58 +10,9 @@ Leastsquares means
\description{
This package provides methods for obtaining socalled leastsquares means for factor combinations in a variety of fitted linear models. It can also compute contrasts or linear combinations of these leastsquares means, (several standard contrast families are provided), and in addition can estimate and contrast slopes of trend lines.
Popular adjustments for multiplecomparisons are provided, as well as graphical ways of displaying the results.
}

\section{Overview}{
\describe{
\item{Concept}{
Leastsquares means (see Searle \emph{et al.} 1980, who prefer the term \dQuote{predicted marginal means} (PMM)) are popular for summarizing linear models that include factors. For balanced experimental designs, they are just the marginal means. For unbalanced data, they in essence estimate what you \emph{would} have observed that the data arisen from a balanced experiment.
}
\item{Reference grids}{
The implementation in \pkg{lsmeans} relies on our own concept of a \emph{reference grid}, which is an array of factor and predictor levels.
Predictions are made on this grid, and leastsquares means are defined as averages of these predictions over zero or more dimensions of the grid. The function \code{\link{ref.grid}} explicitly creates a reference grid (\code{ref.grid} object) that can subsequently be used to obtain leastsquares means. The \code{\link{update}} method is used to change its properties.

Our referencegrid framework expands slightly upon Searle \emph{et al.}'s definitions of PMMs, in that it is possible to include multiple levels of covariates in the grid.
}
\item{Models supported}{
Many linear models are supported by the package, including \code{lm}, \code{glm}, \code{aovList}, and \code{mlm} in the \pkg{stats} package, as well as fittedmodel objects from several contributed packages including \pkg{nlme}, \pkg{lme4}, \pkg{survival}, and \pkg{geepack}. The help page for \code{\link{models}} provides more details, including, in some cases, additional \code{ref.grid} arguments that might affect the subsequent analysis. Also, some models require other packages be installed in order to obtain all the available features.
}
\item{Leastsquares means}{
The \code{\link{lsmeans}} function computes leastsquares means given a \code{ref.grid} object or a fitted model, and a specification indicating what factors to include. The \code{\link{lstrends}} function creates the same sort of results for estimating and comparing slopes of fitted lines. Both return an \code{lsmobj} object very much like a reference grid, but with possibly fewer factors involved.
}
\item{Summaries and analysis}{
The \code{\link{summary}} method may be used to display a \code{ref.grid} or an \code{lsmobj}. Specialpurpose summaries are available via \code{\link{confint}} and \code{\link{test}}, the latter of which can also do a joint test of several estimates. The user may specify by variables, multiplicityadjustment methods, confidence levels, etc., and if a transformation or link function is involved, may reversetransform the results to the response scale.
}
\item{Contrasts and comparisons}{
The \code{\link{contrast}} method is used to obtain contrasts among the estimates; several standard contrast families are available such as deviations from the mean, polynomial contrasts, and comparisons with one or more controls. Another \code{lsmobj} object is returned, which can be summarized or further analyzed. For convenience, a \code{pairs} method is provided for the case of pairwise comparisons. Related to this is the \code{\link{cld}} method, which provides a compact letter display for grouping pairs of means that are not significantly different. \code{cld} requires the \pkg{multcompView} package.
}
\item{Graphs}{The \code{\link[=plot.lsmobj]{plot}} method will display sidebyside confidence intervals for the estimates, and/or \sQuote{comparison arrows} whereby the significance of pairwise differences can be judged by how much they overlap. The \code{\link{lsmip}} function displays estimates like an interaction plot, multipaneled if there are by variables. These graphics capabilities require the \pkg{lattice} package be installed.
}
\item{\pkg{multcomp} interface}{
The \code{\link{as.glht}} function and \code{\link{glht}} method for \code{lsmobj}s provide an interface to the \code{\link[multcomp]{glht}} function in the \pkg{multcomp} package, thus providing for more exacting simultaneous estimation or testing. The package also provides an \code{\link{lsm}} method that works as an alternative to \code{\link[multcomp]{mcp}} in a call to \code{glht}.
}
}}% overview

\section{Additional information}{
Examples and discussion are available via \code{vignette("usinglsmeans", package="lsmeans")}.

Some features of the \pkg{lsmeans} require (or are enhanced by) additional packages that are loaded when needed. Since they are not \dQuote{required} packages, they are not automatically installed with \pkg{lsmeans}. We highly recommend that users also install the following packages: \pkg{multcomp} (if \code{\link{cld}}, \code{\link{glht}}, or \code{\link{as.glht}} are to be used), \pkg{multcompView} (for \code{\link{cld}}), \pkg{lattice} (for \code{\link{plot}} and \code{\link{lsmip}}), and \pkg{lmerTest} or \pkg{pbkrtest} (for models fitted by the \pkg{lme4} package).

Starting with \pkg{lsmeans} version 2, a new object framework based on \emph{reference grids} is used that increases flexibility and provides for extending its capabilities to additional model objects. Use \code{vignette("lsmeanschanges")} for information on the user impact of these changes.

It is possible to write your own interfaces for models not yet supported by \pkg{lsmeans}. See the help page \code{\link{extendinglsmeans}} and \code{vignette("extending")} for details on how to do this.
} % add'l information



\details{
\tabular{ll}{
Package: \tab lsmeans\cr
Type: \tab Package\cr
License: \tab GPL2\cr
Other information: \tab See DESCRIPTION\cr
}
+Almost the entire codebase for \pkg{lsmeans} now resides in the \pkg{emmeans} package
+(named for the more general term, \dQuote{estimated marginal means}). \pkg{lsmeans} exists only as a transitional entity for the few remaining packages that depend on it.
}
\references{
diff pruN 2.27623/man/lsmeans.Rd 2.3001/man/lsmeans.Rd
 2.27623/man/lsmeans.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/lsmeans.Rd 19700101 00:00:00.000000000 +0000
@@ 1,246 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{lsmeans}
\alias{lsmeans}
\alias{lsmeans.formula}
\alias{lsmeans.list}
\alias{lsmeans.character}
\alias{lsmeans.character.ref.grid}
\alias{lstrends}
\alias{lsmobj}
\alias{pmmeans}
\alias{pmtrends}
\alias{pmmobj}

\title{Leastsquares means (or predicted marginal means)}
\description{
Compute leastsquares means (predicted marginal means) for specified factors or factor combinations in a linear model,
and optionally comparisons or contrasts among them.
}
\usage{
\method{lsmeans}{character}(object, specs, ...)
## (used when 'specs' is 'character')

\method{lsmeans}{character.ref.grid}(object, specs, by = NULL,
 fac.reduce = function(coefs) apply(coefs, 2, mean), contr,
 options = getOption("lsmeans")$lsmeans, weights, trend, ...)
## (used when 'object' is a 'ref.grid' and 'specs' is 'character')

\method{lsmeans}{list}(object, specs, ...)
## (used when 'specs' is a 'list')

\method{lsmeans}{formula}(object, specs, contr.list, trend, ...)
## (used when 'specs' is a 'formula')

lstrends(model, specs, var, delta.var = 0.01 * rng, data,
 transform = c("none", "response"), ...)

lsmobj(bhat, V, levels, linfct, df = NA, post.beta = matrix(NA), ...)

pmmeans(...)
pmtrends(...)
pmmobj(...)
}
\arguments{
\item{object}{
An object of class \code{ref.grid}; or a fitted model object that is supported, such as the result of a call to \code{lm} or \code{lmer}. Many fittedmodel objects are supported; see \code{link{models}} for details.}
\item{specs}{
A \code{character} vector specifying the names of the predictors over which LSmeans are desired. \code{specs} may also be a \code{formula} or a \code{list} (optionally named) of valid \code{spec}s. Use of formulas is described in the Details section below.}
\item{by}{
A character vector specifying the names of predictors to condition on.}
\item{fac.reduce}{
A function that combines the rows of a matrix into a single vector. This implements the ``marginal averaging'' aspect of leastsquares means. The default is the mean of the rows. Typically if it is overridden, it would be some kind of weighted mean of the rows. If \code{fac.reduce} is nonlinear, bizarre results are likely, and LS means will not be interpretable. If the \code{weights} argument is nonmissing, \code{fac.reduce} is ignored.}
\item{contr}{
A \code{list} of contrast coefficients to apply to the leastsquares means  or the root name of an \code{.lsmc} function that returns such coefficients. In addition, \code{contr = "cld"} is an alternative way to invoke the \code{\link[lsmeans]{cld}} function. See \code{\link{contrast}} for more details on contrasts. NOTE: \code{contr} is ignored when \code{specs} is a formula.
}
\item{contr.list}{
A named \code{list} of \code{list}s of contrast coefficients, as for \code{contr}. This is used only in the formula method; see Details below.
}
\item{options}{If non\code{NULL}, a named \code{list} of arguments to pass to \code{\link{update}}, just after the object is constructed.}
\item{weights}{
Numeric vector, numeric matrix, or character string specifying weights to use in averaging predictions. If a vector, its length must equal the number of predictions to be averaged to obtain each leastsquares mean. If a matrix, each row of the matrix is used in turn, wrapping back to the first row as needed. When in doubt about what is being averaged (or how many), first call with \code{weights = "show.levels"}.)

If a string, it should partially match one of the following:
\describe{
\item{\code{"equal"}}{Use an equally weighted average.}
\item{\code{"proportional"}}{Weight in proportion to the frequencies (in the original data) of the factor combinations that are averaged over.}
\item{\code{"outer"}}{Weight in proportion to each individual factor's marginal frequencies. Thus, the weights for a combination of factors are the outer product of the onefactor margins}
\item{\code{"cells"}}{Weight according to the frequencies of the cells being averaged.}
\item{\code{"flat"}}{Give equal weight to all cells with data, and ignore empty cells.}
\item{\code{"show.levels"}}{This is a convenience feature for understanding what is being averaged over. Instead of a table of LS means, this causes the function to return a table showing the levels that are averaged over, in the order they appear.}
}
Outer weights are like the 'expected' counts in a chisquare test of independence, and will yield the same results as those obtained by proportional averaging with one factor at a time. All except \code{"cells"} uses the same set of weights for each mean. In a model where the predicted values are the cell means, cell weights will yield the raw averages of the data for the factors involved. Using \code{"flat"} is similar to \code{"cells"}, except nonempty cells are weighted equally and empty cells are ignored.

Note: If a nested structure exists (see the \code{nests} argument in \code{\link{ref.grid}}), then averaging is done separately over each nesting group; thus, these groups are potentially of different sizes. Accordingly, it is unsafe to specify numerical \code{weights}.

Note: If weights were used in fitting the model, then weight totals are used in place of frequencies in these schemes.

If \code{weights} is used, \code{fac.reduce} is ignored.
}
\item{trend}{
Including this argument is an alternative way of calling \code{lstrends} with \code{trend} as its \code{var} argument and \code{object} as its \code{model}.
}
\item{model}{
A supported model object (\emph{not} a \code{ref.grid}).
}
\item{var}{
Character giving the name of a variable with respect to which a difference quotient of the linear predictors is computed. In order for this to be useful, \code{var} should be a numeric predictor that interacts with at least one factor in \code{specs}. Then instead of computing leastsquares means, we compute and compare the slopes of the \code{var} trend over levels of the specified other predictor(s). As in leastsquares means, marginal averages are computed when some variables in the reference grid are excluded for the specification.

The user may specify some monotone function of one variable, e.g., \code{var = "log(dose)"}. If so, the chain rule is applied. Note that, in this example, if \code{model} contains \code{log(dose)} as a predictor, we will be comparing the slopes estimated by that model, whereas specifying \code{var = "dose"} would perform a transformation of those slopes.
}
\item{delta.var}{
The value of \emph{h} to use in forming the difference quotient \emph{(f(x+h)  f(x))/h}. Changing it (especially changing its sign) may be necessary to avoid numerical problems such as logs of negative numbers. The default value is 1/100 of the range of \code{var} over the dataset.
}
\item{data}{As in \code{\link{ref.grid}}, you may use this argument to supply the dataset used in fitting the model, for situations where it is not possible to reconstruct the data. Otherwise, leave it missing.}
\item{transform}{In \code{lstrends}, if \code{object} has a response transformation, then specifying \code{transform = "response"} will cause \code{lstrends} to calculate the trends after backtransforming to the response scale. This is done using the chain rule, and standard errors are estimated via the delta method. With \code{transform = "none"} (the default), the trends are calculated on the scale of the linear predictor, without backtransforming it. This argument works similarly to the \code{transform} argument in \code{\link{ref.grid}} (but without a \code{"log"} option), in that the returned object is regridded to the new scale (see also \code{\link{regrid}}).}
\item{bhat}{Numeric. Vector of regression coefficients.}
\item{V}{Square matrix. Covariance matrix of \code{bhat}}
\item{levels}{Named list or vector. Levels of factor(s) that define the estimates defined by \code{linfct}. If not a list, we assume one factor named \code{"level"}}
\item{linfct}{Matrix. Linear functions of \code{bhat} for each combination of \code{levels}}
\item{df}{Numeric or function with arguments \code{(x,dfargs)}. If a number, that is used for the degrees of freedom. If a function, it should return the degrees of freedom for \code{sum(x*bhat)}; if additional parameters are needed, include them in \code{\dots} as \code{dfargs} (not abbreviated).}
\item{post.beta}{Matrix whose columns comprise a sample from the posterior distribution of the regression coefficients (so that typically, the column averages will be \code{bhat}). A 1 x 1 matrix of \code{NA} indicates that such a sample is unavailable.}
\item{\dots}{Additional arguments passed to other methods or to \code{\link{ref.grid}}. For example, \code{vcov.} may be used to override the default covariance estimate, and some models allow additional options. Some models require \code{data} to be given explicitly. See the help pages for \code{\link{ref.grid}} and \link{models}. In addition, if the model formula contains references to variables that are not predictors, you must provide a \code{params} argument with a list of their names; see the example below for \code{Oatsq.lm}.}
}


\details{
Leastsquares means (also called predicted marginal means) are predictions from a linear model over a \emph{reference grid}, or marginal averages thereof. They have been popularized by \pkg{SAS} (SAS Institute, 2012). The \code{\link{ref.grid}} function identifies/creates the reference grid upon which \code{lsmeans} is based.

For those who prefer the term \dQuote{predicted marginal means}, courtesy wrappers \code{pmmeans}, \code{pmtrends}, and \code{pmmobj} are provided that behave identically to those that start with \code{ls}, except that estimates are relabeled accordingly (e.g., \code{lsmean} becomes \code{pmmean}).

If \code{specs} is a \code{formula}, it should be of the form \code{~ specs}, \code{~ specs  by}, \code{contr ~ specs}, or \code{contr ~ specs  by}. The formula is parsed and the variables therein are used as the arguments \code{specs}, \code{by}, and \code{contr} as indicated. The lefthand side is optional, but if specified it should be the name of a contrast family (e.g., \code{pairwise}) or of a sublist of \code{contr.list}. Operators like \code{*} or \code{:} are necessary to delineate names in the formulas, but otherwise are ignored.

In the special case where the mean (or weighted mean) of all the predictions is desired, specify \code{specs} as \code{~ 1} or \code{"1"}.

A number of standard contrast families are provided. They can be identified as functions having names ending in \code{.lsmc}  use
\preformatted{ls("package:lsmeans", pat=".lsmc")}
to list them. See the documentation for \code{\link{pairwise.lsmc}} and its siblings for details. You may write your own \code{.lsmc} function for custom contrasts.

The function \code{lsmobj} may be used to construct an object just like one returned by \code{lsmeans} from userspecified coefficients, covariance matrix, levels (or row labels), linear functions for each row, and degrees of freedom. After the object is constructed, it is \code{\link[lsmeans]{update}}ed with any additional arguments in \code{\dots}.
}

\value{
When \code{specs} is a \code{character} vector or onesided formula, an object of class \code{\link[=lsmobjclass]{lsmobj}}. A number of methods are provided for further analysis, including \code{\link[lsmeans]{summary}}, \code{\link[lsmeans]{confint}}, \code{\link[lsmeans]{test}}, \code{\link[lsmeans]{contrast}}, \code{\link[lsmeans]{pairs}}, and \code{\link[lsmeans]{cld}}.

When \code{specs} is a \code{list} or a \code{formula} having a lefthand side, the return value is an \code{lsm.list} object, which is simply a \code{list} of \code{lsmobj} objects. Methods for \code{lsm.list} objects are the same as those for \code{lsmobj}, but they apply to only one member of the list, determined by its \code{which} argument.

\bold{Side effect:} When \code{object} is a model, a reference grid is constructed and it is saved as \code{.Last.ref.grid} in the user's environment (unless this is disabled via \samp{lsm.option(save.ref.grid = FALSE)}). This makes it possible to check what reference grid was used, or to use it as the \code{object} in future \code{lsmeans} calls (and bypass reconstructing it). Similarly, \code{lstrends} also saves its reference grid (but for predicting difference quotients) as \code{.Last.ref.grid}.
}

\note{If the model formula contains variables that are not predictors (e.g., degree of a polynomial, knots for a spline, etc.), you must add a \code{params} argument to the call}

\note{While using \code{specs} as a twosided formula or a list is a convenient way to get a lot of results with minimal effort, it can also create confusion when additional arguments are provided, because not all arguments may be applied to all the results produced (see examples). Thus, the safer route is to do things incrementally.}

\note{\code{lsmeans} and its relatives can produce fatal errors or incorrect results with models containing splines (e.g., \code{\link{ns}}) and other smoothers because the required information to reconstruct their basis is not always available. A model with \code{\link{poly}} involving two or more predictors will almost always produce misleading results without any warning; but \code{poly(..., raw = TRUE)} will work correctly.}

\note{For a \code{ref.grid} or \code{lsmobj} object created in \pkg{lsmeans} version 2.10 or earlier, the information needed by the \code{weights} argument is not present; so a message is displayed and averaging is done using \code{fac.reduce}.}


\references{
SAS Institute Inc. (2012)
Online documentation; Shared concepts; LSMEANS statement,
\url{http://support.sas.com/documentation/cdl/en/statug/63962/HTML/default/viewer.htm#statug_introcom_a0000003362.htm}, accessed August 15, 2012.
}

\author{
Russell V. Lenth
}

\seealso{
\code{\link{ref.grid}}, \code{\link{.Last.ref.grid}}, \code{\link{models}}, \code{\link{pairwise.lsmc}}, \code{\link[multcomp]{glht}}, \code{\link{lsm.options}}
}

\examples{
require(lsmeans)

### Covariance example (from Montgomery Design (8th ed.), p.656)
# Uses supplied dataset 'fiber'
fiber.lm < lm(strength ~ diameter + machine, data = fiber)

# adjusted means and comparisons, treating machine C as control
( fiber.lsm < lsmeans (fiber.lm, "machine") )
contrast(fiber.lsm, "trt.vs.ctrlk")
# Or get both at once using
# lsmeans (fiber.lm, "machine", contr = "trt.vs.ctrlk")


### Factorial experiment
warp.lm < lm(breaks ~ wool * tension, data = warpbreaks)
( warp.lsm < lsmeans (warp.lm, ~ wool  tension,
 options = list(estName = "pred.breaks")) )
pairs(warp.lsm) # remembers 'by' structure
contrast(warp.lsm, method = "poly", by = "wool")


### Unbalanced splitplot example ###
# The imbalance is imposed deliberately to illustrate that
# the variance estimates become biased
require(nlme)
Oats.lme < lme(yield ~ factor(nitro) + Variety,
 random = ~1  Block/Variety,
 subset = c(1,2,3,5,8,13,21,34,55), data = Oats)
(Oats.anal < lsmeans(Oats.lme, list(poly ~ nitro, pairwise ~ Variety)))


### Issues with lists of specs
test(Oats.anal) # Uses 1st element by default
confint(Oats.anal, which = 4) # or confint(Oats.anal[[4]])

# Using 'pmmeans' wrapper ...
pmmeans(warp.lm, ~ wool,
 options = list(infer = c(TRUE, TRUE), null = 22, side = ">"))

### Weights
# See what's being averaged over in the above
lsmeans(Oats.lme, ~ nitro, cov.reduce = FALSE, weights = "show.levels")

# Give three times the weight to Marvellous
lsmeans(Oats.lme, ~ nitro, cov.reduce = FALSE, weights = c(1,3,1))

# Overall mean
lsmeans(Oats.lme, ~ 1, weights = "equal")
lsmeans(Oats.lme, "1", weights = "cells")


### Model with a quadratic trend for 'nitro'
# Also illustrates use of `params` argument to list nonpredictors
deg = 2
Oatsq.lm < lm(yield ~ Block + poly(nitro, deg) + Variety, data = Oats)
# Predictions at each unique 'nitro' value in the dataset
lsmeans(Oatsq.lm, ~ nitro, cov.reduce = FALSE, params = "deg")


### Trends
fiber.lm < lm(strength ~ diameter*machine, data=fiber)
# Obtain slopes for each machine ...
( fiber.lst < lstrends(fiber.lm, "machine", var="diameter") )
# ... and pairwise comparisons thereof
pairs(fiber.lst)

# Suppose we want trends relative to sqrt(diameter)...
lstrends(fiber.lm, ~ machine  diameter, var = "sqrt(diameter)",
 at = list(diameter = c(20,30)))

# Given summary statistics for 4 cities computed elsewhere,
# obtain multiple comparisons of their means using the
# Satterthwaite method
ybar < c(47.6, 53.2, 88.9, 69.8)
s < c(12.1, 19.5, 22.8, 13.2)
n < c(44, 11, 37, 24)
se2 = s^2 / n
Satt.df < function(x, dfargs)
 sum(x * dfargs$v)^2 / sum((x * dfargs$v)^2 / (dfargs$n  1))
city.pmm < pmmobj(bhat = ybar, V = diag(se2),
 levels = list(city = LETTERS[1:4]), linfct = diag(c(1,1,1,1)),
 df = Satt.df, dfargs = list(v = se2, n = n), estName = "mean")
city.pmm
contrast(city.pmm, "revpairwise")


# See also many other examples in documentation for
# 'contrast', 'cld', 'glht', 'lsmip', 'ref.grid', 'MOats',
# 'nutrition', etc., and in the vignettes
}
\keyword{ models }
\keyword{ regression }
\keyword{ htest }
diff pruN 2.27623/man/lsmip.Rd 2.3001/man/lsmip.Rd
 2.27623/man/lsmip.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/lsmip.Rd 19700101 00:00:00.000000000 +0000
@@ 1,97 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{lsmip}
\alias{lsmip}
\alias{lsmip.default}
\alias{pmmip}

\title{
Leastsquares (predicted marginal) means interaction plot
}
\description{
This function creates an interaction plot of the leastsquares means based on a fitted model and a simple formula specification.
}
\usage{
\method{lsmip}{default}(object, formula, type,
 pch = c(1,2,6,7,9,10,15:20),
 lty = 1, col = NULL, plotit = TRUE, ...)

pmmip(...)
}
% maybe also 'usage' for other objects documented here.
\arguments{
 \item{object}{
An object of class \code{lsmobj}, or a fitted model of a class supported by \code{\link{lsmeans}}.
}
 \item{formula}{
Formula of the form \code{trace.factors ~ x.factors  by.factors}. The leastsquares means are plotted against \code{x.factor} for each level of \code{trace.factors}. \code{by.factors} is optional, but if present, it determines separate panels. Each element of this formula may be a single factor in the model, or a combination of factors using the \code{*} operator.
}
\item{type}{
As in \code{\link[=predict.ref.grid]{predict}}, this determines whether we want to inversetransform the predictions (\samp{type="response"}) or not (any other choice). The default is \code{"link"}, unless the \code{"predict.type"} option is in force; see \code{\link{lsm.options}}.
}
 \item{pch}{
The plotting characters to use for each group (i.e., levels of \code{trace.factors}). They are recycled as needed.
}
 \item{lty}{
The line types to use for each group. Recycled as needed.
}
 \item{col}{
The colors to use for each group, recycled as needed. If not specified,
the default trellis colors are used.
}
 \item{plotit}{
If \code{TRUE}, the plot is displayed. Otherwise, one may use the \code{"lattice"} attribute of the returned object and print it, perhaps after additional manipulation.
}
 \item{\dots}{
Additional arguments passed to \code{\link{lsmeans}} or to \code{\link[lattice]{xyplot}}.
}
}
\details{
If \code{object} is a fitted model, \code{\link{lsmeans}} is called with an appropriate specification to obtain leastsquares means for each combination of the factors present in \code{formula} (in addition, any arguments in \code{\dots} that match \code{at}, \code{trend}, \code{cov.reduce}, or \code{fac.reduce} are passed to \code{lsmeans}).
Otherwise, if \code{object} is an \code{lsmobj} object, its first element is used, and it must contain one \code{lsmean} value for each combination of the factors present in \code{formula}.

The wrapper \code{pmmip} is provided for those who prefer the term \sQuote{predicted marginal means}.
}
\value{
(Invisibly), a \code{\link{data.frame}} with the table of leastsquares means that were plotted, with an additional \code{"lattice"} attribute containing the \code{trellis} object for the plot.
}
\author{
Russell V. Lenth
}
\note{
This function uses the \code{\link[lattice]{xyplot}} function in the \code{lattice} package (an error is returned if \code{lattice} is not installed). Conceptually, it is equivalent to \code{\link{interaction.plot}} where the summarization function is the leastsquares means.
}

\seealso{
\code{\link{interaction.plot}}
}
\examples{
require(lsmeans)
require(lattice)

# Twofactor example
warp.lm < lm(breaks ~ wool * tension, data = warpbreaks)

# Following plot is the same as the usual interaction plot of the data
lsmip(warp.lm, wool ~ tension)

# Threefactor example
noise.lm = lm(noise ~ size * type * side, data = auto.noise)

# Separate interaction plots of size by type, for each side
lsmip(noise.lm, type ~ size  side)

# One interaction plot, using combinations of size and side as the x factor
lsmip(noise.lm, type ~ side * size)

# One interaction plot using combinations of type and side as the trace factor
# customize the colors, line types, and symbols to suggest these combinations
lsmip(noise.lm, type * side ~ size, lty=1:2, col=1:2, pch=c(1,1,2,2))

# 3way interaction is significant, but doesn't make a lot of visual difference...
noise.lm2 = update(noise.lm, . ~ .  size:type:side)
lsmip(noise.lm2, type * side ~ size, lty=1:2, col=1:2, pch=c(1,1,2,2))
}

\keyword{ models }
\keyword{ regression }
diff pruN 2.27623/man/make.tran.Rd 2.3001/man/make.tran.Rd
 2.27623/man/make.tran.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/make.tran.Rd 19700101 00:00:00.000000000 +0000
@@ 1,81 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{make.tran}
\alias{make.tran}

\title{
Response transformations
}
\description{
Create the needed information to perform transformations of the response variable, including inverting the transformation and estimating variances of backtransformed predictions via the delta method. \code{make.tran} is similar to \code{\link{make.link}}, but it covers additional transformations. The result can be used as an environment in which the model is fitted, or as the \code{tran} argument in \code{\link{update.ref.grid}} (when the given transformation was already applied in an existing model).
}
\usage{
make.tran(type = c("genlog", "power", "boxcox", "sympower", "asin.sqrt"), param = 1)

# See Details for additional autodetected transformations
}
% maybe also 'usage' for other objects documented here.
\arguments{
 \item{type}{
The name of the transformation. See Details.
}
 \item{param}{
Numeric parameter for the transformation. Optionally, it may be a vector of two numeric values; the second element specifies an alternative base or origin for certain transformations. See Details.
}
}
\details{
The functions \code{\link{lsmeans}}, \code{\link{ref.grid}}, and related ones automatically detect response transformations that are recognized by examining the model formula. These are \code{log}, \code{log2}, \code{log10}, \code{sqrt}, \code{logit}, \code{probit}, \code{cauchit}, \code{cloglog}; as well as (for a response variable \code{y}) \code{asin(sqrt(y))}, \code{asinh(sqrt(y))}, and \code{sqrt(y) + sqrt(y+1)}. In addition, any constant multiple of these (e.g., \code{2*sqrt(y)}) is autodetected and appropriately scaled (see also the \code{tran.mult} argument in \code{\link{update.ref.grid}}).

A few additional character strings may be supplied as the \code{tran} argument in \code{\link{update.ref.grid}}: \code{"identity"}, \code{"1/mu^2"}, \code{"inverse"}, \code{"reciprocal"}, \code{"asin.sqrt"}, and \code{"asinh.sqrt"}.

More general transformations may be provided as a list of functions and supplied as the \code{tran} argument as documented in \code{\link{update.ref.grid}}. The \code{make.tran} function returns a suitable list of functions for several popular transformations. Besides being usable with \code{update}, the user may use this list as an enclosing environment in fitting the model itself, in which case the transformation is autodetected when the special name \code{linkfun} (the transformation itself) is used as the response transformation in the call. See the examples below.

Most of the transformations available in "make.tran" require a parameter, specified in \code{param}; we use \eqn{p} to denote this parameter, and \eqn{y} to denote the response variable, in subsequent expressions.
The \code{type} argument specifies the following transformations:
\describe{
\item{\code{"genlog"}}{Generalized logarithmic transformation: \eqn{log(y + p)}, where \eqn{y > p}}
\item{\code{"power"}}{Power transformation: \eqn{y^p}, where \eqn{y > 0}. When \eqn{p = 0}, \code{"log"} is used instead}
\item{\code{"boxcox"}}{The BoxCox transformation (unscaled by the geometric mean): \eqn{(y^p  1) / p}, where \eqn{y > 0}. When \eqn{p = 0}, \eqn{log(y)} is used.}
\item{\code{"sympower"}}{A symmetrized power transformation on the whole real line:
\eqn{abs(y)^p * sign(y)}. There are no restrictions on \eqn{y}, but we require \eqn{p > 0} in order for the transformation to be monotone and continuous.}
\item{\code{"asin.sqrt"}}{Arcsinsquareroot transformation: \eqn{sin^(1)(y/p)^{1/2)}. Typically, the parameter \eqn{p} is equal to 1 for a fraction, or 100 for a percentage.}
}
The user may include a second element in \code{param} to specify an alternative origin (other than zero) for the \code{"power"}, \code{"boxcox"}, or \code{"sympower"} transformations. For example, \samp{type = "power", param = c(1.5, 4)} specifies the transformation \eqn{(y  4)^1.5}.
In the \code{"genpower"} transformation, a second \code{param} element may be used to specify a base other than the default natural logarithm. For example, \samp{type = "genlog", param = c(.5, 10)} specifies the \eqn{log10(y + .5)} transformation.

For purposes of backtransformation, the \samp{sqrt(y) + sqrt(y+1)} transformation is treated exactly the same way as \samp{2*sqrt(y)}, because both are regarded as estimates of \eqn{2\sqrt\mu}.
}} % end of \details

\value{
A \code{list} having at least the same elements as that returned by \code{\link{make.link}}. The \code{linkfun} component is the transformation itself.
}
%%%\references{}
\author{
Russell V. Lenth
}
\note{
We modify certain \code{\link{make.link}} results in transformations where there is a restriction on valid prediction values, so that reasonable inverse predictions are obtained for no matter what. For example, if a \code{sqrt} transformation was used but a predicted value is negative, the inverse transformation is zero rather than the square of the prediction. A side effect of this is that it is possible for one or both confidence limits, or even a standard error, to be zero.
}

\seealso{
 \code{\link{make.link}}, \code{\link[lsmeans]{update}}
}
\examples{
require("lsmeans")

# Fit a model using an oddball transformation:
bctran < make.tran("boxcox", 0.368)
warp.bc < with(bctran,
 lm(linkfun(breaks) ~ wool * tension, data = warpbreaks))
# Obtain backtransformed LS means:
lsmeans(warp.bc, ~ tension  wool, type = "response")

\dontrun{
# An existing model 'mod' was fitted with a log(y + 1) transformation...
mod.rg < update(ref.grid(mod), tran = make.tran("genlog", 1))
lsmeans(mod.rg, "treatment")
}
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ models }
diff pruN 2.27623/man/MOats.Rd 2.3001/man/MOats.Rd
 2.27623/man/MOats.Rd 20170930 17:46:30.000000000 +0000
+++ 2.3001/man/MOats.Rd 19700101 00:00:00.000000000 +0000
@@ 1,39 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{MOats}
\alias{MOats}
\docType{data}
\title{
Oats data in multivariate form
}
\description{
This is the \code{Oats} dataset provided in the \pkg{nlme} package,
but it is rearranged as one multivariate observation per plot.
}
\usage{data(MOats)}
\format{
 A data frame with 18 observations on the following 3 variables.
 \describe{
 \item{\code{Variety}}{a factor with levels \code{Golden Rain}, \code{Marvellous}, \code{Victory}}
 \item{\code{Block}}{an ordered factor with levels \code{VI} < \code{V} < \code{III} < \code{IV} < \code{II} < \code{I}}
 \item{\code{yield}}{a matrix with 4 columns, giving the yields with nitrogen concentrations of 0, .2, .4, and .6.}
 }
}
\details{
These data arise from a splitplot experiment reported by Yates (1935) and used as an example in Pinheiro and Bates (2000) and other texts. Six blocks were divided into three whole plots, randomly assigned to the three varieties of oats. The whole plots were each divided into 4 split plots and randomized to the four concentrations of nitrogen.
}
\source{
The dataset \code{\link[nlme]{Oats}} in the \pkg{nlme} package.
}
\references{
Pinheiro, J. C. and Bates D. M. (2000) \emph{MixedEffects Models in S and SPLUS}, Springer, New York. (Appendix A.15)

Yates, F. (1935) Complex experiments, \emph{Journal of the Royal Statistical Society} Suppl. 2, 181247
}
\examples{
require(lsmeans)
MOats.lm < lm (yield ~ Block + Variety, data = MOats)
MOats.rg < ref.grid (MOats.lm, mult.name = "nitro")
lsmeans(MOats.rg, ~ nitro  Variety)
}
\keyword{datasets}
diff pruN 2.27623/man/models.Rd 2.3001/man/models.Rd
 2.27623/man/models.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/models.Rd 19700101 00:00:00.000000000 +0000
@@ 1,213 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{models}
\alias{models}

\title{Models supported in \pkg{lsmeans}}

\description{
Here we document what model objects may be used with \pkg{lsmeans}, and some special features of some of them. We start with those in the \pkg{stats} package; the other packages follow in alphabetical order.

Certain objects are affected by optional arguments to functions that construct \code{ref.grid} or \code{lsmobj} objects, including \code{\link{ref.grid}}, \code{\link{lsmeans}}, \code{\link{lstrends}}, and \code{\link{lsmip}}. When \dQuote{arguments} are mentioned in the subsequent objectbyobject documentation, we are talking about arguments in these constructors.

Additional models can be supported by writing appropriate \code{recover.data} and \code{lsm.basis} methods. See \code{\link{extendinglsmeans}} and \code{vignette("extending")} for details.
}


\section{\pkg{stats} package}{
 \describe{
 \item{lm, aov, glm}{No extended features. Note that the \code{lm} support often extends to a number of model objects that inherit from it, such as \code{rlm} in the \pkg{MASS} package and \code{rsm} in the \pkg{rsm} package.}
 \item{mlm, maov, manova}{When there is a multivariate response, the different responses are treated as if they were levels of a factor  named \code{rep.meas} by default. The \code{mult.name} argument may be used to change this name. The \code{mult.levs} argument may specify a named list of one or more sets of levels. If this has more than one element, then the multivariate levels are expressed as combinations of the named factor levels via the function \code{\link{expand.grid}}.}
 \item{aovlist}{Support for these objects is limited. To avoid strong biases in the predictions, the \code{contrasts} attribute of all factors should be of a type that sums to zero  for example, \code{"contr.sum"}, \code{"contr.poly"}, or \code{"contr.helmert"} but \emph{not} \code{"contr.treatment"}. Only intrablock estimates of covariances are used. That is, if a factor appears in more than one error stratum, only the covariance structure from its lowest stratum is used in estimating standard errors. Degrees of freedom are obtained using the Satterthwaite method. In general, \code{aovList} support is best with balanced designs, and due caution in the use of contrasts. If a \code{vcov.} argument is supplied, it must yield a single covariance matrix for the unique fixed effects, and the degrees of freedom are set to \code{NA}.}
}} %stats


%%% !!! ALPHABETICAL FROM HERE !!!

\section{\pkg{afex} package}{
\describe{
\item{mixed}{Support for \code{mixed} objects has been removed. Version 0.14 and later of \pkg{afex} provides new object classes with their own \pkg{lsmeans} support.}}}
% afex
%%%Support for the \code{full.model} element of these objects is the same as that for \code{merMod} in the \pkg{lme4} package  see below. However, for \pkg{afex} versions 0.10113 and earlier, the \code{data} argument is required in calls to \code{lsmeans} or \code{ref.grid}, as the information about the original dataset is not preserved in the object.}


\section{\pkg{betareg} package}{
\describe{
\item{betareg}{The additional \code{mode} argument has possible values of \code{"response"}, \code{"link"}, \code{"precision"}, \code{"phi.link"}, \code{"variance"}, and \code{"quantile"}, which have the same meaning as the \code{type} argument in \code{predict.betareg}  with the addition that \code{"phi.link"} is like \code{"link"}, but for the precision portion of the model. When \code{mode = "quantile"} is specified, the additional argument \code{quantile} (a numeric scalar or vector) specifies which quantile(s) to compute; the default is 0.5 (the median). Also in \code{"quantile"} mode, an additional variable \code{quantile} is added to the reference grid, and its levels are the values supplied.
}
}}% betareg


\section{\pkg{CARBayes} package}{
\describe{
\item{carbayes}{The user \emph{must} supply (via the \code{data} argument) the dataset used in fitting the model. As with other MCMCbased objects, the summaries and such are frequentist, but the \code{as.mcmc} method provides a posterior sample of the desired quantities.}
}}% CARBayes


\section{\pkg{coxme} package}{
\describe{
\item{coxme}{No additional options. Support for these models is experimental; may throw errors or incorrect results.}
}}% coxme


\section{\pkg{gam} package}{
\describe{
\item{gam}{Currently, \code{gam} objects are not supported. Past versions of \pkg{lsmeans} appeared to support \code{gam} models owing to inheritance from \code{lm}, but the results were incorrect because spline features were ignored. We now explicitly trap \code{gam} objects to avoid these misleading analyses.}
}}% coxme


\section{\pkg{gee} and \pkg{geepack} packages}{
These models all have more than one covariance estimate available, and it may be selected by supplying a string as the \code{vcov.method} argument. It is partially matched with the available choices; thus, for example, \samp{vcov = "n"} translates to \samp{vcov.method = "naive"}
\describe{
\item{gee}{Available covariance estimates are specified in \code{vcov.method} as \code{"robust"} (the default) and \code{"naive"}.}
\item{geeglm, geese}{Available covariance estimates are specified in \code{vcov.method} as \code{"vbeta"} (the default), \code{"vbeta.naiv"}, \code{"vbeta.j1s"}, or \code{"vbeta.fij"}. The aliases \code{"robust"} (for \code{"vbeta"}) and \code{"naive"} (for \code{"vbeta.naiv"} are also accepted.}
}
If a matrix or function is supplied as \code{vcov.method}, it is interpreted as a \code{vcov.} specification as described for \code{...} in \code{\link{ref.grid}}.
}% geepack


\section{\pkg{glmmADMB} package}{
\describe{
\item{glmmadmb}{No extended features.}
}}% glmmadmb



\section{\pkg{lme4} package}{
\describe{
\item{lmerMod}{There is an optional \code{mode} argument that defaults to \code{get.lsm.option("lmer.df")} (which in turn defaults to \code{"satterthwaite"}). The possible values are "satterthwaite", "kenwardroger", and "asymptotic" (these are partially matched and caseinsensitive). With \code{"satterthwaite"}, d.f. are obtained using code from the \pkg{lmerTest} package, if installed. With \code{"kenwardroger"}, d.f. are obtained using code from the \pkg{pbkrtest} package, if installed. With \code{"asymptotic"}, or if the needed package is not installed, d.f. are set to \code{NA}.

A byproduct of the KenwardRoger method is that the covariance matrix is adjusted using \code{\link[pbkrtest]{vcovAdj}}. This can require considerable computation; so to avoid that overhead, the user should opt for the Satterthwaite or asymptotic method; or, for backward compatibility, may disable the use of \pkg{pbkrtest} via \samp{lsm.options(disable.pbkrtest=TRUE)} (this does not disable the \pkg{pbkrtest} package entirely, just its use in \pkg{lsmeans}). The computation time required depends roughly on the number of observations, \emph{N}, in the design matrix (because a major part of the computation involves inverting an \emph{N x N} matrix). Thus, \pkg{pbkrtest} is automatically disabled if \emph{N} exceeds the value of \code{get.lsm.option("pbkrtest.limit")}. If desired, the user may use \code{lsm.options} to adjust this limit from the default of 3000.

The \code{df} argument may be used to specify some other degrees of freedom. Note that if \code{df} and \code{method = "satterthwaite"} are both specified, the covariance matrix is adjusted but the KR degrees of freedom are not used.
}
\item{glmerMod}{No degrees of freedom are available for these objects, so tests and confidence intervals are asymptotic.}
}}% lme4

\section{\pkg{lme4.0} package}{
\describe{
\item{mer}{Only asymptotic results are available (no d.f.).}
}}% lme4.0

\section{\pkg{MASS} package}{
\describe{
\item{glmmPQL}{Supported by virtue of inheritance from \code{lme} in the \pkg{nlme} package.}
\item{glm.nb}{Supported by virtue of inheritance from \code{glm}.}
\item{polr}{There are two optional arguments: \code{mode} and \code{rescale} (which defaults to \samp{c(0,1)}). For details, see the documentation below regarding the support for the \pkg{ordinal} package, which produces comparable objects (but since \code{polr} does not support scale models, \code{mode="scale"} is not supported).
Tests and confidence intervals are asymptotic.}
\item{rlm}{Supported by virtue of inheritance from \code{lm}.}
}}% MASS

%\section{\pkg{mgcv} package}{
%\describe{
%\item{gam}{Supported by virtue of inheritance from \code{glm}.}
%\item{gamm}{Not supported at this time.}
%}}% mgcv

\section{\pkg{MCMCglmm} package}{
\describe{
\item{MCMCglmm}{Currently, I have found no way to reconstruct the data based on information in the object; thus, you \emph{must} provide the dataset via the \code{data} argument. In addition, the \code{contrasts} specifications are not recoverable from the object, so the system default must match what was actually used in fitting the model. The usual \code{summary}, \code{test}, etc. methods provide frequentist analyses of the results based on the posterior means and covariances. However, an \code{as.mcmc} method is provided that creates an \code{mcmc} object that can be summarized or plotted using the \pkg{coda} package. It provides a posterior sample of lsmeans for the given reference grid, based on the posterior sample of the fixed effects from the \code{MCMCglmm} object.}
}}% MCMCglmm

\section{\pkg{MCMCpack} package (and perhaps others)}{
\describe{
\item{mcmc}{Certain linearmodel or mixedmodel objects are of class \code{mcmc}, and contain a sample from the posterior distribution of fixedeffect coefficients. In some cases (e.g., results of \code{MCMCregress} and \code{MCMCpoisson}), the object may include a \code{"call"} attribute that \code{lsmeans} can use to reconstruct the data and obtain a basis for the leastsquares means. If not, a \code{formula} and \code{data} argument are provided that may help produce the right results. In addition, the \code{contrasts} specifications are not recoverable from the object, so the system default must match what was actually used in fitting the model. As for other MCMCbased objects, the summaries and such are frequentist, but the \code{as.mcmc} method provides a posterior sample of the desired quantities.}
}}% MCMCpack


\section{\pkg{nlme} package}{
\describe{
\item{gls}{No additional features. Degrees of freedom are computed using \code{N  p} in \code{object$dims}. This is consistent with \code{nlme:::summary.gls} but seems questionable.}
\item{lme}{Degrees of freedom are obtained using a containment method, i.e., the minimum of those elements of \code{object$fixDF$X} receiving nonzero weight (but with a correction to the \code{lme} object's intercept df). (This is similar to \pkg{SAS}'s containment method, but I believe \pkg{SAS} does it incorrectly when the estimands are not contrasts.) The optional argument \code{sigmaAdjust} (defaults to \code{TRUE}) will adjust standard errors like in \code{\link[nlme]{summary.lme}} when the model is fitted using the \code{"ML"} method. \bold{Note:} \code{sigmaAdjust} is comparable to \code{adjustSigma} in \code{\link[nlme]{summary.lme}} but it is renamed to avoid conflicting with \code{adjust}.}
\item{nlme}{Support is provided for inferences on parameters named in the \code{fixed} part of the model. The user \emph{must} specify \code{param} in the call and give the name of a parameter that appears in the righthand side of a \code{fixed} formula. Degrees of freedom are obtained using the containmentlike method described above for \code{lme}.}
}}% nlme

\section{\pkg{nnet} package}{
\describe{
\item{multinom}{
The reference grid includes a pseudofactor with the same name and levels as the multinomial response. There is an optional \code{mode} argument which should match \code{"prob"} or \code{"latent"}. With \code{mode = "prob"}, the referencegrid predictions consist of the estimated multinomial probabilities. The \code{"latent"} mode returns the linear predictor, recentered so that it averages to zero over the levels of the response variable (similar to sumtozero contrasts). Thus each latent variable can be regarded as the log probability at that level minus the average log probability over all levels.

Please note that, because the probabilities sum to 1 (and the latent values sum to 0) over the multivariateresponse levels, all sensible results from \code{lsmeans} must involve that response as one of the factors. For example, if \code{resp} is a response with \eqn{k} levels, \code{lsmeans(model, ~ resp  trt)} will yield the estimated multinomial distribution for each \code{trt}; but \code{lsmeans(model, ~ trt)} will just yield the average probability of \eqn{1/k} for each \code{trt}.
}}}% nnet, multinom


\section{\pkg{ordinal} package}{
\describe{
\item{clm,clmm}{The reference grid will include all variables that appear in the main model as well as those in the \code{scale} or \code{nominal} models. There are two optional arguments: \code{mode} (a character string) and \code{rescale} (which defaults to \samp{c(0,1)}). \code{mode} should match one of \code{"latent"} (the default), \code{"linear.predictor"}, \code{"cum.prob"}, \code{"exc.prob"}, \code{"prob"}, \code{"mean.class"}, or \code{"scale"}.

With \samp{mode = "latent"}, the referencegrid predictions are made on the scale of the latent variable implied by the model. The scale and location of this latent variable are arbitrary, and may be altered via \code{rescale}. The predictions are multiplied by \samp{rescale[2]}, then \samp{rescale[1]} is added. Keep in mind that the scaling is related to the link function used in the model; for example, changing from a probit link to a logistic link will inflate the latent values by around \eqn{\pi/\sqrt{3}}{pi/sqrt(3)}, all other things being equal. \code{rescale} has no effect for other values of \code{mode}.

With \samp{mode = "linear.predictor"} \code{mode = "cum.prob"}, and \code{mode = "exc.prob"}, the boundaries between categories (i.e., thresholds) in the ordinal response are included in the reference grid as a pseudofactor named \code{cut}. The referencegrid predictions are then of the cumulative probabilities at each threshold (for \code{mode = "cum.prob"}), exceedance probabilities (one minus cumulative probabilities, for \code{mode = "exc.prob"}), or the link function thereof (for \code{mode = "linear.predictor"}).

With \code{mode = "prob"}, a pseudofactor with the same name as the model's response variable is created, and the grid predictions are of the probabilities of each class of the ordinal response. With \code{"mean.class"}, the returned results are means of the ordinal response, interpreted as a numeric value from 1 to the number of classes, using the \code{"prob"} results as the estimated probability distribution for each case.

With \code{mode = "scale"}, and the fitted object incorporates a scale model, leastsquares means are obtained for the factors in the scale model instead of the response model. The grid is constructed using only the factors in the scale model.

Any grid point that is nonestimable by either the location or the scale model (if present) is set to \code{NA}, and any LSmeans involving such a grid point will also be nonestimable. A consequence of this is that if there is a rankdeficient \code{scale} model, and then \emph{all} latent responses become nonestimable because the predictions are made using the average logscale estimate.

Tests and confidence intervals are asymptotic.}
}}% ordinal


\section{\pkg{pscl} package}{
\describe{
\item{hurdle, zeroinfl}{
Two optional arguments  \code{mode} and \code{lin.pred}  are provided. The \code{mode} argument has possible values \code{"response"} (the default), \code{"count"}, \code{"zero"}, or \code{"prob0"}. \code{lin.pred} is logical and defaults to \code{FALSE}.

With \code{lin.pred = FALSE}, the results are comparable to those returned by \code{predict(..., type = "response")}, \code{predict(..., type = "count")}, \code{predict(..., type = "zero")}, or \code{predict(..., type = "prob")[, 1]}. See the documentation for \code{\link[pscl]{predict.hurdle}} and \code{\link[pscl]{predict.zeroinfl}}.

The option \code{lin.pred = TRUE} only applies to \code{mode = "count"} and \code{mode = "zero"}. The results returned are on the linearpredictor scale, with the same transformation as the link function in that part of the model. The predictions for a reference grid with \code{mode = "count"}, \code{lin.pred = TRUE}, and \code{type = "response"} will be the same as those obtained with \code{lin.pred = FALSE} and \code{mode = "count"}; however, any LS means derived from these grids will be different, because the averaging is done on the logcount scale and the actual count scale, respectively  thereby producing geometric means versus arithmetic means of the predictions.

If the \code{vcov.} argument is used (see details in \code{\link{ref.grid}}), it must yield a matrix of the same size as would be obtained using \code{\link[pscl]{vcov.hurdle}} or \code{\link[pscl]{vcov.zeroinfl}} with its \code{model} argument set to \code{("full", "count", "zero")} in respective correspondence with \code{mode} of \code{("mean", "count", "zero")}.
If \code{vcov.} is a function, it must support the \code{model} argument.
}
}}% pscl


\section{\pkg{rms} package}{
\describe{
\item{Potential masking issue}{
Both \pkg{rms} and \pkg{lsmeans} offer \code{contrast} methods, and whichever package is loaded later masks the other. Thus, you may need to call \code{lsmeans::contrast} or \code{rms::contrast} explicitly to access the one you want.
}
\item{Objects inheriting from rms}{
Standard support is provided. However, with models having more than one intercept (e.g. from \code{orm}), a \code{mode} argument is provided that works similarly to that for the \pkg{ordinal} package. The available modes are \code{"middle"} (the default), \code{"latent"}, \code{"linear.predictor"}, \code{"cum.prob"}, \code{"exc.prob"}, \code{"prob"}, and \code{"mean.class"}. All are as described for the \pkg{ordinal} package, except as noted below.

With \code{mode = "middle"} (this is the default), the middle intercept is used, comparable to the default for \pkg{rms}'s \code{Predict} function. This is quite similar in concept to \code{mode = "latent"}, where all intercepts are averaged together.

Results for \code{mode = "linear.predictor"} are reversed from those in the \pkg{ordinal} package, because \code{orm} models predict the link function of the \emph{upper}tail (exceedance) probabilities.

With \code{mode = "prob"}, a pseudofactor is created having the same name as the model response variable, but its levels are always integers \samp{1, 2, ...} regardless of the levels of the original response.
}
}}% rms


\section{\pkg{rstanarm} package}{
\describe{
\item{stanreg}{Support for models fitted using \code{stan_xxx} is similar to that for models fitted by \code{xxx}, where supported, except that posterior samples are also available. For example, \code{stan_glm} models are treated like \code{stats::glm}, and \code{stan_polr} results are similar to those for \code{MASS::polr} (including its available \code{mode} and \code{rescale} options). Models fitted using \code{stan_biglm}, \code{stan_betareg}, and \code{stan_gamm4} are currently not supported. The user may use
\code{as.mcmc}, \code{as.mcmc.list}, or \code{as.stanfit} on the \code{ref.grid} or \code{lsmobj} produced to obtain posterior samples of LS means, contrasts, etc. }
}}% rstanarm


\section{\pkg{survival} package}{
\describe{
\item{survreg, coxph}{No extended features.}
}}% survival



%\references{}
\author{
Russell V. Lenth
}

%\note{}

%% ~Make other sections like Warning with \section{Warning }{....} ~

\seealso{
 \code{\link{ref.grid}}, \code{\link{lsm.basis}}
}

\keyword{ models }
\keyword{ regression }
\keyword{ htest }
diff pruN 2.27623/man/nutrition.Rd 2.3001/man/nutrition.Rd
 2.27623/man/nutrition.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/nutrition.Rd 19700101 00:00:00.000000000 +0000
@@ 1,45 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{nutrition}
\alias{nutrition}
\docType{data}
\title{
Nutrition data
}
\description{
This observational dataset involves three factors, but where several factor combinations are missing.
It is used as a case study in Milliken and Johnson, Chapter 17, p.202. (You may also find it in the second edition, p.278.)
}
\usage{nutrition}
\format{
 A data frame with 107 observations on the following 4 variables.
 \describe{
 \item{\code{age}}{a factor with levels \code{1}, \code{2}, \code{3}, \code{4}. Mother's age group.}
 \item{\code{group}}{a factor with levels \code{FoodStamps}, \code{NoAid}. Whether or not the family receives food stamp assistance.}
 \item{\code{race}}{a factor with levels \code{Black}, \code{Hispanic}, \code{White}. Mother's race.}
 \item{\code{gain}}{a numeric vector (the response variable). Gain score (posttest minus pretest) on knowledge of nutrition.}
 }
}
\details{
A survey was conducted by home economists ``to study how much lowersocioeconomiclevel mothers knew about nutrition and to judge the effect of a training program designed to increase their knowledge of nutrition.'' This is a messy dataset with several empty cells.
}
\source{
Milliken, G. A. and Johnson, D. E. (1984)
\emph{Analysis of Messy Data  Volume I: Designed Experiments}. Van Nostrand, ISBN 0534027137.
}

\examples{
require(lsmeans)
nutr.aov < aov(gain ~ (group + age + race)^2, data = nutrition)

# Summarize predictions for age group 3
nutr.lsm < lsmeans(nutr.aov, ~ race * group,
 at = list(age="3"))

lsmip(nutr.lsm, race ~ group)

# Hispanics seem exceptional; but, this doesn't test out due to very sparse data
cld(nutr.lsm, by = "group")
cld(nutr.lsm, by = "race")
}
\keyword{datasets}
diff pruN 2.27623/man/oranges.Rd 2.3001/man/oranges.Rd
 2.27623/man/oranges.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/oranges.Rd 19700101 00:00:00.000000000 +0000
@@ 1,41 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{oranges}
\alias{oranges}
\docType{data}
\title{
Orange sales
}
\description{
This example dataset on sales of oranges has two factors, two covariates, and two responses. There is one observation per factor combination.
}
\usage{data(oranges)}
\format{
 A data frame with 36 observations on the following 6 variables.
 \describe{
 \item{\code{store}}{a factor with levels \code{1} \code{2} \code{3} \code{4} \code{5} \code{6}. The store that was observed.}
 \item{\code{day}}{a factor with levels \code{1} \code{2} \code{3} \code{4} \code{5} \code{6}. The day the observation was taken (same for each store).}
 \item{\code{price1}}{a numeric vector. Price of variety 1.}
 \item{\code{price2}}{a numeric vector. Price of variety 2.}
 \item{\code{sales1}}{a numeric vector. Sales (per customer) of variety 1.}
 \item{\code{sales2}}{a numeric vector. Sales (per customer) of variety 2.}
 }
}
%\details{}
\source{
Download from \url{http://ftp.sas.com/samples/A56655}.
}
\references{
Littell, R., Stroup W., Freund, R. (2002) \emph{SAS For Linear Models} (4th edition). SAS Institute. ISBN 1590470230.
}
\examples{
require(lsmeans)

# Example on p.244 of Littell et al.
oranges.lm < lm(sales1 ~ price1*day, data = oranges)
lsmeans(oranges.lm, "day")

# Example on p.246
lsmeans(oranges.lm, "day", at = list(price1 = 0))
}
\keyword{datasets}
diff pruN 2.27623/man/pairwise.lsmc.Rd 2.3001/man/pairwise.lsmc.Rd
 2.27623/man/pairwise.lsmc.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/pairwise.lsmc.Rd 19700101 00:00:00.000000000 +0000
@@ 1,101 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{pairwise.lsmc}
\alias{pairwise.lsmc}
\alias{revpairwise.lsmc}
\alias{poly.lsmc}
\alias{trt.vs.ctrl.lsmc}
\alias{trt.vs.ctrl1.lsmc}
\alias{trt.vs.ctrlk.lsmc}
\alias{eff.lsmc}
\alias{del.eff.lsmc}
\alias{tukey.lsmc}
\alias{dunnett.lsmc}
\alias{consec.lsmc}
\alias{mean_chg.lsmc}

\title{
Contrast families
}
\description{
These functions return standard sets of contrast coefficients.
The name of any of these functions (with the \code{.lsmc} omitted) may be used as the \code{method} argument in \code{\link{contrast}}, or as the \code{contr} argument or lefthand side of a \code{spec} formula in \code{\link{lsmeans}}.
}
\usage{
pairwise.lsmc(levs, ...)
revpairwise.lsmc(levs, ...)
tukey.lsmc(levs, reverse = FALSE)

poly.lsmc(levs, max.degree = min(6, k  1))

trt.vs.ctrl.lsmc(levs, ref = 1)
trt.vs.ctrl1.lsmc(levs, ...)
trt.vs.ctrlk.lsmc(levs, ...)
dunnett.lsmc(levs, ref = 1)

consec.lsmc(levs, reverse = FALSE, ...)
mean_chg.lsmc(levs, reverse = FALSE, ...)

eff.lsmc(levs, ...)
del.eff.lsmc(levs, ...)
}

\arguments{
 \item{levs}{Vector of factor levels}
 \item{\dots}{Additional arguments, ignored but needed to make these functions interchangeable}
 \item{max.degree}{The maximum degree of the polynomial contrasts in \code{poly.lsmc}}
 \item{reverse}{Logical value to determine the direction of comparisons, e.g., pairwise (if \code{TRUE}) or reversepairwise (if \code{FALSE}) comparisons.}
 \item{ref}{Reference level (or control group) in \code{trt.vs.ctrl.lsmc}}
}

\details{
Each contrast family has a default multipletesting adjustment as noted below. These adjustments are often only approximate; for a more exacting adjustment, use the interfaces provided to \code{\link[multcomp]{glht}} in the \pkg{multcomp} package.

\code{pairwise.lsmc}, \code{revpairwise.lsmc}, and \code{tukey.lsmc} generate contrasts for all pairwise comparisons among leastsquares means at the levels in \code{levs}. The distinction is in which direction they are subtracted. For factor levels A, B, C, D, \code{pairwise.lsmc} generates the comparisons AB, AC, AD, BC, BD, and CD, whereas \code{revpairwise.lsmc} generates BA, CA, CB, DA, DB, and DC. \code{tukey.lsmc} invokes \code{pairwise.lsmc} or \code{revpairwise.lsmc} depending on \code{reverse}. The default multiplicity adjustment method is \code{"tukey"}, which is approximate when the standard errors differ.

\code{poly.lsmc} generates orthogonal polynomial contrasts, assuming equallyspaced factor levels. These are derived from the \code{\link{poly}} function, but an ad hoc algorithm is used to scale them to integer coefficients that are (usually) the same as in published tables of orthogonal polynomial contrasts. The default multiplicity adjustment method is \code{"none"}.

\code{trt.vs.ctrl.lsmc} and its relatives generate contrasts for comparing one level (or the average over specified levels) with each of the other levels. The argument \code{ref} should be the \emph{index}(es) (not the labels) of the reference level(s). \code{trt.vs.ctrl1.lsmc} is the same as \code{trt.vs.ctrl} with a reference value of \code{1}, and \code{trt.vs.ctrlk.lsmc} is the same as \code{trt.vs.ctrl} with a reference value of \code{length(levs)}. \code{dunnett.lsmc} is the same as \code{trt.vs.ctrl}.
The default multiplicity adjustment method is \code{"dunnettx"}, a close approximation to the Dunnett adjustment.

\code{consec.lsmc} and \code{mean_chg.lsmc} are useful for contrasting treatments that occur in sequence. For a factor with levels A, B, C, D, E, \code{consec.lsmc} generates the comparisons BA, CB, and DC, while \code{mean_chg.lsmc} generates the contrasts (B+C+D)/3  A, (C+D)/2  (A+B)/2, and D  (A+B+C)/3. With \code{reverse = TRUE}, these differences go in the opposite direction.

\code{eff.lsmc} and \code{del.eff.lsmc} generate contrasts that compare each level with the average over all levels (in \code{eff.lsmc}) or over all other levels (in \code{del.eff.lsmc}). These differ only in how they are scaled. For a set of \eqn{k} lsmeans, \code{del.eff.lsmc} gives weight \eqn{1} to one lsmean and weight \eqn{1/(k1)} to the others, while \code{eff.lsmc} gives weights \eqn{(k1)/k} and \eqn{1/k} respectively, as in subtracting the overall lsmean from each lsmean.
The default multiplicity adjustment method is \code{"fdr"}. This is a Bonferronibased method and is slightly conservative; see \code{\link{p.adjust}}
}
\value{
A \code{data.frame}, each column containing contrast coefficients for \code{levs}.
The \code{"desc"} attribute is used to label the results in \code{lsmeans},
and the \code{"adjust"} attribute gives the default adjustment method for multiplicity.
}

\author{
Russell V. Lenth
}
\note{
You may create your own contrast functions, using these as guides. A function named \code{mycontr.lsmc} may be invoked in \code{lsmeans} via, e.g., \preformatted{lsmeans(\var{object}, mycontr ~ \var{factor})}
The \code{"desc"}, \code{"adjust"}, and \code{"offset"} attributes are optional; if present, these are passed to \code{contrast}. If absent, the root name of the function is used as \code{"desc"}, and no adjustment is requested for p values. See the examples.
}


\seealso{
\code{\link{lsmeans}}, \code{\link[multcomp]{glht}}
}
\examples{
### View orthogonal polynomials for 4 levels
poly.lsmc(1:4)

### Setting up a custom contrast function
helmert.lsmc < function(levs, ...) {
 M < as.data.frame(contr.helmert(levs))
 names(M) < paste(levs[1],"vs earlier")
 attr(M, "desc") < "Helmert contrasts"
 M
}
warp.lm < lm(breaks ~ wool*tension, data = warpbreaks)
lsmeans(warp.lm, helmert ~ tension  wool)
}

\keyword{ models }
\keyword{ regression }
\keyword{ htest }
diff pruN 2.27623/man/ref.gridclass.Rd 2.3001/man/ref.gridclass.Rd
 2.27623/man/ref.gridclass.Rd 19700101 00:00:00.000000000 +0000
+++ 2.3001/man/ref.gridclass.Rd 20181026 20:17:25.000000000 +0000
@@ 0,0 +1,15 @@
+\docType{class}
+\name{ref.gridclass}
+\alias{ref.gridclass}
+\alias{lsmobjclass}
+
+\title{The \code{ref.grid} and \code{lsmobj} classes}
+
+\description{
+The codebase for \pkg{lsmeans} is now mostly in \pkg{emmeans}. These two classes
+are simple extensions of the \code{emmGrid} class defined in \pkg{emmeans},
+and are provided as support for objects created in older versions of \pkg{lsmeans}.
+For details, see \code{\link{emmGridclass}}.
+}
+
+\author{Russell V. Lenth}
diff pruN 2.27623/man/ref.grid.class.Rd 2.3001/man/ref.grid.class.Rd
 2.27623/man/ref.grid.class.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/ref.grid.class.Rd 19700101 00:00:00.000000000 +0000
@@ 1,76 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{ref.gridclass}
\Rdversion{1.1}
\docType{class}
\alias{ref.gridclass}
\alias{lsmobjclass}
\alias{lsmeans,ref.grid,charactermethod}
\alias{show,ref.gridmethod}
\alias{show,lsmobjmethod}
\alias{summary,ref.gridmethod}

\title{Classes \code{"ref.grid"} and \code{"lsmobj"}}
\description{
A reference grid encapsulates everything needed to compute leastsquares means, independently of the underlying model object. The \code{"lsmobj"} class is a minor extension of \code{"ref.grid"} where the linear predictors for the reference grid are transformed in some linear way such as marginal averages or contrasts.
}

\section{Objects from the Classes}{
Objects of class \code{"ref.grid"} are most commonly created by calling the \code{\link{ref.grid}} function.

Objects of class \code{"lsmobj"} are created by calling \code{\link{lsmeans}} or a related function such as \code{\link{contrast}}.}

\section{Slots}{
 \describe{
 \item{\code{model.info}:}{Object of class \code{"list"} containing the elements \code{call} (the call that produced the model), \code{terms} (its \code{terms} object), and \code{xlev} (factorlevel information)}
 \item{\code{roles}:}{Object of class \code{"list"} containing at least the elements \code{predictors}, \code{responses}, and \code{multresp}. These are character vectors of names of these variables.}
 \item{\code{grid}:}{Object of class \code{"data.frame"} containing the combinations of the variables that define the reference grid. In addition, there is an auxiliary column named \code{".wgt."} holding the observed frequencies or weights for each factor combination (excluding covariates). If the model has one or more \code{\link{offset}()} calls, there is an another auxiliary column named \code{".offset."}. Auxiliary columns are not considered part of the reference grid. (However, any variables included in \code{offset} calls \emph{are} in the reference grid.)}
 \item{\code{levels}:}{Object of class \code{"list"} with each entry containing the distinct levels of variables in the reference grid. Note that \code{grid} is obtained by applying the function \code{\link{expand.grid}} to this list}
 \item{\code{matlevs}:}{Object of class \code{"list"} Like \code{levels} but has the levels of any matrices in the original dataset. Matrix columns must always be reduced to a single value for purposes of the reference grid }
 \item{\code{linfct}:}{Object of class \code{"matrix"} giving the linear functions of the regression coefficients for predicting each element of the reference grid. The rows of this matrix go in onetoone correspondence with the rows of \code{grid}, and the columns with elements of \code{bhat}}
 \item{\code{bhat}:}{Object of class \code{"numeric"} with the regression coefficients. If there is a multivariate response, this must be flattened to a single vector, and \code{linfct} and \code{V} redefined appropriately. Important: \code{bhat} must \emph{include} any \code{NA} values produced by collinearity in the predictors. These are taken care of later in the estimability check.}
 \item{\code{nbasis}:}{Object of class \code{"matrix"} with the basis for the nonestimable functions of the regression coefficients. Every LS mean will correspond to a linear combination of rows of \code{linfct}, and that result must be orthogonal to all the columns of \code{nbasis} in order to be estimable. This will be \code{NULL} if everything is estimable}
 \item{\code{V}:}{Object of class \code{"matrix"}, the symmetric variancecovariance matrix of \code{bhat} }
 \item{\code{dffun, dfargs:}}{Objects of class \code{"function"} and \code{"list"} respectively. \code{dffun(k,dfargs)} should return the degrees of freedom for the linear function \code{sum(k*bhat)}, or \code{NA} if unavailable}
 \item{\code{misc}:}{A \code{list} containing additional information used by methods. These include at least the following: \code{estName} (the label for the estimates of linear functions), and the default values of \code{infer}, \code{level}, and \code{adjust} to be used in the \code{\link{summary}} method. Elements in this slot may be modified if desired using the \code{\link{update}} method.}
 \item{\code{post.beta}:}{A \code{matrix} containing a sample from the posterior distribution of the regression coefficients; or a 1 x 1 matrix of \code{NA} if this is not available. When it is nontrivial, the \code{as.mcmc} method returns \code{post.beta} times \code{t(linfct)}, which is a sample from the posterior distribution of the LS means.}
}} % end of describe and slots section

\section{Extends}{
\code{Class "lsmobj"} extends \code{Class "ref.grid"}, directly. There is hardly a difference between these classes except for how the slots \code{linfct} and \code{grid} are obtained, and their \code{show} methods.}

\section{Methods}{
 All methods for these objects are S3 methods except for \code{show}.
 \describe{
 \item{\code{show}:}{Prints the results of \code{str} for \code{ref.grid} objects, and \code{summary} for \code{lsmobj} objects.}
 \item{\code{str}:}{Displays a brief listing of the variables and levels defining the grid. }
 \item{\code{summary}:}{Displays a summary of estimates, standard errors, degrees of freedom, and optionally, tests and/or confidence intervals. }
 \item{\code{lsmeans}:}{Computes leastsquares means and creates an \code{"lsmobj"} object.}
 \item{\code{confint}:}{Confidence intervals for lsmeans.}
 \item{\code{test}:}{Hypothesis tests. }
 \item{\code{cld}:}{Compactletter display for tests of pairwise comparisons}
 \item{\code{contrast}:}{Contrasts among lsmeans. }
 \item{\code{pairs}:}{A special case of \code{contrasts} for pairwise comparisons. }
 \item{\code{update}:}{Change defaults used primarily by \code{summary}, such as transformation, pvalue adjustment, and confidence level.}
} % end of \describe
} % end of Methods section


%\references{}
\author{
Russell V. Lenth
}

%\note{}

%% ~Make other sections like Warning with \section{Warning }{....} ~

\seealso{
 \code{\link{ref.grid}}, \code{\link{lsmeans}}
}

\examples{
showClass("ref.grid")
showClass("lsmobj")
}
\keyword{classes}
diff pruN 2.27623/man/ref.grid.Rd 2.3001/man/ref.grid.Rd
 2.27623/man/ref.grid.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/ref.grid.Rd 20181101 16:24:40.000000000 +0000
@@ 1,77 +1,38 @@
% Copyright (c) 20122016 Russell V. Lenth %
+% Copyright (c) 20122018 Russell V. Lenth %
\name{ref.grid}
\alias{ref.grid}
\alias{.Last.ref.grid}
+\alias{recover.data}
+\alias{lsm.basis}
+% others needed to keep checking happy
+\alias{summary.ref.grid}
+\alias{lsmeans}
+\alias{contrast}
% handy for extra documentation...
\alias{ref.grid.object}
\alias{summary.ref.grid.object}
\title{
Create a reference grid from a fitted model
}
\description{
Using a fitted model object, determine a reference grid for which leastsquares means are defined. The resulting \code{ref.grid} object encapsulates all the information needed to calculate LS means and make inferences on them.
+These functions are provided in \pkg{lsmeans} because they have been renamed in \pkg{emmeans}
}
\usage{
ref.grid(object, at, cov.reduce = mean, mult.name, mult.levs,
 options = get.lsm.option("ref.grid"), data, df, type,
 transform = c("none", "response", "mu", "unlink", "log"),
 nesting, ...)
+ref.grid(object, ...)
.Last.ref.grid
+recover.data(object, ...)
+lsm.basis(object, ...)
}
\arguments{
 \item{object}{An object produced by a supported modelfitting function, such as \code{lm}. Many models are supported. See \code{\link{models}}.}
 \item{at}{Optional named list of levels for the corresponding variables}
 \item{cov.reduce}{A function, logical value, or formula; or a named list of these. Each covariate \emph{not specified in} \code{at} is reduced according to these specifications.

 If a single function, it is applied to each covariate.

 If logical and \code{TRUE}, \code{mean} is used. If logical and \code{FALSE}, it is equivalent to specifying \samp{function(x) sort(unique(x))}, and these values are considered part of the reference grid; thus, it is a handy alternative to specifying these same values in \code{at}.

 If a formula (which must be twosided), then a model is fitted to that formula using \code{\link{lm}}; then in the reference grid, its response variable is set to the results of \code{\link{predict}} for that model, with the reference grid as \code{newdata}. (This is done \emph{after} the reference grid is determined.) A formula is appropriate here when you think experimental conditions affect the covariate as well as the response.

 If \code{cov.reduce} is a named list, then the above criteria are used to determine what to do with covariates named in the list. (However, formula elements do not need to be named, as those names are determined from the formulas' lefthand sides.) Any unresolved covariates are reduced using \code{"mean"}.

Any \code{cov.reduce} specification for a covariate also named in \code{at} is ignored.
} % end of \item{cov.reduce}
 \item{mult.name}{Character, the name to give to the \dQuote{factor} whose levels delineate the elements of a multivariate response. If this is provided, it overrides the default name, e.g., \code{"rep.meas"} for an \code{\link[=lm]{mlm}} object or \code{"cut"} for a \code{\link[MASS]{polr}} object.}
 \item{mult.levs}{A named list of levels for the dimensions of a multivariate response. If there is more than one element, the combinations of levels are used, in \code{\link{expand.grid}} order. The (total) number of levels must match the number of dimensions. If \code{mult.name} is specified, this argument is ignored.}
 \item{options}{If non\code{NULL}, a named \code{list} of arguments to pass to \code{\link{update}}, just after the object is constructed.}
 \item{data}{A \code{data.frame} to use to obtain information about the predictors (e.g. factor levels). If missing, then \code{\link{recover.data}} is used to attempt to reconstruct the data.}
 \item{df}{This is a courtesy shortcut, equivalent to specifying \code{options(df = df)}. See \code{\link{update}}.}
 \item{type}{If provided, this is saved as the \code{"predict.type"} setting. See \code{\link{update}}}
 \item{transform}{If other than \code{"none"}, the reference grid is reconstructed via \code{\link{regrid}} with the given \code{transform} argument. See Details.}
 \item{nesting}{If the model has nested fixed effects, this may be specified here via a character vector or named \code{list} specifying the nesting structure. Specifying \code{nesting} overrides any nesting structure that is automatically detected. See Details.}
 \item{\dots}{Optional arguments passed to \code{\link{lsm.basis}}, such as \code{vcov.} (see Details below) or options for certain models (see \link{models}).}
+ \item{object}{A model object in a supported class.}
+ \item{\dots}{Additional arguments passed to companion functions in the \pkg{emmeans} package.}
} % end of \arguments
\details{The reference grid consists of combinations of independent variables over which predictions are made. Leastsquares means are defined as these predictions, or marginal averages thereof.
The grid is determined by first reconstructing the data used in fitting the model (see \code{\link{recover.data}}), or by using the \code{data.frame} provided in \code{context}. The default reference grid is determined by the observed levels of any factors, the ordered unique values of charactervalued predictors, and the results of \code{cov.reduce} for numeric predictors. These may be overridden using \code{at}.

Ability to support a particular class of \code{object} depends on the existence of \code{recover.data} and \code{lsm.basis} methods  see \link{extendinglsmeans} for details. The call \code{methods("recover.data")} will help identify these.

In certain models, (e.g., results of \code{\link[lme4]{glmer.nb}}),
it is not possible to identify the original dataset. In such cases, we can work around this by setting \code{data} equal to the dataset used in fitting the model, or a suitable subset.
Only the complete cases in \code{data} are used, so it may be necessary to exclude some unused variables.
Using \code{data} can also help save computing, especially when the dataset is large. In any case, \code{data} must represent all factor levels used in fitting the model. It \emph{cannot} be used as an alternative to \code{at}. (Note: If there is a pattern of \code{NAs} that caused one or more factor levels to be excluded when fitting the model, then \code{data} should also exclude those levels.)

By default, the variancecovariance matrix for the fixed effects is obtained from \code{object}, usually via its \code{\link{vcov}} method. However, the user may override this via a \code{vcov.} argument, specifying a matrix or a function. If a matrix, it must be square and of the same dimension and parameter order of the fixed effects. If a function, must return a suitable matrix when it is called with \code{object} as its only argument.

Nested factors: Having a nesting structure affects marginal averaging in \code{lsmeans} in that it is done separately for each level (or combination thereof) of the grouping factors. \code{ref.grid} tries to discern which factors are nested in other factors, but it is not always obvious, and if it misses some, the user must specify this structure via \code{nesting}; or later using \code{\link{update}}. \code{nesting} may be a character vector or a named \code{list}. If a \code{list}, each name should be the name of a single factor in the grid, and its entry a character vector of the name(s) of its grouping factor(s). \code{nested} may also be a character value of the form \code{"factor1 \%in\% (factor2*factor3)"}. If there is more than one such specification, they may be appended separated by commas, or as a character vector.
For example, these specifications are equivalent: \code{nesting = list(state = "country", city = c("state", "country")}, \code{nesting = "state \%in\% country, city \%in\% (state*country)"}, and \code{nesting = c("state \%in\% country)", "city \%in\% (state*country)")}.

There is a subtle difference between specifying \samp{type = "response"} and \samp{transform = "response"}. While the summary statistics for the grid itself are the same, subsequent use in \code{\link{lsmeans}} will yield different results if there is a response transformation. With \samp{type = "response"}, LS means are computed by averaging together predictions on the \emph{linearpredictor} scale and then backtransforming to the response scale; while with \samp{transform = "response"}, the predictions are already on the response scale so that the LS means will be the arithmetic means of those responsescale predictions. To add further to the possibilities, \emph{geometric} means of the responsescale predictions are obtainable via \samp{transform = "log", type = "response"}.

The most recent result of \code{ref.grid}, whether called directly or indirectly via \code{\link{lsmeans}}, \code{\link{lstrends}}, or some other function that calls one of these, is saved in the user's environment as \code{.Last.ref.grid}. This facilitates checking what reference grid was used, or reusing the same reference grid for further calculations. This automatic saving is enabled by default, but may be disabled via \samp{lsm.options(save.ref.grid = FALSE)}, and reenabled by specifying \code{TRUE}.
} %  end of details

\value{An S4 object of class \code{"ref.grid"} (see \code{\link{ref.gridclass}}). These objects encapsulate everything needed to do calculations and inferences for leastsquares means, and contain nothing that depends on the modelfitting procedure. As a side effect, the result is also saved as \code{.Last.ref.grid} (in the global environment, unless this variable is found in another position).
}
+\value{
+\pkg{lsmeans} now passes all its computations to \pkg{emmeans}, and the return values
+are thus what is returned by the corresponding functions \code{\link{ref_grid}}, \code{\link{recover_data}}, and \code{\link{emm_basis}}, respectively.
+}
%%%\references{}
@@ 81,39 +42,16 @@ Russell V. Lenth
}
%\note{}
%% ~Make other sections like Warning with \section{Warning }{....} ~

\seealso{
See also \code{\link[lsmeans]{summary}} and other methods for the returned objects. Reference grids are fundamental to \code{\link{lsmeans}}. Click here for more on the \code{\link[=ref.gridclass]{ref.grid}} class. Supported models are detailed in \code{\link{models}}.
}

\examples{
require(lsmeans)

fiber.lm < lm(strength ~ machine*diameter, data = fiber)
ref.grid(fiber.lm)
summary(ref.grid(fiber.lm))

ref.grid(fiber.lm, at = list(diameter = c(15, 25)))

\dontrun{
# We could substitute the sandwich estimator vcovHAC(fiber.lm)
# as follows:
require(sandwich)
summary(ref.grid(fiber.lm, vcov. = vcovHAC))
}

# If we thought that the machines affect the diameters
# (admittedly not plausible in this example), then we should use:
ref.grid(fiber.lm, cov.reduce = diameter~machine)

# Multivariate example
MOats.lm = lm(yield ~ Block + Variety, data = MOats)
ref.grid(MOats.lm, mult.name = "nitro")
# silly illustration of how to use 'mult.levs'
ref.grid(MOats.lm, mult.levs = list(T=LETTERS[1:2], U=letters[1:2]))
+ fiber.lm < lm(strength ~ machine + diameter, data = fiber)
+ rg < ref.grid(fiber.lm, at = list(diameter = c(20, 24, 28)))
+ rg
+
+ # Note this is an emmGrid object defined in emmeans. The old "ref.grid"
+ # class is now an extension of this:
+ r.g. < new("ref.grid", rg)
+ lsmeans(r.g., "machine")
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ regression }
\keyword{ models }% __ONLY ONE__ keyword per line
diff pruN 2.27623/man/summary.Rd 2.3001/man/summary.Rd
 2.27623/man/summary.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/summary.Rd 19700101 00:00:00.000000000 +0000
@@ 1,251 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{summary}
\alias{summary}
\alias{summary.ref.grid}
\alias{str.ref.grid}
\alias{predict.ref.grid}
\alias{print.ref.grid}
\alias{print.summary.ref.grid}
\alias{plot.lsmobj}
\alias{plot.summary.ref.grid}
\alias{vcov.ref.grid}
\alias{regrid}
\alias{rbind}
\alias{rbind.ref.grid}
\alias{as.mcmc}
\alias{as.mcmc.ref.grid}
\alias{as.mcmc.list}
\alias{as.mcmc.list.ref.grid}
\alias{as.stanfit}
\alias{[.ref.grid}
\alias{xtable.ref.grid}
\alias{xtable.summary.ref.grid}
\alias{print.xtable.lsm}


% Also NEED an '\alias' for EACH other topic documented here.
\title{
Methods for \code{ref.grid} objects
}
\description{
Use these methods to summarize, print, plot, or examine objects of class \code{"ref.grid"}. They also apply to the class \code{"lsmobj"}, which is an extension of \code{"ref.grid"}.
}
\usage{
\method{summary}{ref.grid}(object, infer, level, adjust, by, type, df,
 null, delta, side, ...)

\method{predict}{ref.grid}(object, type, ...)

\method{str}{ref.grid}(object, ...)

\method{rbind}{ref.grid}(..., deparse.level = 1, adjust = "bonferroni")

\method{[}{ref.grid}(x, i, adjust, drop.levels = TRUE, ...)

\method{print}{ref.grid}(x, ...)
\method{print}{summary.ref.grid}(x, ..., digits = NULL, quote = FALSE, right = TRUE)

\method{xtable}{ref.grid}(x, caption = NULL, label = NULL, align = NULL,
 digits = 4, display = NULL, auto = FALSE, ...)
\method{xtable}{summary.ref.grid}(x, caption = NULL, label = NULL, align = NULL,
 digits = 4, display = NULL, auto = FALSE, ...)
\method{print}{xtable.lsm}(x, type = getOption("xtable.type", "latex"),
 include.rownames = FALSE, sanitize.message.function = footnotesize,
 ...)

\method{plot}{lsmobj}(x, y, type, intervals = TRUE, comparisons = FALSE,
 alpha = 0.05, adjust = "tukey", int.adjust, ...)
\method{plot}{summary.ref.grid}(x, y, horizontal = TRUE,
 xlab, ylab, layout, ...)

\method{vcov}{ref.grid}(object, ...)

regrid (object, transform = c("response", "mu", "unlink", "log", "none"),
 inv.log.lbl = "response", predict.type)

\method{as.mcmc}{ref.grid}(x, names = TRUE, sep.chains = TRUE, ...)
\method{as.mcmc.list}{ref.grid}(x, names = TRUE, ...)

as.stanfit(object, names = TRUE, ...)
}

\arguments{
 \item{object}{
An object of class \code{"ref.grid"}.
}
 \item{infer}{
A vector of two logical values. The first determines whether confidence intervals are displayed, and the second determines whether \emph{t} tests and \emph{P} values are displayed. If only one value is provided, it is used for both.
}
 \item{level}{
Confidence level for confidence intervals, if \code{infer[1]} is \code{TRUE}.
}
 \item{adjust}{
Character value naming the method used to adjust \eqn{p} values or confidence limits; or to adjust comparison arrows in \code{plot}. See Details.
}
 \item{by}{
Character name(s) of variables to use for grouping. This affects the family of tests considered in adjusted \emph{P} values. The printed display of the summary is grouped by the \code{by} variables.
}
 \item{type}{
Type of prediction desired (except in \code{print.xtable}). This only has an effect if there is a known transformation or link function. \code{"response"} specifies that the inverse transformation be applied. \code{"mu"} (or equivalently, \code{"unlink"} is usually the same as \code{"response"}, but in the case where the model has both a link function and a response transformation, only the link part is backtransformed. Other valid values are \code{"link"}, \code{"lp"}, and \code{"linear"}; these are equivalent, and request that results be shown for the linear predictor, with no backtransformation. The default is \code{"link"}, unless the \code{"predict.type"} option is in force; see \code{\link{lsm.options}}.

Note that \code{type} is also an argument for the \code{print.xtable} method; it is passed to \code{\link[xtable]{print.xtableList}} in the \pkg{xtable} package.
}
 \item{df}{
If nonmissing a constant number of degrees of freedom to use in constructing confidence intervals and \emph{P} values (\code{NA} specifies asymptotic results).
}
 \item{null}{Null hypothesis value(s) against which estimates are tested. May be a single value used for all, or a numeric vector of length equal to the number of tests in each family (i.e., \code{by} group in the displayed table).}
 \item{delta}{Numeric value. If zero, ordinary tests of significance are performed. If positive, this specifies a threshold for testing equivalence (using the TOST or twoonesidedtest method), noninferiority, or nonsuperiority, depending on \code{side}. See Details for how the test statistics are defined.}
 \item{side}{Numeric or character value specifying whether the test is lefttailed (\code{1}, \code{""}, code{"<"}, \code{"left"}, or \code{"nonsuperiority"}); righttailed (\code{1}, \code{"+"}, \code{">"}, \code{"right"}, or \code{"noninferiority"}); or twosided (\code{0}, \code{2}, \code{"!="}, \code{"twosided"}, \code{"both"}, \code{"equivalence"}, or \code{"="}).}
 \item{deparse.level}{This argument is needed by the generic \code{rbind} method, but ignored by its \code{ref.grid} method.}
 \item{drop.levels}{Logical value to specify whether or not the \code{levels} slot should be recomputed based on a possibly reduced number of levels of factors in the grid.}
 \item{x}{
The object to be subsetted, printed, plotted, or converted.
}
 \item{y}{This argument is ignored.}
 \item{i}{Integer index(es) of which linear functions to extract.}
 \item{horizontal}{Determines orientation of plotted confidence intervals.}
 \item{intervals}{If \code{TRUE}, confidence intervals are plotted for each estimate}
 \item{comparisons}{If \code{TRUE}, \dQuote{comparison arrows} are added to the plot, in such a way that the degree to which arrows overlap reflects as much as possible the significance of the comparison of the two estimates.}
 \item{alpha}{The \code{alpha} argument to use in constructing comparison arrows.}
 \item{int.adjust}{the multiplicity adjustment method for the plotted confidence intervals; if missing, it defaults to the object's internal \code{adjust} setting (see \code{\link{update}}). (Note: the \code{adjust} argument in \code{plot} sets the adjust method for the comparison arrows, not the confidence intervals.)}
 \item{transform}{Character value. If \code{"response"} or \code{"mu"}, the inverse transformation is applied to the estimates in the grid (but if there is both a link function and a response transformation, \code{"mu"} backtransforms only the link part); if \code{"log"}, the results are formulated as if the response had been \code{log}transformed; if \code{"none"}, predictions thereof are on the same scale as in \code{object}, and any internal transformation information is preserved. For compatibility with past versions, \code{transform} may also be logical; \code{TRUE} is taken as \code{"response"}, and \code{FALSE} as \code{"none"}.}
 \item{inv.log.lbl}{Character value. This applies only when \code{transform = "log"}, and is used to label the predictions if subsequently summarized with \code{type = "response"}.}
 \item{predict.type}{Character value. If provided, the returned object is first \code{\link{update}}d with the given type, e.g., \code{"response"}.}
 \item{names}{Logical scalar or vector specifying whether variable names are appended to levels in the column labels for the \code{as.mcmc} or \code{as.mcmc.list} result  e.g., column names of \code{treat A} and \code{treat B} versus just \code{A} and \code{B}. When there is more than one variable involved, the elements of \code{names} are used cyclically.}
\item{sep.chains}{Logical value. If \code{TRUE}, and there is more than one MCMC chain available, an \code{\link[coda]{mcmc.list}} object is returned by \code{as.mcmc}, with separate lsmeans posteriors in each chain.}
\item{\dots, digits, quote, right, caption, label, align, display, auto, include.rownames, sanitize.message.function, xlab, ylab, layout}{For summaries, these are additional arguments passed to other methods including \code{\link{print.data.frame}},
\code{\link{xtableList}}, \code{\link{print.xtableList}},
\code{\link{update}}, or \code{\link{dotplot}} as appropriate. If not specified, appropriate defaults are used. For example, the default \code{layout} is one column of horizontal panels or one row of vertical panels.}
}
\details{
\bold{Defaults for summarization, etc.:}
The \code{misc} slot in \code{object} contains default values for \code{by}, \code{infer}, \code{level}, \code{adjust}, \code{type}, \code{null}, \code{side}, and \code{delta}. These defaults vary depending on the code that created the object. The \code{\link{update}} method may be used to change these defaults. In addition, any options set using \samp{lsm.options(summary=...)} will trump those stored in the object's \code{misc} slot.

\bold{Transformations and links:}
With \code{type="response"}, the transformation assumed can be found in \samp{object@misc$tran}, and its label, for the summary is in \samp{object@misc$inv.lbl}. Any \eqn{t} or \eqn{z} tests are still performed on the scale of the linear predictor, not the inversetransformed one. Similarly, confidence intervals are computed on the linearpredictor scale, then inversetransformed.

\bold{Confidencelimit and Pvalue adjustments:}
The \code{adjust} argument specifies a multiplicity adjustment for tests or confidence intervals. This adjustment always is applied \emph{separately} to each table or subtable that you see in the printed output (see the details on \code{rbind} below for how to combine tables). The valid values of \code{adjust} are as follows:
\describe{
\item{\code{"tukey"}}{Uses the Studentized range distribution with the number of means in the family. (Available for twosided cases only.)}
\item{\code{"scheffe"}}{Computes \eqn{p} values from the \eqn{F} distribution, according to the Scheffe critical value of \eqn{\sqrt{kF(k,d)}}{sqrt[k*F(k,d)]}, where \eqn{d} is the error degrees of freedom and \eqn{k} is (family size minus 1) for contrasts, and (number of estimates) otherwise. (Available for twosided cases only.)}
\item{\code{"sidak"}}{Makes adjustments as if the estimates were independent (a conservative adjustment in many cases).}
\item{\code{"bonferroni"}}{Multiplies \eqn{p} values, or divides significance levels by the number of estimates. This is a conservative adjustment.}
\item{\code{"dunnettx"}}{Uses an approximation to the Dunnett distribution for a family of estimates having pairwise correlations of \eqn{0.5} (as is true when comparing treatments with a control with equal sample sizes). The accuracy of the approximation improves with the number of simultaneous estimates, and is much faster than \code{"mvt"}. (Available for twosided cases only.)}
\item{\code{"mvt"}}{Uses the multivariate \eqn{t} distribution to assess the probability or critical value for the maximum of \eqn{k} estimates. This method produces the same \eqn{p} values and intervals as the default \code{summary} or \code{confint} methods to the results of \code{\link{as.glht}}. In the context of pairwise comparisons or comparisons with a control, this produces \dQuote{exact} Tukey or Dunnett adjustments, respectively. However, the algorithm (from the \pkg{mvtnorm} package) uses a Monte Carlo method, so results are not exactly repeatable unless the randomnumber seed is used (see \code{\link[base]{set.seed}}). As the family size increases, the required computation time will become noticeable or even intolerable, making the \code{"tukey"}, \code{"dunnettx"}, or others more attractive.}
\item{\code{"none"}}{Makes no adjustments to the \eqn{p} values.}
} % end \describe {}

For Pvalue adjustments only, the Bonferroniinequalitybased adjustment methods in \code{\link{p.adjust}} are also available (currently, these include \code{"holm"}, \code{"hochberg"}, \code{"hommel"}, \code{"bonferroni"}, \code{"BH"}, \code{"BY"}, \code{"fdr"}, and \code{"none"}). If a \code{p.adjust.methods} method other than \code{"bonferroni"} or \code{"none"} is specified for confidence limits, the straight Bonferroni adjustment is used instead.
Also, if an adjustment method is not appropriate (e.g., using \code{"tukey"} with onesided tests, or with results that are not pairwise comparisons), a more appropriate method (usually \code{"sidak"}) is substituted.

In some cases, confidence and \eqn{p}value adjustments are only approximate  especially when the degrees of freedom or standard errors vary greatly within the family of tests. The \code{"mvt"} method is always the correct onestep adjustment, but it can be very slow. One may use \code{\link{as.glht}} with methods in the \pkg{multcomp} package to obtain nonconservative multistep adjustments to tests.

\bold{Information:}
The \code{str} method outputs a very brief summary of the object, whereas \code{levels} produces a \code{data.frame} containing the combinations of levels of predictor values that define the reference grid.

\bold{\code{xtable}related methods:}
The \code{\link{xtable}} methods actually use \code{\link{xtableList}}, because of the ability to display messages such as those for Pvalue adjustments. These methods return an object of class \code{"xtable.lsm"}  an extension of \code{"xtableList"}. Unlike other \code{xtable} methods, the number of digits defaults to 4; and degrees of freedom and \emph{t} ratios are always formatted independently of \code{digits}. The \code{print} method uses \code{\link{print.xtableList}}, and any \code{\dots} arguments are passed there.

\bold{\code{rbind} and \code{[} methods:}
\code{rbind} can be used to combine two or more reference grids into one. The \code{"["} method for \code{ref.grid}s may be used to obtain a subset. The primary reason for doing this would be to redefine the family of tests to which a Pvalue adjustment method applies. In \code{rbind}, the variables defined in the objects' grids are merged into one grid, and the returned object has no \dQuote{by} variables and the multiplicity adjustment method set to \code{"mvt"} (as this is likely the only appropriate one).
\code{rbind} throws an error if there are any mismatches among the dimensions, fixedeffect coefficients, or covariance matrices.

\bold{Nonestimable cases:}
When the model is rankdeficient, each row \code{x} of \code{object}'s \code{linfct} slot is each checked for estimability. If \code{sum(x*bhat)} is found to be nonestimable, then an \code{NA} is displayed for the estimate (as well as any associated statistics). This check is performed using the orthonormal basis \code{N} in the \code{nbasis} slot for the null space of the rows of the model matrix. Estimability fails when \eqn{Nx^2 / x^2} exceeds \code{tol}, which by default is \code{1e8}. You may change it via \code{\link{lsm.options}} by setting \code{estble.tol} to the desired value.

\bold{More on tests:}
When \code{delta = 0}, test statistics are of the usual form \samp{(estimate  null)/SE}, or notationally, \eqn{t = (Q  \theta_0)/SE} where \eqn{Q} is our estimate of \eqn{\theta}; then left, right, or twosided \eqn{p} values are produced.

When \code{delta} is positive, the test statistic depends on \code{side} as follows.

Leftsided (nonsuperiority, \eqn{H_0: \theta \ge \theta_0 + \delta} versus \eqn{H_1: \theta < \theta_0 + \delta}): \eqn{t = (Q  \theta_0  \delta)/SE}. The \eqn{p} value is the lowertail probability.

Rightsided (noninferiority): \eqn{H_0: \theta \le \theta_0  \delta} versus \eqn{H_1: \theta > \theta_0  \delta}): \eqn{t = (Q  \theta_0 + \delta)/SE}. The \eqn{p} value is the uppertail probability.

Twosided (equivalence): \eqn{H_0: \theta  \theta_0 \ge \delta} versus \eqn{H_1: \theta  \theta_0 < \delta}): \eqn{t = (Q  \theta_0  \delta)/SE}. The \eqn{p} value is the \emph{lower}tail probability.


\bold{Plots:}
The \code{plot} method for \code{"lsmobj"} or \code{"summary.ref.grid"} objects (but not \code{"ref.grid"} objects themselves) produces a plot displaying confidence intervals for the estimates. If any \code{by} variables are in force, the plot is divided into separate panels. These functions use the \code{\link[lattice]{dotplot}} function, and thus require that the \pkg{lattice} package be installed. For \code{"summary.ref.grid"} objects, the \code{\dots} arguments in \code{plot} are passed \emph{only} to \code{dotplot}, whereas for \code{"lsmobj"} objects, the object is updated using \code{\dots} before summarizing and plotting.

In plots with \code{comparisons = TRUE}, the resulting arrows are only approximate, and in some cases may fail to accurately reflect the pairwise comparisons of the estimates  especially when estimates having large and small standard errors are intermingled in just the wrong way.

\bold{Regridding:}
The \code{regrid} function reparameterizes an existing \code{ref.grid} so that its \code{linfct} slot is the identity matrix and its \code{bhat} slot consists of the estimates at the grid points. If \code{transform} is \code{TRUE}, the inverse transform is applied to the estimates. Outwardly, the \code{summary} after applying \code{regrid} is identical to what it was before (using \samp{type="response"} if \code{transform} is \code{TRUE}). But subsequent contrasts will be conducted on the transformed scale  which is the reason this function exists. See the example below. In cases where the degrees of freedom depended on the linear function being estimated, the d.f. from the reference grid are saved, and a kind of \dQuote{containment} method is substituted in the returned object whereby the calculated d.f. for a new linear function will be the minimum d.f. among those having nonzero coefficients. This is kind of an \emph{ad hoc} method, and it can overestimate the degrees of freedom in some cases.

\bold{MCMC samplers:}
When the object's \code{post.beta} slot is nontrivial, \code{as.mcmc} will return an \code{\link[coda]{mcmc}} or \code{\link[coda]{mcmc.list}} object that can be summarized or plotted using methods in the \pkg{coda} package. Alternatively, \code{as.stanfit} will return a \code{\link[rstan]{stanfit}} object that can be summarized or plotted using methods in the \pkg{rstan} package. You may use any of these functions regardless of what packages were originally used to implement the MCMC method.
In these functions, \code{post.beta} is transformed by postmultiplying it by \code{t(linfct)}, creating a sample from the posterior distribution of LS means. In \code{as.mcmc}, if \code{sep.chains} is \code{TRUE} and there is in fact more than one chain, an \code{mcmc.list} is returned with each chain's results. The \code{as.mcmc.list} method is guaranteed to return an \code{mcmc.list}, even if it comprises just one chain. Note that \code{stanfit} objects are designed already for multiple chains.
}

\value{
The \code{summary} method for \code{"ref.grid"} objects returns an object of class \code{"summary.ref.grid"}, which extends \code{"data.frame"}. \code{xtable} returns an object of class \code{"xtable.lsm"}, as explained in details. \code{plot} returns an object of class \code{"trellis"}. \code{vcov} returns the covariance matrix of the product of the object's \code{linfct} and \code{bhat} slots. \code{as.mcmc} returns a \pkg{coda} \code{mcmc} object.
}
%%\references{}
\author{
Russell V. Lenth
}
%\note{}

\seealso{
Methods for the closely related \code{"lsmobj"} class can be found in \code{\link[lsmeans]{contrast}}, \code{\link[lsmeans]{cld}}, and \code{\link[lsmeans]{glht}}. For more on Bonferronibased Pvalue adjustments, see \code{\link{p.adjust}}. Also, \code{\link{test}} and \code{\link{confint}} are essentially frontends for \code{summary}, so additional examples may be found there.
}
\examples{
require(lsmeans)
warp.lm < lm(breaks ~ wool * tension, data = warpbreaks)
warp.rg < ref.grid(warp.lm)
str(warp.rg)
levels(warp.rg)

summary(warp.rg)

summary(warp.rg, by = "wool",
 infer = c(TRUE, FALSE), level = .90, adjust = "sidak")

# Do all pairwise comparisons within rows or within columns,
# all considered as one faily of tests:
w.t < pairs(lsmeans(warp.rg, ~ wool  tension))
t.w < pairs(lsmeans(warp.rg, ~ tension  wool))
rbind(w.t, t.w)

# Transformed response
sqwarp.rg < ref.grid(update(warp.lm, sqrt(breaks) ~ .))
summary(sqwarp.rg)

# Backtransformed results  compare with summary of 'warp.rg'
summary(sqwarp.rg, type = "response")

# But differences of sqrts can't be backtransformed
summary(pairs(sqwarp.rg, by = "wool"), type = "response")

# We can do it via regrid
sqwarp.rg2 < regrid(sqwarp.rg)
summary(sqwarp.rg2) # same as for sqwarp.rg with type = "response"
pairs(sqwarp.rg2, by = "wool")

# Logistic regression
# Reshape the Titanic data
Titan < do.call("expand.grid", dimnames(Titanic)[4])
Titan$Died < matrix(Titanic, ncol=2)
Titan.glm < glm(Died ~ (Class + Sex + Age)^2,
 family = binomial, data = Titan)
Titan.lsm < lsmeans(Titan.glm, ~ ClassSex, at = list(Age="Adult"))
summary(Titan.lsm, type="response")
summary(pairs(Titan.lsm), type="response")

# Nonsuperiority test: Is any class no more likely to die than
# the 1st class passengers?
summary(contrast(Titan.lsm, "trt.vs.ctrl1"), delta = 1,
 adjust = "none", side = "<")


# Plot 90% CIs on the response scale
plot(Titan.lsm, type = "response", level = .90,
 xlab = "Predicted probability of drowning")
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ models }
\keyword{ htest }
diff pruN 2.27623/man/update.Rd 2.3001/man/update.Rd
 2.27623/man/update.Rd 20170930 17:46:31.000000000 +0000
+++ 2.3001/man/update.Rd 19700101 00:00:00.000000000 +0000
@@ 1,158 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %

\name{update}
\alias{update}
\alias{update.ref.grid}
\alias{lsm.options}
\alias{get.lsm.option}
\alias{defaults.lsm}
\alias{pmm.options}
\alias{get.pmm.option}

\title{
Set or retrieve options for objects and summaries in \pkg{lsmeans}
}
\description{
Objects of class \code{ref.grid} or \code{lsmobj} contain several settings in their \code{"misc"} slot that affect primarily the
defaults used by \code{\link{summary}}. This \code{update} method allows them to be changed more safely than by modifying this slot directly.

In addition, the user may set defaults for all objects using \samp{options(lsmeans = ...)}, or more conveniently using the \code{lsm.options} and \code{get.lsm.option} functions documented here (or its courtesy wrappers, \code{pmm.options} and \code{get.pmm.option} for those who dislike the \sQuote{leastsquares means} terminology).
}
\usage{
\S3method{update}{ref.grid}(object, ..., silent = FALSE)

lsm.options(...)
get.lsm.option(x, default = defaults.lsm[[x]])

pmm.options(...)
get.pmm.option(...)
}
\arguments{
 \item{object}{An object of class \code{ref.grid} (or its extension, \code{lsmobj})
}
 \item{\dots}{
Arguments specifying elements' names and their new values.
}
 \item{silent}{If \code{FALSE}, a message is displayed for any unmatched names.}
 \item{x}{Character string holding an option name for \code{lsm.options}.}
 \item{default}{Return value if \code{x} is not found.}
}

\details{

\subsection{Using \code{update}}{
In \code{update}, the names in \code{\dots} are partially matched against those that are valid, and if a match is found, it adds or replaces the current setting. The valid names are

\describe{
\item{\code{nesting}}{(named \code{list}) specifies the nesting structure. The names are those of nested factors, and the elements are character vectors of the factors they are nested in. See the \code{nesting} argument and Details section of \code{\link{ref.grid}}. The current nesting structure is displayed by \code{link{str}}.}
\item{\code{tran}, \code{tran2}}{(\code{list} or \code{character}) specifies the transformation which, when inverted, determines the results displayed by \code{\link{summary}}, \code{\link{predict}}, or \code{\link{lsmip}} when \code{type="response"}. The value may be the name of a standard transformation from \code{\link{make.link}} or additional ones supported by name, such as \code{log2}; or, for a custom transformation, a \code{list} containing at least the functions \code{linkinv} (the inverse of the transformation) and \code{mu.eta} (the derivative thereof). The \code{\link{make.tran}} function returns such lists for a number of popular transformations. See the help page of \code{\link{make.tran}} for details as well as information on the additional named transformations that are supported. \code{tran2} is just like \code{tran} except it is a second transformation (i.e., a response transformation in a generalized linear model).}

\item{\code{tran.mult}}{Multiple for \code{tran}. For example, for the response transformation \samp{2*sqrt(y)} (or \samp{sqrt(y) + sqrt(y + 1)}, for that matter), we should have \code{tran = "sqrt"} and \code{tran.mult = 2}. If absent, a multiple of 1 is assumed.}

\item{\code{estName}}{(\code{character}) is the column label used for displaying predictions or LS means.}

\item{\code{inv.lbl}}{(\code{character)}) is the column label to use for predictions or LS means when \code{type="response"}.}

\item{\code{by.vars}}{(\code{character)} vector or \code{NULL}) the variables used for grouping in the summary, and also for defining subfamilies in a call to \code{\link{contrast}}.}

\item{\code{pri.vars}}{(\code{character} vector) are the names of the grid variables that are not in \code{by.vars}. Thus, the combinations of their levels are used as columns in each table produced by \code{\link{summary}}.}

\item{\code{alpha}}{(numeric) is the default significance level for tests, in \code{\link{summary}} as well as \code{\link{cld}} and \code{\link{plot}} when \samp{intervals = TRUE}}

\item{\code{adjust}}{(\code{character)}) is the default for the \code{adjust} argument in \code{\link{summary}}.}

\item{\code{estType}}{(\code{character}) is the type of the estimate. It should match one of \samp{c("prediction","contrast","pairs")}. This is used along with \code{"adjust"} to determine appropriate adjustments to P values and confidence intervals.}

\item{\code{famSize}}{(integer) is the \code{nmeans} parameter for \code{\link{ptukey}} when \code{adjust="tukey"}. }

\item{\code{infer}}{(\code{logical} vector of length 2) is the default value of \code{infer} in \code{\link{summary}}.}

\item{\code{level}}{(numeric) is the default confidence level, \code{level}, in \code{\link{summary}}}

\item{\code{df}}{(numeric) overrides the default degrees of freedom with a specified single value.}

\item{\code{null}}{(numeric) null hypothesis for \code{summary} or \code{test} (taken to be zero if missing).}

\item{\code{side}}{(numeric or character) \code{side} specification for for \code{summary} or \code{test} (taken to be zero if missing).}

\item{\code{delta}}{(numeric) \code{delta} specification for \code{summary} or \code{test} (taken to be zero if missing).}

\item{\code{predict.type}}{(character) sets the default method of displaying predictions in \code{\link{summary}}, \code{\link{predict}}, and \code{\link{lsmip}}. Valid values are \code{"link"} (with synonyms \code{"lp"} and \code{"linear"}), or \code{"response"}.}

\item{\code{avgd.over}}{(\code{character)} vector) are the names of the variables whose levels are averaged over in obtaining marginal averages of predictions, i.e., LS means. Changing this might produce a misleading printout, but setting it to \code{character(0)} will suppress the \dQuote{averaged over} message in the summary.}

\item{\code{initMesg}}{(\code{character}) is a string that is added to the beginning of any annotations that appear below the \code{\link{summary}} display.}

\item{\code{methDesc}}{(\code{character}) is a string that may be used for creating names for a list of \code{lsmobj} objects. }

\item{(any slot name)}{If the name matches an element of \code{slotNames(object)}, that slot is replaced by the supplied value, if it is of the required class (otherwise an error occurs). Note that all the other possibilities above refer to elements of \code{misc}; hence, you probably don't want to replace \code{misc} itself. The user must be very careful in replacing slots because they are interrelated; for example, the \code{levels} and \code{grid} slots must involve the same variable names, and the lengths and dimensions of \code{grid}, \code{linfct}, \code{bhat}, and \code{V} must conform.
}
} % end \describe
} % end subsection

\subsection{Using \code{lsm.options}}{
In \code{lsm.options}, we may set or change the default values for the above attributes in the \code{lsmeans} option list(see \code{\link{options}}). Currently, the following elements of this list are used if specified:
\describe{
\item{\code{ref.grid}}{A named \code{list} of defaults for objects created by \code{\link{ref.grid}}. This could affect other objects as well. For example, if \code{lsmeans} is called with a fitted model object, it calls \code{ref.grid} and this option will affect the resulting \code{lsmobj} object.}
\item{\code{lsmeans}}{A named \code{list} of defaults for objects created by \code{\link{lsmeans}} (or \code{\link{lstrends}}).}
\item{\code{contrast}}{A named \code{list} of defaults for objects created by \code{\link{contrast}} (or \code{\link{pairs}}).}
\item{\code{summary}}{A named \code{list} of defaults used by the methods \code{\link{summary}}, \code{\link{predict}}, and \code{\link{lsmip}}. The only option that can affect the latter two is \code{"predict.method"}.}
\item{\code{estble.tol}}{Tolerance for determining estimability in rankdeficient cases. If absent, the value in \code{defaults.lsm$estble.tol)} is used.}
\item{(others)}{Other options may be accessed by support code for particular model classes (see \code{\link{models}}). For example, the \code{lmer.df}, \code{disable.pbkrtest}, and \code{pbkrtest.limit} options affect how degrees of freedom are computed for \code{lmerMod} objects (\pkg{lme4} package).}
} % end \describe
} % end subsection

} % end details
\value{
\code{update} returns a copy of \code{object} with its \code{"misc"} slot modified (and perhaps other slots). \code{lsm.options} returns the current options (same as the result of \samp{getOption("lsmeans")})  invisibly, unless called with no arguments.
}


\author{
Russell V. Lenth
}
\note{If a call to \code{\link{lsmeans}}, \code{\link{contrast}}, or \code{\link{ref.grid}} contains a non\code{NULL} \code{options} list, those options are passed in a call to \code{update} on the constructed object before it is returned. This allows you, for example, to override the defaults used by \code{\link{summary}}. In addition, user defaults may be set using an \code{link{options}} setting for \code{"lsmeans"}. It should be a list with one or more named elements \code{lsmeans}, \code{contrast}, or \code{ref.grid}, used for setting the defaults for objects constructed by functions of these same names. Note that options can get \dQuote{inherited}. See the examples.

Unlike the \code{update} method for model classes (\code{lm}, \code{glm}, etc.), this does not refit or reestimate anything; but it does affect how \code{object} is treated by other methods for its class.}

%% ~Make other sections like Warning with \section{Warning }{....} ~

\seealso{
\code{\link{summary}}, \code{\link{make.tran}}
}
\examples{
# An altered log transformation

warp.lm1 < lm(log(breaks + 1) ~ wool*tension, data = warpbreaks)
rg1 < update(ref.grid(warp.lm1),
 tran = list(linkinv = function(eta) exp(eta)  1,
 mu.eta = function(eta) exp(eta)),
 inv.lbl = "pred.breaks")

summary(rg1, type = "response")

\dontrun{
lsm.options(ref.grid = list(level = .90),
 contrast = list(infer = c(TRUE,FALSE)),
 estble.tol = 1e6)
# Sets default confidence level to .90 for objects created by ref.grid
# AS WELL AS lsmeans called with a model object (since it creates a
# reference grid). In addition, when we call 'contrast', 'pairs', etc.,
# confidence intervals rather than tests are displayed by default.
}

\dontrun{
lsm.options(disable.pbkrtest = TRUE)
# This forces use of asymptotic methods for lmerMod objects.
# Set to FALSE or NULL to reenable using pbkrtest.
}

# See tolerance being used for determining estimability
get.lsm.option("estble.tol")
}


% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ models }
\keyword{ htest }% __ONLY ONE__ keyword per line
diff pruN 2.27623/MD5 2.3001/MD5
 2.27623/MD5 20180511 11:03:06.000000000 +0000
+++ 2.3001/MD5 20181102 23:50:11.000000000 +0000
@@ 1,34 +1,9 @@
05c71fa3f98270ed116a4a383dbb7081 *DESCRIPTION
2dd0410db3d7c83ed40d324589a92e9c *NAMESPACE
0c7544689fa308a2cfdf39597cd51c47 *R/MCMCsupport.R
b6aeea0c61ba42efc7238c12eb473c7e *R/S4classes.R
7e7d476ad3a25aa9c621a185a2651dba *R/aovlistsupport.R
6873bb0b8efa62a28acdeba28783ad5a *R/betareg.support.R
10454c0bcf829647554a68b7cd7dc169 *R/cld.lsm.R
4a61d785b8e3d0c7fa376859feec17dd *R/countregsupport.R
818e51949363aea61de4e8e1c5964661 *R/glhtsupport.R
14cd61471a02703d30bfea86e6784be3 *R/helpers.R
c965210689c5dffbbb86fca1598c811e *R/lsmcontr.R
c904945997d5ca634c2f22e4e695f63f *R/lsm.list.R
526e0e9d57e133ddb508299f7da7abfc *R/lsmeans.R
93ceb32af11885f5eef99c288afc5426 *R/lsmip.R
5b198b5a9c2afccbb91a79b2323d24a6 *R/lstrends.R
12521e239f0be407d783ff3573fe143c *R/multinomsupport.R
0305f67466a59d31d5d824ec92bb1a82 *R/nested.R
9d134b9868657bf5e2f11889478299e2 *R/nonlinsupport.R
cf659542dd3a75de7823bd60f9d305ae *R/ordinalsupport.R
fe11c6093f8bf2296da4bfc62e483eff *R/plot.lsm.R
62d84c37d7cdcc427dc3bf556649dc1d *R/pmmeans.R
738e67d2039d0fc4e092da1662e2da4c *R/rbind.R
1cd217797a319d4a594902cf07da3866 *R/ref.grid.R
72c419a99bbf793adce3f350cc8c6956 *R/reformulate.R
38b763fd739e9a305ca150ad48775d8b *R/rmssupport.R
de86df367c732c5d034918c0b16a9b52 *R/summary.R
54a61e06c93bbb27db583293750a574d *R/transformations.R
0d4573046b69b973df22a82fd08cb16a *R/xtablemethod.R
3a51303fe4c11415911871137502290b *R/zzz.R
+3237a7ee4a08bd36ffc453af5b8c2c50 *DESCRIPTION
+50095211737ca788e9e88bb05ce4d511 *NAMESPACE
+912f8abdd89249af545cb90b623b4557 *R/S4classes.R
+e7829f7b6ae0334294360151e6aff2dc *R/ref.grid.R
+2d0d082cc616f58597d64913749b37a4 *R/zzz.R
019034d6abc413f009ad344a5fbf5849 *README.md
c93e9991d11bc8887b5d9939fa2d3e91 *build/vignette.rds
dd8a9e9e6180f65bff84a40f25943636 *data/MOats.RData
2d7a1d217def5e4ab094c7f019a7d27d *data/autonoise.RData
991422f691ec5cdee38ab0d613e2a89c *data/feedlot.RData
@@ 36,31 +11,11 @@ f204c1431e151e2459178e8f4fc8f0e8 *data/f
298a5159a77e201ffe1410cf80282eff *data/nutrition.RData
2b03398ef2214b51371430e875d964cc *data/oranges.RData
35e5174543eefde1753d492066cf016f *inst/CITATION
6880ad4531814261e36292734c17c1a4 *inst/NEWS
f6316a1bdad5e2cb434c307cd596ca83 *inst/doc/usinglsmeans.R
40c4ff3f0f4f5b085c5230d008825e32 *inst/doc/usinglsmeans.pdf
aac32e5e0203635156cee0096c07fa2d *inst/doc/usinglsmeans.rnw
7a453bfdd15f1ea178c3b38639af07a1 *man/MOats.Rd
efed4c40d321ca3a773c9216cb917c9f *man/auto.noise.Rd
03263d8f20d26e973f93192864ca8df7 *man/cld.Rd
780ad5bbe3b3fdba277f1a7f018291bc *man/contrast.Rd
d7c418c37e8a89dea4713e7ee8019885 *man/extending.Rd
81a0afb3a77612ec1f933d82f38b6487 *man/feedlot.Rd
da86f57874d9ff6a6db11ae0baa5dc9a *man/fiber.Rd
fe7c5809c027590b886814524353ece0 *man/glht.Rd
33b82a7683ec667ffc97dfda40a70964 *man/grouping.Rd
6f63a8c859ef681b7384ccf4ad59caa8 *man/lsmeanspackage.Rd
59a1d198b972f132bf53599f3e6776eb *man/lsmeans.Rd
3daee9eaaea145b92cea3e761637060f *man/lsmip.Rd
fff34d957b3add1a0607efb2d0519a2a *man/make.tran.Rd
814e7ce0445c0d6fe385bec12a2f5fc8 *man/models.Rd
8b773ecdda0d3ae4a63a1a5c4ccbae42 *man/nutrition.Rd
d97fcfe0355cc8841c9ad4f91dc1efd3 *man/oranges.Rd
1609269aebd103bf7f0c66728897bf2d *man/pairwise.lsmc.Rd
1790338a4f938a88db96eab95767e74b *man/ref.grid.Rd
d1a7339bebd91a6d9db015a21b3b5e65 *man/ref.grid.class.Rd
264fcb5d54dd373d819aad9375991321 *man/summary.Rd
+da5600d04be6ae1cdd2f56846e595539 *inst/NEWS
+6404c4fe7e9c7c81ca32ca8fe9617744 *man/auto.noise.Rd
+6e3957c6ddc995b3025d68706f1a3ada *man/lsmeanspackage.Rd
+cf636bf7f563988cd041599afc3be71e *man/ref.gridclass.Rd
+e0c9101462562c8d7c436eba132a1709 *man/ref.grid.Rd
3677b9494267f40b83afc04e355ec331 *man/transition.Rd
702b3222d5f91ff13575dd2abc4d3870 *man/update.Rd
950ac1a25d37ddac3b540c83873192f3 *vignettes/lsmeans.bib
aac32e5e0203635156cee0096c07fa2d *vignettes/usinglsmeans.rnw
+6d23fee52ea0a0c7cb1e1ef19bc4afbf *tests/lsmbasistest.R
+0d5b8a9120006dd599c1b8fa91f07f90 *tests/lsmbasistest.out
diff pruN 2.27623/NAMESPACE 2.3001/NAMESPACE
 2.27623/NAMESPACE 20171022 15:06:05.000000000 +0000
+++ 2.3001/NAMESPACE 20181102 18:54:31.000000000 +0000
@@ 1,183 +1,23 @@
# Namespace for lsmeans package
# Imports
# From default packages (new req from CRAN, July 2015)
importFrom("graphics", "pairs", "plot")
importFrom("stats", "as.formula", "coef", "complete.cases", "confint", "cov",
 "cov2cor", "delete.response", "deriv", "family", "lm", "make.link",
 "model.frame", "model.matrix", "na.omit", "na.pass", "p.adjust",
 "p.adjust.methods", "pchisq", "pf", "poly", "predict", "pt", "ptukey",
 "qbeta", "qf", "qt", "qtukey", "reformulate", "terms", "uniroot",
 "update", "vcov")
importFrom("utils", "head", "installed.packages", "str")
importFrom("nlme", "fixef")

# Others
import(methods)
import(mvtnorm)
import(estimability)

# 'requireNamespace' block below allows me to put multcomp in
# Imports instead of Depends.
if (requireNamespace("multcomp", quietly = TRUE)) {
 importFrom(multcomp, cld, glht, modelparm)
 export(cld) # needed so that cld is visible even when multcomp not attached
 S3method(cld, ref.grid)
 S3method(cld, lsm.list)
 S3method(glht, lsmlf)
 S3method(glht, ref.grid)
 S3method(modelparm, lsmwrap)
}

if (requireNamespace("plyr", quietly = TRUE)) {
 importFrom(plyr, alply)
}

if (requireNamespace("coda", quietly = TRUE)) {
 importFrom(coda, as.mcmc, as.mcmc.list)
 S3method(as.mcmc, ref.grid)
 S3method(as.mcmc.list, ref.grid)
}

### If rstan ever implements an as.stanfit generic, we need to move rstan
### from Suggests to Imports and do something more like we do for coda::as.mcmc
#if (requireNamespace("rstan", quietly = TRUE)) {
 export(as.stanfit)
#}


if (requireNamespace("xtable", quietly = TRUE)) {
 importFrom(xtable, xtable, xtableList)
}
+import(emmeans)
# Visible exports
exportPattern("*.lsmc") #all contrast fcns
export(
 add_grouping,
 as.glht,
 contrast,
 defaults.lsm,
 get.lsm.option,
 get.pmm.option,
 lsm,
 lsm.basis,
 lsmeans,
 lsmeans.character,
 lsmobj,
 lsmip,
 lsm.options,
 lstrends,
 make.tran,
 pmm,
 pmmeans,
 pmmobj,
 pmmip,
 pmm.options,
 pmtrends,
 ###rbind, # my own version that overrides one in methods
 recover.data,
 ref.grid,
 regrid,
 test
+ ref.grid, lsm.basis, recover.data
)
# hidden functions of possible use to other package developers
export(
 .all.vars,
 .aovlist.dffun,
 .diag,
 .get.offset,
 .my.vcov
)


# S3 methods for recover.data and lsm.basis that are needed by other packages
S3method(recover.data, call)

S3method(recover.data, aovlist)
S3method(lsm.basis, aovlist)

S3method(recover.data, lm)
S3method(lsm.basis, lm)

S3method(recover.data, lme)
S3method(lsm.basis, lme)
+exportClasses(ref.grid, lsmobj)
S3method(recover.data, merMod)
S3method(lsm.basis, merMod)
+# To nurse along StroupGLMM: (when no longer needed, also remove aliases in ref.grid.Rd)
+export(contrast, lsmeans)
S3method(lsm.basis, mlm) # recover.data for mlm uses lm

# S3 methods 
# For clarity, I'm showing them all
# but commenting out the ones used only interally

S3method("[", ref.grid)

S3method(as.glht, ref.grid)
S3method(as.glht, lsm.list)

S3method(coef, ref.grid)
S3method(coef, lsm.list)

S3method(confint, ref.grid)
S3method(confint, lsm.list)

S3method(contrast, ref.grid)
S3method(contrast, lsm.list)

#S3method(glht, lsmlf) # in namespace block above
#S3method(glht, ref.grid)

S3method(lsmeans, character)
S3method(lsmeans.character, default)
S3method(lsmeans.character, ref.grid)
S3method(lsmeans, default)
S3method(lsmeans, formula)
S3method(lsmeans, list)

S3method(lsmip, default)

#S3method(modelparm, lsmwrap) # in namespace block above

S3method(pairs, ref.grid)
S3method(pairs, lsm.list)

S3method(plot, lsmobj)
S3method(plot, summary.ref.grid)

S3method(predict, ref.grid)

S3method(print, ref.grid)
S3method(print, summary.ref.grid)
S3method(print, lsm.list)
S3method(print, xtable.lsm)

S3method(rbind, ref.grid)

S3method(str, ref.grid)
S3method(str, lsm.list)

S3method(summary, ref.grid)
S3method(summary, lsm.list)

S3method(test, ref.grid)
S3method(test, lsm.list)
S3method(update, ref.grid)

S3method(vcov, ref.grid)

S3method(xtable, ref.grid)
S3method(xtable, summary.ref.grid)


# Support for my glht.list objects (cede to Torsten if he wants 'em in multcomp)
# DOESN'T WORK: S3method(cld, glht.list)
S3method(coef, glht.list)
S3method(confint, glht.list)
S3method(plot, glht.list)
# NOT NEEDED: S3method(print, glht.list)
S3method(summary, glht.list)
S3method(vcov, glht.list)

diff pruN 2.27623/R/aovlistsupport.R 2.3001/R/aovlistsupport.R
 2.27623/R/aovlistsupport.R 20171104 20:51:17.000000000 +0000
+++ 2.3001/R/aovlistsupport.R 19700101 00:00:00.000000000 +0000
@@ 1,139 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# lsmeans support for aovlist objects

recover.data.aovlist = function(object, ...) {
 fcall = attr(object, "call")
 trms = terms(object)
 # Find the Error terms
 lbls = attr(trms, "term.labels")
 err.idx = grep("^Error\\(", lbls)
 newf = as.formula(paste(c(".~.", lbls[err.idx]), collapse = ""))
 trms = terms(update(trms, newf))
 recover.data(fcall, delete.response(trms), na.action = attr(object, "na.action"), ...)
}

# This works great for balanced experiments, and goes horribly wrong
# even for slightly unbalanced ones. So I abort on these kinds of cases
lsm.basis.aovlist = function (object, trms, xlev, grid, vcov., ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 contr = attr(object, "contrasts")
 X = model.matrix(trms, m, contrasts.arg = contr)
 xnms = dimnames(X)[[2]]

 # Check for situations we can't handle...
 colsums = apply(X[, setdiff(xnms, "(Intercept)"), drop=FALSE], 2, sum)
 if (any(round(colsums,3) != 0))
 warning("Some predictors are correlated with the intercept  results are biased.\n",
 "May help to refit with different contrasts, e.g. 'contr.sum'")
 if (length(unlist(lapply(object, function(x) names(coef(x))))) > length(xnms))
 message("NOTE: Results are based on intrablock estimates.")

 # initialize arrays
 nonint = setdiff(names(object), "(Intercept)")

 k = length(xnms)
 bhat = rep(NA, k) # I'll use NAs to track which slots I've filled
 V = matrix(0, nrow=k, ncol=k)
 names(bhat) = xnms
 dimnames(V) = list(xnms, xnms)
 empty.list = as.list(nonint)
 names(empty.list) = nonint
 Vmats = Vidx = Vdf = empty.list
 wts = matrix(0, nrow = length(nonint), ncol = k)
 dimnames(wts) = list(nonint, xnms)
 # NOTE: At present, I just do intrablock analysis: wts are all 0 and 1
 btemp = bhat #++ temp for tracking indexes
 #++Work thru strata in reverse order
 for (nm in rev(nonint)) {
 x = object[[nm]]
 bi = coef(x)
 bi = bi[!is.na(bi)]
 ii = match(names(bi), xnms)
 Vidx[[nm]] = use = setdiff(ii, which(!is.na(bhat))) #++ omit elts already filled
 if(length(use) > 0) {
 ii.left = seq_along(ii)[!is.na(match(ii,use))]
 wts[nm, use] = 1
 bhat[use] = bi[ii.left]
 Vi = vcov(x, complete = FALSE)[ii.left, ii.left, drop=FALSE]
 Vmats[[nm]] = Vi
 V[use,use] = Vi
 }
 else {
 Vmats[[nm]] = matrix(0, nrow=0, ncol=0)
 }
 # Any cases with 0 df will have NaN for covariances. I make df = 1
 # in those cases so I don't divide by 0 later in Satterthwaite calcs
 Vdf[[nm]] = ifelse(x$df > 0, x$df, 1)
 }

 x < object[["(Intercept)"]]
 if (!is.null(x)) {
 # The intercept belongs in the 1st error stratum
 # So have to add a row and column to its covariance matrix
 bhat[1] = x$coefficients[1]
 wts[1,1] = 1
 Vidx[[1]] = ii = c(1, Vidx[[1]])
 k = length(ii)
 vv = matrix(0, nrow=k, ncol=k)
 if (k > 1) vv[2:k,2:k] = Vmats[[1]]
 # Variance of intercept is EMS of this stratum divided by N
 # Here I'm assuming there are no weights
 N = sum(sapply(object, function(x) length(x$residuals)))
 V[1,1] = vv[1,1] = sum(object[[2]]$residuals^2) / object[[2]]$df / N
 #dimnames(vv) = list(c(xnms[ii], xnms[ii]))
 Vmats[[1]] = vv
 }
 # override V if vcov. is supplied
 if(!missing(vcov.)) {
 V = .my.vcov(object, vcov.)
 dfargs = list()
 dffun = function(k, dfargs) NA
 }
 else {
 dfargs = list(Vmats=Vmats, Vidx=Vidx, Vdf=unlist(Vdf), wts = wts)
 dffun = function(k, dfargs) {
 lsmeans::.aovlist.dffun(k, dfargs)
 }
 }
 nbasis = estimability::all.estble # Consider this further?
 misc = list()

 list(X = X, bhat = bhat, nbasis = nbasis, V = V, dffun = dffun,
 dfargs = dfargs, misc = misc)
}

.aovlist.dffun = function(k, dfargs) {
 if(is.matrix(k) && (nrow(k) > 1)) {
 dfs = apply(k, 1, .aovlist.dffun, dfargs)
 min(dfs)
 }
 else {
 v = sapply(seq_along(dfargs$Vdf), function(j) {
 ii = dfargs$Vidx[[j]]
 kk = (k * dfargs$wts[j, ])[ii]
 #sum(kk * .mat.times.vec(dfargs$Vmats[[j]], kk))
 .qf.non0(dfargs$Vmats[[j]], kk)
 })
 sum(v)^2 / sum(v^2 / dfargs$Vdf) # Good ole Satterthwaite
 }
}
\ No newline at end of file
diff pruN 2.27623/R/betareg.support.R 2.3001/R/betareg.support.R
 2.27623/R/betareg.support.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/betareg.support.R 19700101 00:00:00.000000000 +0000
@@ 1,128 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# Support for 'betareg' class

# mode is same as 'type' in predict.betareg, PLUS
# mode = "phi.link" refers to link function before backtransforming to "precision"

recover.data.betareg = function(object, mode = c("response", "link", "precision", "phi.link", "variance", "quantile"), ...) {
 fcall = object$call
 mode = match.arg(mode)
 if (mode %in% c("response", "link"))
 mode = "mean"
 if (mode == "phi.link")
 mode = "precision"
 if(mode %in% c("response", "link", "precision"))
 trms = delete.response(terms(object, model = mode))
 else
 trms = delete.response(object$terms$full)
 # Make sure there's an offset function available
 env = new.env(parent = attr(trms, ".Environment"))
 env$offset = function(x) x
 attr(trms, ".Environment") = env
 recover.data(fcall, trms, object$na.action, ...)
}

# PRELIMINARY...
# Currently works correctly only for "resp", "link", "precision", "phi" modes
lsm.basis.betareg = function(object, trms, xlev, grid,
 mode = c("response", "link", "precision", "phi.link", "variance", "quantile"),
 quantile = .5, ...) {
 mode = match.arg(mode)
# if (mode %in% c("variance", "quantile"))
# stop(paste0('"', mode, '" mode is not yet supported.'))

 # figure out which parameters we need
 model = if (mode %in% c("response", "link")) "mean"
 else if (mode %in% c("precision", "phi.link")) "precision"
 else "full"
 V = .pscl.vcov(object, model = model) # borrowed from pscl methods
 bhat = coef(object, model = model)

 nbasis = estimability::all.estble
 dffun = function(k, dfargs) NA
 dfargs = list()


 if (mode %in% c("response", "link", "precision", "phi.link")) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = object$contrasts[[model]])
 misc = list(tran = object$link[[model]]$name)
 if (mode %in% c("response", "precision")) {
 misc$postGridHook = ".betareg.pg"
 }
 }
 else { ### (mode %in% c("variance", "quantile"))
 m.trms = delete.response(terms(object, "mean"))
 m.m = model.frame(m.trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(m.trms, m.m, contrasts.arg = object$contrasts$mean)
 m.idx = seq_len(ncol(X))
 m.lp = as.numeric(X %*% bhat[m.idx] + .get.offset(m.trms, grid))
 mu = object$link$mean$linkinv(m.lp)

 p.trms = delete.response(terms(object, "precision"))
 p.m = model.frame(m.trms, grid, na.action = na.pass, xlev = xlev)
 Z = model.matrix(p.trms, p.m, contrasts.arg = object$contrasts$precision)
 p.lp = as.numeric(Z %*% bhat[m.idx] + .get.offset(p.trms, grid))
 phi = object$link$precision$linkinv(p.lp)

 if (mode == "variance") {
 bhat = mu * (1  mu) / (1 + phi)
 dbhat.dm = (1  2 * mu) / (1 + phi)
 dbhat.dp = bhat / (1 + phi)
 delta = cbind(diag(dbhat.dm) %*% X, diag(dbhat.dp) %*% Z)
 V = delta %*% tcrossprod(V, delta)
 misc = list()
 }
 else { ### (mode = "quantile")
 bhat = as.numeric(sapply(quantile, function(q)
 stats::qbeta(q, phi * mu, phi * (1  mu))))
 V = matrix(NA, nrow = length(bhat), ncol = length(bhat))
 misc = list(ylevs = list(quantile = quantile))
 }
 X = diag(1, length(bhat))
 }
 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=misc)
}

# Postgrid hook for simple backtransforming
.betareg.pg = function(object) {
 object@misc$postGridHook = NULL
 regrid(object, transform = TRUE)
}


### predict methods
# link: X%*%beta + off_m
# response: mu = h_m(link)
#
# phi.link: Z%*%gamma + off_p
# precision: phi = h_p(phi.link)
#
# variance: mu*(1  mu) / (1 + phi)
# quantile: qbeta(p, mu*phi, (1  mu)*phi)
#
# Defns:
# phi = a + b
# mu = a / (a + b)
# so that phi*mu = a and phi*(1  mu) = b,
# Variance = ab / [(a + b)^2 * (a + b + 1)]
diff pruN 2.27623/R/cld.lsm.R 2.3001/R/cld.lsm.R
 2.27623/R/cld.lsm.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/cld.lsm.R 19700101 00:00:00.000000000 +0000
@@ 1,116 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# Runs the function multicompLetters from the multcompView package
# returns an error if not installed
.mcletters = function(..., Letters=c("1234567890",LETTERS,letters), reversed=FALSE) {
 if(!requireNamespace("multcompView", quietly = TRUE)) {
 stop("The 'multcompView' package must be installed to use cld methods")
 return (list(monospacedLetters = "?"))
 }

 # Expand strings to individual letters
 Letters = as.character(unlist(sapply(Letters, function(stg) {
 sapply(seq_len(nchar(stg)), function(i) substr(stg, i, i))
 })))

 result = multcompView::multcompLetters(..., Letters=Letters, reversed=reversed)
 if (is.null(result$monospacedLetters))
 result$monospacedLetters = result$Letters
 result
}

# S3 method for ref.grid
cld.ref.grid = function(object, details=FALSE, sort=TRUE,
 by, alpha=.05,
 Letters = c("1234567890",LETTERS,letters),
 reversed=FALSE, ...) {
 lsmtbl = summary(object, ...)
 if(missing(by))
 by = object@misc$by.vars
 if (sort) {
 args = list()
 for (nm in by) args[[nm]] = lsmtbl[[nm]]
 args$.lsm. = lsmtbl[[attr(lsmtbl, "estName")]]
 ord = do.call("order", args)
 lsmtbl = lsmtbl[ord, ]
 object@grid = object@grid[ord, , drop=FALSE]
 object@linfct = object@linfct[ord, , drop = FALSE]
 }
 attr(lsmtbl, "by.vars") = by
 object@misc$by.vars = by

 prwise = contrast(object, "revpairwise", by=by)
 pwtbl = test(prwise, ...)

 p.boo = (pwtbl$p.value < alpha)
 if(is.null(by)) {
 by.rows = list(seq_len(nrow(pwtbl)))
 by.out = list(seq_len(nrow(lsmtbl)))
 }
 else {
 by.rows = .find.by.rows(pwtbl, by)
 by.out = .find.by.rows(lsmtbl, by)
 }
 # Create comps matrix reflecting order generated by pairwise.lsmc
 icol = jcol = numeric(0)
 # create fake row indexes in revpairwise order for use by .mcletters
 k = length(by.out[[1]])
 for (i in 2:k) {
 icol = c(icol, seq_len(i1))
 jcol = c(jcol, rep(i, i1))
 }
 na.p = which(is.na(p.boo))
 # Take care of nonest cases. This is surprisingly complicated,
 # because it's possible we have some lsmeans that are nonest
 # but comparisons are est'ble. So cases to exclude must be missing in
 # the table of means, AND appar somewhere in the indexes of NA p values
 # All that said, it still messes up because I didn't track the indexes correctly
 # excl.rows = intersect(which(is.na(lsmtbl$SE)), union(icol[na.p], jcol[na.p]))
 # So I'll just go with which est's are missing
 excl.rows = which(is.na(lsmtbl$SE))
 p.boo[na.p] = FALSE

 labs = paste(icol,jcol,sep="")
 ltrs = rep("", nrow(lsmtbl))
 for (i in seq_len(length(by.rows))) {
 pb = p.boo[by.rows[[i]]]
 names(pb) = labs
 mcl = .mcletters(pb, Letters = Letters, reversed = reversed)$monospacedLetters
 ltrs[by.out[[i]]] = paste(" ", mcl, sep="")
 }
 # any missing estimates get blanks...
 ltrs[excl.rows] = ""

 lsmtbl[[".group"]] = ltrs
 if(sort && reversed) for (i in seq_len(length(by.out))) {
 r = by.out[[i]]
 lsmtbl[r, ] = lsmtbl[rev(r), ]
 }

 attr(lsmtbl, "mesg") = c(attr(lsmtbl,"mesg"), attr(pwtbl, "mesg"),
 paste("significance level used: alpha =", alpha))

 if (details)
 list(lsmeans = lsmtbl, comparisons = pwtbl)
 else
 lsmtbl
}
diff pruN 2.27623/R/countregsupport.R 2.3001/R/countregsupport.R
 2.27623/R/countregsupport.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/countregsupport.R 19700101 00:00:00.000000000 +0000
@@ 1,267 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# Support for zeroinfl and hurdle models (pscl [& future countreg package?])

# We'll support two optional arguments:
# mode  type of result required
# lin.pred  TRUE: keep linear predictor and link
# FALSE: backtransform (default)
#
# With lin.pred = FALSE and mode %in% c("response", "count", "zero"), we
# will return comparable results to predict(..., type = mode)
# with mode = "prob0", same results as predict(..., type = "prob")[, 1]
#
# lin.pred only affects results for mode %in% c("count", "zero").
# When lin.pred = TRUE, we get the actual linear predictor and link function
# for that part of the model.



#  zeroinfl objects 

recover.data.zeroinfl = function(object, mode = c("response", "count", "zero", "prob0"), ...) {
 fcall = object$call
 mode = match.arg(mode)
 if (mode %in% c("count", "zero"))
 trms = delete.response(terms(object, model = mode))
 else ### mode = %in% c("response", "prob0")
 trms = delete.response(object$terms$full)
 # Make sure there's an offset function available
 env = new.env(parent = attr(trms, ".Environment"))
 env$offset = function(x) x
 attr(trms, ".Environment") = env
 recover.data(fcall, trms, object$na.action, ...)
}


lsm.basis.zeroinfl = function(object, trms, xlev, grid,
 mode = c("response", "count", "zero", "prob0"), lin.pred = FALSE, ...)
{
 mode = match.arg(mode)
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 if (mode %in% c("count", "zero")) {
 contr = object$contrasts[[mode]]
 X = model.matrix(trms, m, contrasts.arg = contr)
 bhat = coef(object, model = mode)
 V = .pscl.vcov(object, model = mode, ...)
 if (mode == "count")
 misc = list(tran = "log", inv.lbl = "count")
 else
 misc = list(tran = object$link, inv.lbl = "prob")
 if (!lin.pred) { # backtransform the results
 lp = as.numeric(X %*% bhat + .get.offset(trms, grid))
 lnk = make.link(misc$tran)
 bhat = lnk$linkinv(lp)
 delta = .diag(lnk$mu.eta(lp)) %*% X
 V = delta %*% tcrossprod(V, delta)
 X = diag(1, length(bhat))
 misc = list(offset.mult = 0)
 }
 }
 else { ## "response", "prob0"
 trms1 = delete.response(terms(object, model = "count"))
 off1 = .get.offset(trms1, grid)
 contr1 = object$contrasts[["count"]]
 X1 = model.matrix(trms1, m, contrasts.arg = contr1)
 b1 = coef(object, model = "count")
 lp1 = as.numeric(X1 %*% b1 + off1)
 mu1 = exp(lp1)

 trms2 = delete.response(terms(object, model = "zero"))
 off2 = .get.offset(trms2, grid)
 contr2 = object$contrasts[["zero"]]
 X2 = model.matrix(trms2, m, contrasts.arg = contr2)
 b2 = coef(object, model = "zero")
 lp2 = as.numeric(X2 %*% b2) + off2
 mu2 = object$linkinv(lp2)
 mu2prime = stats::make.link(object$link)$mu.eta(lp2)

 if(mode == "response") {
 delta = .diag(mu1) %*% cbind(.diag(1  mu2) %*% X1, .diag(mu2prime) %*% X2)
 bhat = (1  mu2) * mu1
 }
 else { # mode = "prob0"
 p0 = 1  .prob.gt.0(object$dist, mu1, object$theta)
 dp0 =  .dprob.gt.0(object$dist, mu1, object$theta, "log", lp1)
 bhat = (1  mu2) * p0 + mu2
 delta = cbind(.diag((1  mu2) * dp0) %*% X1, .diag(mu2prime * (1  p0)) %*% X2)
 }
 V = delta %*% tcrossprod(.pscl.vcov(object, model = "full", ...), delta)
 X = diag(1, length(bhat))
 misc = list(offset.mult = 0)
 }
 nbasis = estimability::all.estble
 dffun = function(k, dfargs) NA
 dfargs = list()
 list(X = X, bhat = bhat, nbasis = nbasis, V = V,
 dffun = dffun, dfargs = dfargs, misc = misc)
}



#### Support for hurdle models

recover.data.hurdle = function(object, mode = c("response", "count", "zero", "prob0"), ...) {
 fcall = object$call
 mode = match.arg(mode)
 if (mode %in% c("count", "zero"))
 trms = delete.response(terms(object, model = mode))
 else ### mode = "mean" or "prob.ratio"
 trms = delete.response(object$terms$full)
 # Make sure there's an offset function available
 env = new.env(parent = attr(trms, ".Environment"))
 env$offset = function(x) x
 attr(trms, ".Environment") = env
 recover.data(fcall, trms, object$na.action, ...)
}

# see expl notes afterward for notations in some of this
lsm.basis.hurdle = function(object, trms, xlev, grid,
 mode = c("response", "count", "zero", "prob0"),
 lin.pred = FALSE, ...)
{
 mode = match.arg(mode)
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 if ((lin.pred && mode %in% c("count", "zero"))  (!lin.pred && mode %in% c("count", "prob0"))) {
 model = ifelse(mode == "count", "count", "zero")
 contr = object$contrasts[[model]]
 X = model.matrix(trms, m, contrasts.arg = contr)
 bhat = coef(object, model = model)
 V = .pscl.vcov(object, model = model, ...)
 misc = switch(object$dist[[model]],
 binomial = list(tran = object$link, inv.lbl = "prob"),
 list(tran = "log", inv.lbl = "count"))
 if (!lin.pred) { # backtransform
 lp = as.numeric(X %*% bhat + .get.offset(trms, grid))
 lnk = make.link(misc$tran)
 bhat = lnk$linkinv(lp)
 if (mode != "prob0") {
 delta = .diag(lnk$mu.eta(lp)) %*% X
 }
 else {
 bhat = 1  .prob.gt.0(object$dist$zero, bhat, object$theta["zero"])
 db =  .dprob.gt.0(object$dist$zero, bhat, object$theta["zero"], misc$tran, lp)
 delta = .diag(db) %*% X
 }
 V = delta %*% tcrossprod(V, delta)
 X = diag(1, length(bhat))
 misc = list(offset.mult = 0)
 }
 }
 else { ### "zero" or "response" with implied lin.pred = FALSE
 trms1 = delete.response(terms(object, model = "count"))
 off1 = .get.offset(trms1, grid)
 contr1 = object$contrasts[["count"]]
 X1 = model.matrix(trms1, m, contrasts.arg = contr1)
 b1 = coef(object, model = "count")
 mu1 = as.numeric(exp(X1 %*% b1 + off1))
 theta1 = object$theta["count"]
 p1 = .prob.gt.0(object$dist$count, mu1, theta1)
 dp1 = .dprob.gt.0(object$dist$count, mu1, theta1, "", 0) # binomial won't happen

 trms2 = delete.response(terms(object, model = "zero"))
 off2 = .get.offset(trms2, grid)
 contr2 = object$contrasts[["zero"]]
 X2 = model.matrix(trms2, m, contrasts.arg = contr2)
 b2 = coef(object, model = "zero")
 lp2 = as.numeric(X2 %*% b2 + off2)
 mu2 = switch(object$dist$zero,
 binomial = object$linkinv(lp2),
 exp(lp2) )
 theta2 = object$theta["zero"]
 p2 = .prob.gt.0(object$dist$zero, mu2, theta2)
 dp2 = .dprob.gt.0(object$dist$zero, mu2, theta2, object$link, lp2)

 if (mode == "response") {
 bhat = p2 * mu1 / p1
 delta = cbind(.diag(bhat*(1  mu1 * dp1 / p1)) %*% X1,
 .diag(mu1 * dp2 / p1) %*% X2)
 }
 else { ## mode == "zero"
 bhat = p2 / p1
 delta = cbind(.diag(p2 * dp1 / p1^2) %*% X1,
 .diag(dp2 / p1) %*% X2)
 }
 V = delta %*% tcrossprod(.pscl.vcov(object, model = "full", ...), delta)
 X = .diag(1, length(bhat))

 misc = list(estName = mode, offset.mult = 0)
 }
 nbasis = estimability::all.estble
 dffun = function(k, dfargs) object$df.residual
 dfargs = list()
 list(X = X, bhat = bhat, nbasis = nbasis, V = V,
 dffun = dffun, dfargs = dfargs, misc = misc)
}

# utility for prob (Y > 0  dist, mu, theta)
.prob.gt.0 = function(dist, mu, theta) {
 switch(dist,
 binomial = mu,
 poisson = 1  exp(mu),
 negbin = 1  (theta / (mu + theta))^theta,
 geometric = 1  1 / (1 + mu)
 )
}

# utility for d/d(eta) prob (Y > 0  dist, mu, theta)
.dprob.gt.0 = function(dist, mu, theta, link, lp) {
 switch(dist,
 binomial = stats::make.link(link)$mu.eta(lp),
 poisson = mu * exp(mu),
 negbin = mu * (theta /(mu + theta))^(1 + theta),
 geometric = mu / (1 + mu)^2
 )
}

# special version of .my.vcov that accepts (and requires!) model argument
.pscl.vcov = function(object, model, vcov. = stats::vcov, ...) {
 if (is.function(vcov.))
 vcov. = vcov.(object, model = model)
 else if (!is.matrix(vcov.))
 stop("vcov. must be a function or a square matrix")
 vcov.
}

# Explanatory notes for hurdle models
# 
# We have a linear predictor eta = X%*%beta + offset
# mu = h(eta) where h is inverse link (usually exp but not always)
# Define p = P(Y > 0  mu). This comes out to...
# binomial: mu
# poisson: 1  exp(mu)
# negbin: 1  (theta/(mu+theta))^theta
# geometric: 1  1/(mu+1)
# Define dp = dp/d(eta). Note  when h(mu)=exp(mu) we have dp = mu*dp/d(mu)
# binomial: h'(eta)
# poisson: mu*exp(mu)
# negbin: mu*(theta/(mu+theta))^(theta+1)
# geometric: mu/(mu+1)^2
#
# This gives us what we need to find the estimates and apply the delta method
# In the code we index these notations with 1 (count model) and 2 (zero model)
# And we treat theta1 and theta2 as constants
#
#!!! In theory, above seems correct, and estimates match those from predict.hurdle.
#!!! But SEs don't seem right.
#!!! They do seem right though if I omit the factor of mu in dp
#!!! when link is log
diff pruN 2.27623/R/glhtsupport.R 2.3001/R/glhtsupport.R
 2.27623/R/glhtsupport.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/glhtsupport.R 19700101 00:00:00.000000000 +0000
@@ 1,156 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### Code for an enhancement of 'glht' in 'multcomp' package
### Provides for using 'lsm' in similar way to 'mcp'
### This is implemented via the class "lsmlf"  linear functions for lsmeans
### (also oddly reminiscent of an old Lucky Strike commercial, LSMFT)

# lsm(specs) will be used as 'linfct' argument in glht
# all we need to do is class it and save the arguments
lsm < function(...) {
 result < list(...)
 class(result) < "lsmlf"
 result
}

# New S3 method for lsmlf objects
glht.lsmlf < function(model, linfct, ...) {
 # Pass the arguments we should pass to ref.grid:
 args = linfct
 args[[1]] = model
 names(args)[1] = "object"
 # Now pass the ref.grid to lsmeans:
 linfct$object < do.call("ref.grid", args)
 lsmo < do.call("lsmeans", linfct)
 if (is.list(lsmo))
 lsmo = lsmo[[length(lsmo)]]
 # Then call the method for lsmobj
 glht(model, lsmo, ...)
}


# S3 method for an lsmobj or ref.grid
# Note: model is redundant, really, so can be omitted
glht.ref.grid < function(model, linfct, by, ...) {
 if (!requireNamespace("multcomp"))
 stop(sQuote("glht")," requires ", dQuote("multcomp"), " to be installed")
 object = linfct # so I don't get confused
 if (missing(model))
 model = .cls.list("lsmwrap", object = object)
 args = list(model = model, ...)
 # add a df value if not supplied
 if (is.null(args$df)) {
 df = summary(linfct)$df
 if(any(!is.na(df))) {
 args$df = max(1, as.integer(mean(df, na.rm=TRUE) + .25))
 message("Note: df set to ", args$df)
 }
 }
 if (missing(by)) by = object@misc$by.vars

 nms = setdiff(names(object@grid), c(by, ".offset.", ".freq.", ".wgt."))
 if (is.null(object@misc$estHook))
 lf = object@linfct
 else # custom estimation setup  use the grid itself as the parameterization
 lf = diag(1, nrow(object@linfct))
 dimnames(lf)[[1]] = as.character(interaction(object@grid[, nms], sep=", "))

 if (is.null(by)) {
 args$linfct = lf
 return(do.call("glht", args))
 }

 # (else...)
 by.rows = .find.by.rows(object@grid, by)
 result = lapply(by.rows, function(r) {
 args$linfct = lf[r, , drop=FALSE]
 do.call("glht", args)
 })
 bylevs = lapply(by, function(byv) unique(object@grid[[byv]]))
 names(bylevs) = by
 bygrid = do.call("expand.grid", bylevs)
 levlbls = lapply(by, function(byv) paste(byv, "=", bygrid[[byv]]))
 levlbls$sep = ", "
 names(result) = do.call("paste", levlbls)
 class(result) = c("glht.list", "list")
 result
}

### as. glht  convert my object to glht object
as.glht < function(object, ...)
 UseMethod("as.glht")

as.glht.default < function(object, ...)
 stop("Cannot convert an object of class ", sQuote(class(object)[1]),
 " to a ", sQuote("glht"), " object")

as.glht.ref.grid < function(object, ...)
 glht( , object, ...)

as.glht.lsm.list < function(object, ..., which = 1)
 as.glht(object[[which]], ...)


# S3 modelparm method for lsmwrap (S3 wrapper for an lsmobj  see glht.lsmobj)
modelparm.lsmwrap < function(model, coef., vcov., df, ...) {
 object = model$object
 if (is.null(object@misc$estHook)) {
 bhat = object@bhat
 V = object@V
 }
 else { # Have custom vcov and est methods. Use the grid itself as parameterization
 bhat = predict(object)
 V = vcov(object)
 }
 if(missing(df)  is.na(df))
 df = 0
 .cls.list("modelparm", coef = bhat, vcov = V,
 df = df, estimable = !is.na(bhat))
 # This is NOT what we mean by 'estimable', but it is what glht wants...
}

# S3 methods for glht.list

### Doesn't work so excluded...
# cld.glht.list = function(object, ...)
# lapply(object, cld, ...)

coef.glht.list = function(object, ...)
 lapply(object, coef, ...)

confint.glht.list = function(object, ...)
 lapply(object, confint, ...)

plot.glht.list = function(x, ...)
 lapply(x, plot, ...)

summary.glht.list = function(object, ...)
 lapply(object, summary, ...)

vcov.glht.list = function(object, ...)
 lapply(object, vcov, ...)






diff pruN 2.27623/R/helpers.R 2.3001/R/helpers.R
 2.27623/R/helpers.R 20171104 20:51:32.000000000 +0000
+++ 2.3001/R/helpers.R 19700101 00:00:00.000000000 +0000
@@ 1,803 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### Helper functions for lsmeans
### Here we have 'recover.data' and 'lsm.basis' methods
### For models that this package supports.
#
### Recover data methods will return a data.frame with
### the original data, and at least these additional attrs:
# attr(, "terms")  terms component of object
# attr(, "responses")  names of response variable
# attr(, "predictors")  names of predictors
#
# generic version
recover.data = function(object, ...)
 UseMethod("recover.data")

#
### lsm.basis methods create a basis for the reference grid
#
# Required args:
# object  the model object
# trms  terms component of object
# xlev  named list of factor levels (but not the coerced ones)
# grid  reference grid
# All methods must return a list with these elements:
# X  basis for linear fcns over reference grid
# bhat  regression coefficients for fixed effects (INCLUDING any NAs)
# nbasis  matrix whose columns for a basis for nonestimable functions of beta; all.estble if none
# V  estimated covariance matrix of bhat
# dffun  function(k, dfargs) to find df for k'bhat having std error se
# dfargs  additional arguments, if any, for dffun
# misc  Extra info ...
#  if extra levels need to be added (e.g. mlm, polr),
# put them in misc$ylevs
#  For transformations or link fcns, use misc$tran
# for name (see 'make.link'), and use misc$inv.lbl
# for label to use in 'summary' when tran is inverted
# (ref.grid looks at lhs of model for tran if none found)
# Note: if no df exists, set dffun = function(...) NA and dfargs = list()
#
# generic version
lsm.basis = function(object, trms, xlev, grid, ...)
 UseMethod("lsm.basis")



#
### DEFAULT METHODS (we hit these when a model is NOT supported)
# I'll have it return the message if we caught the error in this way
# Then caller can use try() to check for other types of errors,
# and just print this message otherwise
recover.data.default = function(object, ...) {
 paste("Can't handle an object of class ", dQuote(class(object)[1]), "\n",
 paste(.show_supported(), collapse=""))
}

lsm.basis.default = function(object, trms, xlev, grid, ...) {
 stop("Can't handle an object of class", dQuote(class(object)[1]), "\n",
 .show_supported())
}

# Private fcn to get a list of supported objects
# does this by looking in namespace [ns] and methods [meth]
# then strips that off leaving extensions
.show_supported = function(ns = "lsmeans", meth = "lsm.basis") {
 "Use help(\"models\", package = \"lsmeans\") for information on supported models."
}


#
### call' objects
# This recover.data method serves as the workhorse for the others
# For model objects, call this with the object's call and its terms component
# Late addition: if data is nonnull, use it in place of recovered data
# Later addition: na.action arg req'd  vector of row indexes removed due to NAs
# na.action is ignored when data is nonNULL
recover.data.call = function(object, trms, na.action, data = NULL, params = NULL, ...) {
 fcall = object # because I'm easily confused
 vars = setdiff(.all.vars(trms), params)
 tbl = data
 if (length(vars) == 0) {
 tbl = data.frame(c(1,1))
 vars = names(tbl) = 1
 }
 if (is.null(tbl)) {
 m = match(c("formula", "data", "subset", "weights"), names(fcall), 0L)
 fcall = fcall[c(1L, m)]

 # check to see if there are any function calls to worry about
 # [e.g., subset = sample(1:n, 50) will give us a different subset than model used]
 mm = match(c("data", "subset"), names(fcall), 0L)
 if(any(mm > 0)) {
 fcns = unlist(lapply(fcall[mm],
 function(x) setdiff(all.names(x), c("::",":::","[[","]]",all.vars(x)))))
 if(max(nchar(c("", fcns))) > 1)
 warning("Function call in data or subset: ref.grid/lsmeans results may be inconsistent",
 call. = FALSE)
 }

 fcall$drop.unused.levels = TRUE
 fcall[[1L]] = as.name("model.frame")
 fcall$xlev = NULL # we'll ignore xlev

 if(!is.numeric(na.action)) ### In case na.action is not a vector of indices
 na.action = NULL

 # If we have an explicit list of cases to exclude, let everything through now
 if (!is.null(na.action))
 fcall$na.action = na.pass
 else # exclude incomplete cases
 fcall$na.action = na.omit
 form = reformulate(vars)
 fcall$formula = update(trms, form)
 env = environment(trms)
 if (is.null(env))
 env = parent.frame()
 tbl = eval(fcall, env, parent.frame())

 # Now we can drop na.action's rows
 if (!is.null(na.action))
 tbl = tbl[(na.action), , drop=FALSE]
 }

 else {
 tbl = tbl[, vars, drop = FALSE] # consider only the variables actually needed
 tbl = tbl[complete.cases(tbl), , drop=FALSE]
 }

 attr(tbl, "call") = object # the original call
 attr(tbl, "terms") = trms
 attr(tbl, "predictors") = setdiff(.all.vars(delete.response(trms)), params)
 attr(tbl, "responses") = setdiff(vars, union(attr(tbl, "predictors"), params))
 tbl
}


#
### lm objects (and also aov, rlm, others that inherit)  but NOT aovList
recover.data.lm = function(object, ...) {
 fcall = object$call
 recover.data(fcall, delete.response(terms(object)), object$na.action, ...)
}

lsm.basis.lm = function(object, trms, xlev, grid, ...) {
 # coef() works right for lm but coef.aov tosses out NAs
 bhat = object$coefficients
 nm = if(is.null(names(bhat))) row.names(bhat) else names(bhat)
 m = suppressWarnings(model.frame(trms, grid, na.action = na.pass, xlev = xlev))
 X = model.matrix(trms, m, contrasts.arg = object$contrasts)[, nm, drop = FALSE]
 bhat = as.numeric(bhat)
 # stretches it out if multivariate  see mlm method
 V = .my.vcov(object, ...)

 if (sum(is.na(bhat)) > 0)
 nbasis = estimability::nonest.basis(object$qr)
 else
 nbasis = estimability::all.estble
 misc = list()
 if (inherits(object, "glm")) {
 misc = .std.link.labels(object$family, misc)
 dffun = function(k, dfargs) NA
 dfargs = list()
 }
 else {
 dfargs = list(df = object$df.residual)
 dffun = function(k, dfargs) dfargs$df
 }
 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=misc)
}



#
### mlm objects
# (recover.data.lm works just fine)

lsm.basis.mlm = function(object, trms, xlev, grid, ...) {
 class(object) = c("mlm", "lm") # avoids error in vcov for "maov" objects
 bas = lsm.basis.lm(object, trms, xlev, grid, ...)
 bhat = coef(object)
 k = ncol(bhat)
 bas$X = kronecker(diag(rep(1,k)), bas$X)
 bas$nbasis = kronecker(rep(1,k), bas$nbasis)
 ylevs = dimnames(bhat)[[2]]
 if (is.null(ylevs)) ylevs = seq_len(k)
 bas$misc$ylevs = list(rep.meas = ylevs)
 bas
}



#
### merMod objects (lme4 package)
recover.data.merMod = function(object, ...) {
 if(!lme4::isLMM(object) && !lme4::isGLMM(object))
 return("Can't handle a nonlinear mixed model")
 fcall = object@call
 recover.data(fcall, delete.response(terms(object)),
 attr(object@frame, "na.action"), ...)
}

lsm.basis.merMod = function(object, trms, xlev, grid, vcov.,
 mode = get.lsm.option("lmer.df"), lmer.df, ...) {
 if (missing(vcov.))
 V = as.matrix(vcov(object, correlation = FALSE))
 else
 V = as.matrix(.my.vcov(object, vcov.))
 dfargs = misc = list()

 if (lme4::isLMM(object)) {
 # Allow user to specify mode as 'lmer.df'
 if (!missing(lmer.df))
 mode = lmer.df
 mode = match.arg(tolower(mode), c("satterthwaite", "kenwardroger", "asymptotic"))

 if (mode == "satterthwaite") {
 if (requireNamespace("lmerTest")) {
 dfargs = list(object = object)
 dffun = function(k, dfargs)
 suppressMessages(lmerTest::calcSatterth(dfargs$object, k)$denom)
 }
 else {
 message("Install package 'lmerTest' to obtain Satterthwaite degrees of freedom")
 mode = "asymptotic"
 }
 }
 else if (mode == "kenwardroger") {
 pbdis = .lsm.is.true("disable.pbkrtest")
 Nlim = get.lsm.option("pbkrtest.limit")
 objN = lme4::getME(object, "N")
 toobig = objN > Nlim
 if (!pbdis && !toobig && requireNamespace("pbkrtest") && missing(vcov.)) {
 dfargs = list(unadjV = V,
 adjV = pbkrtest::vcovAdj.lmerMod(object, 0))
 V = as.matrix(dfargs$adjV)
 tst = try(pbkrtest::Lb_ddf)
 if(class(tst) != "tryerror")
 dffun = function(k, dfargs) pbkrtest::Lb_ddf (k, dfargs$unadjV, dfargs$adjV)
 else {
 mode = "asymptotic"
 warning("To obtain d.f., install 'pbkrtest' version 0.41 or later")
 }
 }
 else {
 if(!pbdis && !("pbkrtest" %in% row.names(installed.packages())))
 message("Install package 'pbkrtest' to obtain bias corrections and degrees of freedom")
 else if(toobig)
 message("Note: Adjusted covariance and degreesoffreedom calculations have been\n",
 "disabled because the number of observations exceeds ", Nlim, ".\n",
 "Standard errors and tests may be more biased than if they were adjusted.\n",
 "To enable adjustments, set lsm.options(pbkrtest.limit = ", objN, ") or larger,\n",
 "but be warned that this may result in large computation time and memory use.")
 mode = "asymptotic"
 }
 }
 if (mode == "asymptotic") {
 dffun = function(k, dfargs) NA
 }
 misc$initMesg = paste("Degreesoffreedom method:", mode)
 }
 else if (lme4::isGLMM(object)) {
 dffun = function(k, dfargs) NA
 misc = .std.link.labels(family(object), misc)
 }
 else
 stop("Can't handle a nonlinear mixed model")

 contrasts = attr(object@pp$X, "contrasts")
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = contrasts)
 bhat = lme4::fixef(object)

 if (length(bhat) < ncol(X)) {
 # Newer versions of lmer can handle rank deficiency, but we need to do a couple of
 # backflips to put the pieces together right,
 # First, figure out which columns were retained
 kept = match(names(bhat), dimnames(X)[[2]])
 # Now redo bhat with NAs in the right places
 bhat = NA * X[1, ]
 bhat[kept] = lme4::fixef(object)
 # we have to reconstruct the model matrix
 modmat = model.matrix(trms, object@frame, contrasts.arg=contrasts)
 nbasis = estimability::nonest.basis(modmat)
 }
 else
 nbasis=estimability::all.estble

 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=misc)
}



# lme4.0 support removed because CRAN really doesn't want it supported
#
# ### mer objects (from old lme4 version, now lme4.0)
# ### reenabled; CRAN check now seems to work with multiple add'l repositories
#
# recover.data.mer = function(object, ...) {
# if(!lme4.0::isLMM(object) && !lme4.0::isGLMM(object))
# return("Can't handle a nonlinear mixed model")
# fcall = object@call
# recover.data(fcall, delete.response(terms(object)),
# attr(object@frame, "na.action"), ...)
# }
#
# # Does NOT support pbkrtest capabilities. Uses asymptotic methods
# lsm.basis.mer = function(object, trms, xlev, grid, ...) {
# V = as.matrix(.my.vcov(object, ...))
# dfargs = misc = list()
# if (lme4.0::isLMM(object)) {
# dffun = function(k, dfargs) NA
# }
# else if (lme4.0::isGLMM(object)) {
# dffun = function(k, dfargs) NA
# # need to work harder as there is no 'family' method
# cfam = object@call$family
# if (is.name(cfam))
# fam = eval(cfam)()
# else
# fam = eval(cfam)
# misc = .std.link.labels(fam, misc)
# }
# else
# stop("Can't handle a nonlinear mixed model")
#
# contrasts = attr(object@X, "contrasts")
# m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
# X = model.matrix(trms, m, contrasts.arg = contrasts)
# bhat = lme4.0::fixef(object)
# nbasis=estimability::all.estble
#
# list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=misc)
# }




#
### lme objects (nlme package)
recover.data.lme = function(object, data, ...) {
 fcall = object$call
 if (!is.null(fcall$weights))
 fcall$weights = nlme::varWeights(object$modelStruct)
 recover.data(fcall, delete.response(terms(object)), object$na.action, data = data, ...)
}

lsm.basis.lme = function(object, trms, xlev, grid, sigmaAdjust = TRUE, ...) {
 contrasts = object$contrasts
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = contrasts)
 bhat = nlme::fixef(object)
 V = .my.vcov(object, ...)
 if (sigmaAdjust && object$method == "ML")
 V = V * object$dims$N / (object$dims$N  nrow(V))
 misc = list()
 if (!is.null(object$family)) {
 misc = .std.link.labels(object$family, misc)
 }
 nbasis = estimability::all.estble
 # Replaced by containment method##dffun = function(...) NA
 dfx = object$fixDF$X
 if (names(bhat[1]) == "(Intercept)")
 dfx[1] = length(levels(object$groups[[1]]))  1#min(dfx) ### Correct apparent error in lme containment algorithm
 dffun = function(x, dfargs) {
 idx = which(abs(x) > 1e4)
 ifelse(length(idx) > 0, min(dfargs$dfx[idx]), NA)
 }
 list(X = X, bhat = bhat, nbasis = nbasis, V = V,
 dffun = dffun, dfargs = list(dfx = dfx), misc = misc)
}



#
### gls objects (nlme package)
recover.data.gls = function(object, ...) {
 fcall = object$call
 if (!is.null(fcall$weights))
 fcall$weights = nlme::varWeights(object$modelStruct)
 recover.data(fcall, delete.response(nlme::getCovariateFormula(object)),
 object$na.action, ...)
}

lsm.basis.gls = function(object, trms, xlev, grid, ...) {
 contrasts = object$contrasts
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = contrasts)
 bhat = coef(object)
 V = .my.vcov(object, ...)
 nbasis = estimability::all.estble
 dfargs = list(df = object$dims$N  object$dims$p)
 dffun = function(k, dfargs) dfargs$df
 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=list())
}



#
### polr objects (MASS package)
recover.data.polr = recover.data.lm

lsm.basis.polr = function(object, trms, xlev, grid,
 mode = c("latent", "linear.predictor", "cum.prob", "exc.prob", "prob", "mean.class"),
 rescale = c(0,1), ...) {
 mode = match.arg(mode)
 contrasts = object$contrasts
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = contrasts)
 # Strip out the intercept (borrowed code from predict.polr)
 xint = match("(Intercept)", colnames(X), nomatch = 0L)
 if (xint > 0L)
 X = X[, xint, drop = FALSE]
 bhat = c(coef(object), object$zeta)
 V = .my.vcov(object, ...)
 k = length(object$zeta)
 if (mode == "latent") {
 X = rescale[2] * cbind(X, matrix( 1/k, nrow = nrow(X), ncol = k))
 bhat = c(coef(object), object$zeta  rescale[1] / rescale[2])
 misc = list(offset.mult = rescale[2])
 }
 else {
 j = matrix(1, nrow=k, ncol=1)
 J = matrix(1, nrow=nrow(X), ncol=1)
 X = cbind(kronecker(j, X), kronecker(diag(1,k), J))
 link = object$method
 if (link == "logistic") link = "logit"
 misc = list(ylevs = list(cut = names(object$zeta)),
 tran = link, inv.lbl = "cumprob", offset.mult = 1)
 if (mode != "linear.predictor") {
 # just use the machinery we already have for the 'ordinal' package
 misc$mode = mode
 misc$postGridHook = ".clm.postGrid"
 }
 }
 misc$respName = as.character(terms(object))[2]
 nbasis = estimability::all.estble
 dffun = function(...) NA
 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=list(), misc=misc)
}




#
### survreg objects (survival package)
recover.data.survreg = function(object, ...) {
 fcall = object$call
 trms = delete.response(terms(object))
 # I'm gonna delete any terms involving strata(), cluster(), or frailty()
 mod.elts = dimnames(attr(trms, "factor"))[[2]]
 tmp = grep("strata\\(cluster\\(frailty\\(", mod.elts)
 if (length(tmp))
 trms = trms[tmp]
 recover.data(fcall, trms, object$na.action, ...)
}

# Seems to work right in a little testing.
# However, it fails sometimes if I update the model
# with a subset argument. Workaround: just fitting a new model
lsm.basis.survreg = function(object, trms, xlev, grid, ...) {
 # Much of this code is adapted from predict.survreg
 bhat = object$coefficients
 k = length(bhat)
 V = .my.vcov(object, ...)[seq_len(k), seq_len(k), drop=FALSE]
 # ??? not used... is.fixeds = (k == ncol(object$var))
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 # X = model.matrix(object, m) # This is what predict.survreg does
 # But I have manipulated trms, so need to make sure things are consistent
 X = model.matrix(trms, m, contrasts.arg = object$contrasts)
 nbasis = estimability::nonest.basis(model.matrix(object))
 dfargs = list(df = object$df.residual)
 dffun = function(k, dfargs) dfargs$df
 if (object$dist %in% c("exponential","weibull","loglogistic","loggaussian","lognormal"))
 misc = list(tran = "log", inv.lbl = "response")
 else
 misc = list()
 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=misc)
}



#
### coxph objects (survival package)
recover.data.coxph = function(object, ...)
 recover.data.survreg(object, ...)

lsm.basis.coxph = function (object, trms, xlev, grid, ...)
{
 object$dist = "doesn't matter"
 result = lsm.basis.survreg(object, trms, xlev, grid, ...)
 result$dfargs$df = NA
 result$X = result$X[, 1, drop = FALSE]
 result$X = result$X  rep(object$means, each = nrow(result$X))
 result$misc$tran = "log"
 result$misc$inv.lbl = "hazard"
 result
}

# Note: Very brief experimentation suggests coxph.penal also works.
# This is an extension of coxph


#
### coxme objects ####
### Greatly revised 61515 (after version 2.18)
recover.data.coxme = function(object, ...)
 recover.data.survreg(object, ...)

lsm.basis.coxme = function(object, trms, xlev, grid, ...) {
 bhat = fixef(object)
 k = length(bhat)
 V = .my.vcov(object, ...)[seq_len(k), seq_len(k), drop = FALSE]
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m)
 X = X[, 1, drop = FALSE] # remove the intercept
 # scale the linear predictor
 for (j in seq_along(X[1, ]))
 X[, j] = (X[, j]  object$means[j]) ### / object$scale[j]
 nbasis = estimability::all.estble
 dffun = function(k, dfargs) NA
 misc = list(tran = "log", inv.lbl = "hazard")
 list(X = X, bhat = bhat, nbasis = nbasis, V = V, dffun = dffun,
 dfargs = list(), misc = misc)
}


### special vcov prototype for cases where there are several vcov options
### e.g., gee, geeglm, geese
.named.vcov = function(object, method, ...)
 UseMethod(".named.vcov")

# default has optional idx of same length as valid and if so, idx indicating
# which elt of valid to use if matched
# Ex: valid = c("mammal", "fish", "rat", "dog", "trout", "perch")
# idx = c( 1, 2, 1, 1, 2, 2)
#  so ultimately results can only be "mammal" or "fish"
# nonmatches revert to 1st elt.
.named.vcov.default = function(object, method, valid, idx = seq_along(valid), ...) {
 if (!is.character(method)) { # in case vcov. arg was matched by vcov.method {
 V = .my.vcov(object, method)
 method = "usersupplied"
 }
 else {
 i = pmatch(method, valid, 1)
 method = valid[idx[i]]
 V = object[[method]]
 }
 attr(V, "methMesg") = paste("Covariance estimate used:", method)
 V
}

# generalpurpose lsm.basis function
.lsmb.geeGP = function(object, trms, xlev, grid, vcov.method, valid, idx = seq_along(valid), ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = object$contrasts)
 bhat = coef(object)
 V = .named.vcov(object, vcov.method, valid, idx, ...)

 if (sum(is.na(bhat)) > 0)
 nbasis = estimability::nonest.basis(object$qr)
 else
 nbasis = estimability::all.estble

 misc = .std.link.labels(object$family, list())
 misc$initMesg = attr(V, "methMesg")
 dffun = function(k, dfargs) NA
 dfargs = list()
 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=misc)
}

#
### gee objects ####


recover.data.gee = recover.data.lm

lsm.basis.gee = function(object, trms, xlev, grid, vcov.method = "robust.variance", ...)
 .lsmb.geeGP(object, trms, xlev, grid, vcov.method,
 valid = c("robust.variance", "naive.variance"))

### geepack objects ####
recover.data.geeglm = recover.data.lm

lsm.basis.geeglm = function(object, trms, xlev, grid, vcov.method = "vbeta", ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = object$contrasts)
 bhat = coef(object)
 V = .named.vcov(object$geese, vcov.method,
 valid = c("vbeta", "vbeta.naiv","vbeta.j1s","vbeta.fij","robust","naive"),
 idx = c(1,2,3,4,1,2))

 if (sum(is.na(bhat)) > 0)
 nbasis = estimability::nonest.basis(object$qr)
 else
 nbasis = estimability::all.estble

 misc = .std.link.labels(object$family, list())
 misc$initMesg = attr(V, "methMesg")
 dffun = function(k, dfargs) NA
 dfargs = list()
 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=misc)
}


recover.data.geese = function(object, ...) {
 fcall = object$call
 # what a pain  we need to reconstruct the terms component
 args = as.list(fcall[1])
 na.action = object$na.action
 #trms = terms.formula(fcall$formula)
 if (!is.null(args$data)) {
 data = eval(args$data, parent.frame())
 trms = terms(model.frame(fcall$formula, data = data))
 } else {
 trms = terms(model.frame(fcall$formula))
 }
 recover.data(fcall, delete.response(trms), na.action, ...)
}

lsm.basis.geese = function(object, trms, xlev, grid, vcov.method = "vbeta", ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = object$contrasts)
 bhat = object$beta
 V = .named.vcov(object, vcov.method,
 valid = c("vbeta", "vbeta.naiv","vbeta.j1s","vbeta.fij","robust","naive"),
 idx = c(1,2,3,4,1,2))

 # We don't have the qr component  I'm gonna punt for now
 if (sum(is.na(bhat)) > 0)
 warning("There are nonestimable functions, but estimability is NOT being checked")
# nbasis = estimability::nonest.basis(object$qr)
# else
 nbasis = estimability::all.estble

 misc = list()
 if (!is.null(fam < object$call$family))
 misc = .std.link.labels(eval(fam)(), misc)
 misc$initMesg = attr(V, "methMesg")
 dffun = function(k, dfargs) NA
 dfargs = list()
 list(X=X, bhat=bhat, nbasis=nbasis, V=V, dffun=dffun, dfargs=dfargs, misc=misc)
}



#
### afex package  mixed objects ###
# just need to provide an 'lsmeans' method here, assuming Henrik adds the 'data' item

### These are deprecated as of afex 0.14  now afex has its own lsmeans support

# recover.data.mixed = function(object, ...) {
# recover.data.merMod(object$full.model, ...)
# }
#
# lsm.basis.mixed = function(object, trms, xlev, grid, ...) {
# lsm.basis.merMod(object$full.model, trms, xlev, grid, ...)
# }


#
### glmmADMB package

recover.data.glmmadmb = recover.data.lm

lsm.basis.glmmadmb = function (object, trms, xlev, grid, ...)
{
 contrasts = object$contrasts
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = contrasts)
 bhat = glmmADMB::fixef(object)
 V = .my.vcov(object, ...)
 misc = list()
 if (!is.null(object$family)) {
 fam = object$family
 misc$tran = object$link
 misc$inv.lbl = "response"
 if (!is.na(pmatch(fam,"binomial")))
 misc$inv.lbl = "prob"
 else if (!is.na(pmatch(fam,"poisson")))
 misc$inv.lbl = "rate"
 }
 nbasis = estimability::all.estble
 dffun = function(...) NA
 list(X = X, bhat = bhat, nbasis = nbasis, V = V, dffun = dffun,
 dfargs = list(), misc = misc)
}


# 
### Explicit nonsupport for 'gam' objects (runs, but results are wrong)

lsm.basis.gam = function(object, trms, xlev, grid, ...) {
 stop("Can't handle an object of class", dQuote(class(object)[1]), "\n",
 .show_supported())
}


#
### mgcv package 

# gam  OK  inherits from glm

# gamm
# recover.data.gamm = function(object, ...) {
# fcall = object$lme$call
# recover.data(fcall, delete.response(terms(object$lme)), object$lme$na.action, ...)
# }
#
# lsm.basis.gamm = function (object, trms, xlev, grid, sigmaAdjust = TRUE, ...) {
# lsm.basis(object$lme, trms, xlev, grid, sigmaAdjust, ...)
# # Doesn't work because needs the matrices in object$lme$data
# }






###  Auxiliary routines 
# Provide for vcov. argument in ref.grid call, which could be a function or a matrix

.my.vcov = function(object, vcov. = function(object)
 stats::vcov(object, complete = FALSE), ...) {
 if (is.function(vcov.))
 vcov. = vcov.(object)
 else if (!is.matrix(vcov.))
 stop("vcov. must be a function or a square matrix")
 vcov.
}

# Call this to do the standard stuff with link labels
# Returns a modified misc
.std.link.labels = function(fam, misc) {
 if (is.null(fam))
 return(misc)
 if (fam$link == "identity")
 return(misc)
 misc$tran = fam$link
 misc$inv.lbl = "response"
 if (length(grep("binomial", fam$family)) == 1)
 misc$inv.lbl = "prob"
 else if (length(grep("poisson", fam$family)) == 1)
 misc$inv.lbl = "rate"
 misc
}

## Alternative to all.vars, but keeps vars like foo$x and foo[[1]] asis
## Passes ... to all.vars
.all.vars = function(expr, retain = c("\\$", "\\[\\[", "\\]\\]"), ...) {
 if (is.null(expr))
 return(character(0))
 if (!inherits(expr, "formula")) {
 expr = try(eval(expr), silent = TRUE)
 if(inherits(expr, "tryerror")) {
 return(character(0))
 }
 }
 repl = paste("_Av", seq_along(retain), "_", sep = "")
 for (i in seq_along(retain))
 expr = gsub(retain[i], repl[i], expr)
 subs = switch(length(expr), 1, c(1,2), c(2,1,3))
 vars = all.vars(as.formula(paste(expr[subs], collapse = "")), ...)
 retain = gsub("\\\\", "", retain)
 for (i in seq_along(retain))
 vars = gsub(repl[i], retain[i], vars)
 if(length(vars) == 0) vars = "1" # no vars > intercept
 vars
}


### Notsodamnsmart replacement of diag() that will
### not be so quick to assume I want an identity matrix
### returns matrix(x) when x is a scalar
.diag = function(x, nrow, ncol) {
 if(is.matrix(x))
 diag(x)
 else if((length(x) == 1) && missing(nrow) && missing(ncol))
 matrix(x)
 else
 diag(x, nrow, ncol)
}


diff pruN 2.27623/R/lsmcontr.R 2.3001/R/lsmcontr.R
 2.27623/R/lsmcontr.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/lsmcontr.R 19700101 00:00:00.000000000 +0000
@@ 1,213 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### functions to implement different families of contrasts
### All return a matrix or data frame whose columns are the desired contrasts coefs
### with appropriate row and column names
### Also they have two attributes:
### "desc" is an expanded description of the family,
### "adjust" is the default multiplicity adjustment (used if adjust="auto" in lsmeans)

# all pairwise trt[i]  trt[j], i < j
pairwise.lsmc = function(levs,...) {
 k = length(levs)
 M = data.frame(levs=levs)
 for (i in seq_len(k1)) {
 for (j in (i + seq_len(ki))) { ###for (j in (i+1):k) {
 con = rep(0,k)
 con[i] = 1
 con[j] = 1
 nm = paste(levs[i], levs[j], sep = "  ")
 M[[nm]] = con
 }
 }
 row.names(M) = levs
 M = M[1]
 attr(M, "desc") = "pairwise differences"
 attr(M, "adjust") = "tukey"
 attr(M, "type") = "pairs"
 M
}

# all pairwise trt[j]  trt[i], j > i
revpairwise.lsmc = function(levs,...) {
 k = length(levs)
 M = data.frame(levs=levs)
 for (i in 2:k) {
 for (j in seq_len(i1)) {
 con = rep(0,k)
 con[i] = 1
 con[j] = 1
 nm = paste(levs[i], levs[j], sep = "  ")
 M[[nm]] = con
 }
 }
 row.names(M) = levs
 M = M[1]
 attr(M, "desc") = "pairwise differences"
 attr(M, "adjust") = "tukey"
 attr(M, "type") = "pairs"
 M
}

# pseudonym
tukey.lsmc = function(levs, reverse = FALSE) {
 if (reverse)
 revpairwise.lsmc(levs)
 else
 pairwise.lsmc(levs)
}

# Poly contrasts  scaled w/ integer levels like most tables
# ad hoc scaling works for up to 13 levels
poly.lsmc = function(levs, max.degree=min(6,k1)) {
 nm = c("linear", "quadratic", "cubic", "quartic", paste("degree",5:20))
 k = length(levs)
 M = as.data.frame(poly(seq_len(k), min(20,max.degree)))
 for (j in seq_len(ncol(M))) {
 con = M[ ,j]
 pos = which(con > .01)
 con = con / min(con[pos])
 z = max(abs(con  round(con)))
 while (z > .05) {
 con = con / z
 z = max(abs(con  round(con)))
 }
 M[ ,j] = round(con)
 }
 row.names(M) = levs
 names(M) = nm[seq_len(ncol(M))]
 attr(M, "desc") = "polynomial contrasts"
 attr(M, "adjust") = "none"
 M
}

# All comparisons with a control; ref = index of control group
# New version  allows more than one control group (ref is a vector)
trt.vs.ctrl.lsmc = function(levs, ref=1) {
 if ((min(ref) < 1)  (max(ref) > length(levs)))
 stop("Reference levels are out of range")
 k = length(levs)
 cnm = ifelse(length(ref)==1,
 levs[ref],
 paste("avg(", paste(levs[ref], collapse=","), ")", sep=""))
 templ = rep(0, length(levs))
 templ[ref] = 1 / length(ref)
 M = data.frame(levs=levs)
 for (i in seq_len(k)) {
 if (i %in% ref) next
 con = templ
 con[i] = 1
 nm = paste(levs[i], cnm, sep = "  ")
 M[[nm]] = con
 }
 row.names(M) = levs
 M = M[1]
 attr(M, "desc") = "differences from control"
 attr(M, "adjust") = "dunnettx"
 M
}

# control is 1st level
trt.vs.ctrl1.lsmc = function(levs, ...) {
 trt.vs.ctrl.lsmc(levs, ref = 1)
}

# control is last level
trt.vs.ctrlk.lsmc = function(levs, ...) {
 trt.vs.ctrl.lsmc(levs, ref = length(levs))
}

# pseudonym
dunnett.lsmc = function(levs, ref = 1) {
 trt.vs.ctrl.lsmc(levs, ref = ref)
}

# effects contrasts. Each mean versus the average of all
eff.lsmc = function(levs, ...) {
 k = length(levs)
 M = data.frame(levs=levs)
 for (i in seq_len(k)) {
 con = rep(1/k, k)
 con[i] = (k1)/k
 nm = paste(levs[i], "effect")
 M[[nm]] = con
 }
 row.names(M) = levs
 M = M[1]
 attr(M, "desc") = "differences from grand mean"
 attr(M, "adjust") = "fdr"
 M
}

# "deleted" effects contrasts.
# Each mean versus the average of all others
del.eff.lsmc = function(levs, ...) {
 k = length(levs)
 M = as.matrix(eff.lsmc(levs,...)) * k / (k1)
 M = as.data.frame(M)
 attr(M, "desc") = "differences from mean of others"
 attr(M, "adjust") = "fdr"
 M
}

# Contrasts to compare consecutive levels:
# (1,1,0,0,...), (0,1,1,0,...), ..., (0,...0,1,1)
consec.lsmc = function(levs, reverse = FALSE, ...) {
 sgn = ifelse(reverse, 1, 1)
 k = length(levs)
 M = data.frame(levs=levs)
 for (i in seq_len(k1)) {
 con = rep(0, k)
 con[i] = sgn
 con[i+1] = sgn
 nm = ifelse(reverse,
 paste(levs[i], "", levs[i+1]),
 paste(levs[i+1], "", levs[i]))
 M[[nm]] = con
 }
 row.names(M) = levs
 M = M[1]
 attr(M, "desc") = "changes between consecutive levels"
 attr(M, "adjust") = "mvt"
 M
}

# Mean after minus mean before
# e.g., (1, 1/3,1/3,1/3), (1/2,1/2, 1/2,1/2), (1/3,1/3,1/3, 1)
mean_chg.lsmc = function(levs, reverse = FALSE, ...) {
 sgn = ifelse(reverse, 1, 1)
 k = length(levs)
 M = data.frame(levs=levs)
 for (i in seq_len(k1)) {
 kmi = k  i
 con = rep(c(sgn/i, sgn/kmi), c(i, kmi))
 nm = paste(levs[i], levs[i+1], sep="")
 M[[nm]] = con
 }
 row.names(M) = levs
 M = M[1]
 attr(M, "desc") = "mean after minus mean before"
 attr(M, "adjust") = "mvt"
 M
}


diff pruN 2.27623/R/lsmeans.R 2.3001/R/lsmeans.R
 2.27623/R/lsmeans.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/lsmeans.R 19700101 00:00:00.000000000 +0000
@@ 1,706 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# lsmeans and related functions

# Utility to pick out the args that can be passed to a function
.args.for.fcn = function(fcn, args) {
 oknames = names(as.list(args(fcn)))
 mat = pmatch(names(args), oknames)
 args = args[!is.na(mat)]
 mat = mat[!is.na(mat)]
 names(args) = oknames[mat]
 args
}

# Create a list and give it class class.name
.cls.list < function(class.name, ...) {
 result < list(...)
 class(result) < c(class.name, "list")
 result
}

setMethod("show", "lsmobj",
 function(object) print(summary(object)) )



### lsmeans S3 generics ...
### I am opting to use S3 methods, cascaded for two arguments
### rather than messing with S4 methods

lsmeans = function(object, specs, ...)
 UseMethod("lsmeans", specs)

#
lsmeans.default = function(object, specs, nesting, ...) {
 rgargs = list(object = object, ...) ####.args.for.fcn(ref.grid, list(object=object, ...))
 rgargs$options = NULL # don't pass options to ref.grid
 if (!missing(nesting))
 rgargs$nesting = nesting
 RG = do.call("ref.grid", rgargs)
 lsargs = list(object = RG, specs = specs, ...)
 #for (nm in names(rgargs)[1]) lsargs[[nm]] = NULL
 do.call("lsmeans", lsargs)###lsmeans(RG, specs, ...)
}

lsmeans.formula =
function(object, specs, contr.list, trend, ...) {
 if (!missing(trend))
 return(lstrends(object, specs, var=trend, ...))

 if(length(specs) == 2) { # just a rhs
 by = .find.by(as.character(specs[2]))
 lsmeans(object, .all.vars(specs), by = by, ...)
 }
 else {
# lsms = lsmeans(object, .all.vars(specs[2]), ...)
 contr.spec = .all.vars(specs[3])[1]
 by = .find.by(as.character(specs[3]))
 # Handle oldstyle case where contr is a list of lists
 if (!missing(contr.list)) {
 cmat = contr.list[[contr.spec]]
 if (!is.null(cmat))
 contr.spec = cmat
 }
 lsmeans(object, specs = .all.vars(specs[2]),
 by = by, contr = contr.spec, ...)
 }
}

# List of specs
lsmeans.list = function(object, specs, ...) {
 result = list()
 nms = names(specs)
 # Format a string describing the results
 .make.desc = function(meth, pri, by) {
 pri = paste(pri, collapse = ", ")
 desc = paste(meth, "of", pri)
 if (!is.null(by)) {
 by = paste(by, collapse = ", ")
 desc = paste(desc, "", by)
 }
 desc
 }

 for (i in seq_len(length(specs))) {
 res = lsmeans(object=object, specs = specs[[i]], ...)
 nm = nms[i]
 if (is.data.frame(res)) { # happens e.g. when cld is used
 if (is.null(nm))
 nm = .make.desc("summary", attr(res, "pri.vars"), attr(res, "by.vars"))
 result[[nm]] = res
 }
 else if (is.list(res)) {
 for (j in seq_len(length(res))) {
 m = res[[j]]@misc
 if (is.null(nm))
 names(res)[j] = .make.desc(m$methDesc, m$pri.vars, m$by.vars)
 else
 names(res)[j] = paste(nm, m$methDesc)
 }
 result = c(result,res)
 }
 else{
 if (is.null(nm))
 nm = .make.desc(res@misc$methDesc, res@misc$pri.vars, res@misc$by.vars)
 result[[nm]] = res
 }
 }
 class(result) = c("lsm.list", "list")
 result
}


# Generic for after we've gotten specs in character form
lsmeans.character = function(object, specs, ...) {
 UseMethod("lsmeans.character")
}

# Needed for model objects
lsmeans.character.default = function(object, specs, trend, ...) {
 if (!missing(trend)) {
 .Deprecated("lsmeans::lstrends()", "lsmeans",
 "The `trend` argument is being deprecated use `lstrends()` instead.")
 lstrends(object, specs, var = trend, ...)
 }
 else
 lsmeans.default(object, specs, ...)
}

# Method for a ref.grid  all methods will get us here eventually
lsmeans.character.ref.grid = function(object, specs, by = NULL,
 fac.reduce = function(coefs) apply(coefs, 2, mean),
 contr, options = getOption("lsmeans")$lsmeans, weights, trend, ...) {

 if (!missing(trend)) {
 stop("Trend results require supplying the model object itself, not a reference grid")
 # message("Refitting the model. Avoid this by calling lsmeans with the model object.")
 # cl = match.call()
 # cl[[1]] = as.name("lstrends")
 # cl$model = object@model.info$call
 # cl$var = trend
 # cl$object = cl$trend = NULL
 # return(eval(cl))
 }

 if(is.null(nesting < object@model.info$nesting))
 {
 RG = object
 facs = union(specs, by)

 # Check that grid is complete
 # This isn't a 100% reliable check, but...
 if(nrow(RG@grid) != prod(sapply(RG@levels, length)))
 stop("Irregular reference grid: Marginal means cannot be determined")

 if ((length(facs) == 1) && (facs == "1")) { ### just want grand mean
 RG@levels[["1"]] = "overall"
 RG@grid[ ,"1"] = 1
 }


 # Figure out the structure of the grid
 wgt = RG@grid[[".wgt."]]
 if(!is.null(wgt) && all(zapsmall(wgt) == 0)) wgt = wgt + 1 ### repl all zero wgts with 1
 dims = sapply(RG@levels, length)
 row.idx = array(seq_len(nrow(RG@linfct)), dims)
 use.mars = match(facs, names(RG@levels)) # which margins to use
 avgd.mars = setdiff(seq_along(dims)[dims>1], use.mars) # margins that we average over

 # Reconcile weights, if there are any margins left
 if ((length(avgd.mars) > 0) && !missing(weights)) {
 if (is.character(weights)) {
 if (is.null(wgt))
 warning("'weights' requested but no weighting information is available")
 else {
 wopts = c("equal","proportional","outer","cells","flat","show.levels","invalid")
 weights = switch(wopts[pmatch(weights, wopts, 7)],
 equal = rep(1, prod(dims[avgd.mars])),
 proportional = as.numeric(plyr::aaply(row.idx, avgd.mars,
 function(idx) sum(wgt[idx]))),
 outer = {
 ftbl = plyr::aaply(row.idx, avgd.mars,
 function(idx) sum(wgt[idx]), .drop = FALSE)
 w = N = sum(ftbl)
 for (d in seq_along(dim(ftbl)))
 w = outer(w, plyr::aaply(ftbl, d, sum) / N)
 as.numeric(w)
 },
 cells = "fq",
 flat = "fl",
 show.levels = {
 cat("lsmeans are obtained by averaging over these factor combinations\n")
 return(do.call(expand.grid, RG@levels[avgd.mars]))
 },
 invalid = stop("Invalid 'weights' option: '", weights, "'")
 )
 }
 }
 if (is.matrix(weights)) {
 wtrow = 0
 fac.reduce = function(coefs) {
 wtmat = .diag(weights[wtrow+1, ]) / sum(weights[wtrow+1, ])
 ans = apply(wtmat %*% coefs, 2, sum)
 wtrow << (1 + wtrow) %% nrow(weights)
 ans
 }
 }
 else if (is.numeric(weights)) {
 wtmat = .diag(weights)
 wtsum = sum(weights)
 if (wtsum <= 1e8) wtsum = NA
 fac.reduce = function(coefs) {
 if (nrow(coefs) != nrow(wtmat))
 stop("Nonconforming number of weights  need ", nrow(coefs))
 apply(wtmat %*% coefs, 2, sum) / wtsum
 }
 }
 }

 # Get the required factor combs
 levs = list()
 for (f in facs) {
 levs[[f]] = RG@levels[[f]]
 if (!hasName(levs, f))
 stop(paste("No variable named", f, "in the reference grid"))
 }
 combs = do.call("expand.grid", levs)
 if (!missing(weights) && (weights %in% c("fq", "fl")))
 K = plyr::alply(row.idx, use.mars, function(idx) {
 fq = RG@grid[[".wgt."]][idx]
 if (weights == "fl")
 fq = 0 + (fq > 0) # fq = 1 if > 0, else 0
 apply(.diag(fq) %*% RG@linfct[idx, , drop=FALSE], 2, sum) / sum(fq)
 })
 else
 K = plyr::alply(row.idx, use.mars, function(idx) {
 fac.reduce(RG@linfct[idx, , drop=FALSE])
 })

 linfct = t(as.matrix(as.data.frame(K)))
 row.names(linfct) = NULL

 if(.some.term.contains(union(facs, RG@roles$trend), RG@model.info$terms))
 message("NOTE: Results may be misleading due to involvement in interactions")

 # Figure offset, if any
 if (hasName(RG@grid, ".offset.")) {
 combs[[".offset."]] = as.numeric(plyr::aaply(row.idx, use.mars, function(idx)
 fac.reduce(as.matrix(RG@grid[idx, ".offset.", drop=FALSE]))))
 }

 avgd.over = names(RG@levels[avgd.mars])

 # Update .wgt column of grid, if it exists
 if (!is.null(wgt)) {
 combs[[".wgt."]] = as.numeric(plyr::aaply(row.idx, use.mars,
 function(idx) sum(wgt[idx])))
 }

 RG@roles$responses = character()
 RG@misc$famSize = nrow(linfct)
 if(RG@misc$estName == "prediction")
 RG@misc$estName = "lsmean"
 RG@misc$adjust = "none"
 RG@misc$infer = c(TRUE,FALSE)
 RG@misc$pri.vars = setdiff(facs, by)
 RG@misc$by.vars = by
 RG@misc$avgd.over = union(RG@misc$avgd.over, avgd.over)
 RG@misc$methDesc = "lsmeans"
 RG@roles$predictors = names(levs)
 result = new("lsmobj", RG, linfct = linfct, levels = levs, grid = combs)


 if(!is.null(options)) {
 options$object = result
 result = do.call("update.ref.grid", options)
 }
 }

 else { # handle a nested structure
 object@model.info$nesting = NULL
 result = .nested_lsm(object, specs, by = by, fac.reduce = fac.reduce,
 options = options, weights = weights, ..., nesting = nesting)
 }


 if(!missing(contr)) { # return a list with lsmeans and contrasts
 if (is.character(contr) && contr == "cld") {
 # TO DO: provide for passing dots to cld
 return(cld(result, by = by))
 }
 ctrs = contrast(result, method = contr, by = by, ...)
 result = .cls.list("lsm.list", lsmeans = result, contrasts = ctrs)
 if(!is.null(lbl < object@misc$methDesc))
 names(result)[1] = lbl
 }

 result
}



# utility to parse 'by' part of a formula
.find.by = function(rhs) {
 b = strsplit(rhs, "\\")[[1]]
 if (length(b) > 1)
 .all.vars(as.formula(paste("~",b[2])))
 else NULL
}

### 'contrast' S3 generic and method
contrast = function(object, ...)
 UseMethod("contrast")

contrast.ref.grid = function(object, method = "eff", interaction = FALSE,
 by, offset = NULL, name = "contrast",
 options = getOption("lsmeans")$contrast, adjust, ...)
{
 if(missing(by))
 by = object@misc$by.vars
 if(length(by) == 0) # character(0) > NULL
 by = NULL

 nesting = object@model.info$nesting
 if (!is.null(nesting)  !is.null(object@misc$display))
 return (.nested_contrast(rgobj = object, method = method, by = by, adjust = adjust, ...))

 orig.grid = object@grid[, , drop = FALSE]
 orig.grid[[".wgt."]] = orig.grid[[".offset."]] = NULL

 if (is.logical(interaction) && interaction)
 interaction = method
 if (!is.logical(interaction)) { # i.e., interaction is not FALSE
 if (!is.character(interaction))
 stop("interaction requires named contrast function(s)")
 if(missing(adjust))
 adjust = "none"
 by = NULL
 vars = names(object@levels)
 k = length(vars)
 if(!is.null(by)) {
 vars = c(setdiff(vars, by), by)
 k = k  length(by)
 }
 interaction = rep(interaction, k)[1:k]
 tcm = NULL
 for (i in k:1) {
 nm = paste(vars[i], interaction[i], sep = "_")
 object = contrast.ref.grid(object, interaction[i], by = vars[i], name = nm)
 if(is.null(tcm))
 tcm = object@misc$con.coef
 else
 tcm = object@misc$con.coef %*% tcm
 vars[i] = nm
 }
 object = update(object, by = by, adjust = adjust, ...)
 object@misc$orig.grid = orig.grid
 object@misc$con.coef = tcm
 if(!is.null(options)) {
 options$object = object
 object = do.call(update.ref.grid, options)
 }
 return(object)
 }

 # else
 linfct = object@linfct[, , drop = FALSE]
 args = g = object@grid[, , drop = FALSE]
 args[[".offset."]] = NULL
 args[[".wgt."]] = NULL # ignore auxiliary stuff in labels, etc.
 if (!is.null(by)) {
 by.rows = .find.by.rows(args, by)
 bylevs = args[, by, drop=FALSE]
 args = args[by.rows[[1]], , drop=FALSE]
 for (nm in by) args[[nm]] = NULL
 }
 args$sep = ","
 levs = do.call("paste", args) # NOTE  these are levels for the first (or only) bygroup


 if (is.list(method)) {
 cmat = as.data.frame(method, optional = TRUE)
 # I have no clue why they named that argument 'optional',
 # but setting it to TRUE keeps it from messing up the names
 method = function(levs) cmat
 }
 else if (is.character(method)) {
 fn = paste(method, "lsmc", sep=".")
 method = if (exists(fn, mode="function"))
 get(fn)
 else
 stop(paste("Contrast function '", fn, "' not found", sep=""))
 }
 # case like in old lsmeans, contr = list
 else if (!is.function(method))
 stop("'method' must be a function or the basename of an '.lsmc' function")

 # Get the contrasts; this should be a data.frame
 cmat = method(levs, ...)
 if (!is.data.frame(cmat))
 stop("Contrast function must provide a data.frame")
 else if(ncol(cmat) == 0)
 cmat = data.frame(`(nothing)` = rep(NA, nrow(args)), check.names = FALSE)
 # warning("No contrasts were generated! Perhaps only one lsmean is involved.\n",
 # " This can happen, for example, when your predictors are not factors.")
 else if (nrow(cmat) != nrow(args))
 stop("Nonconforming number of contrast coefficients")
 tcmat = t(cmat)

 if (is.null(by)) {
 linfct = tcmat %*% linfct
 grid = data.frame(.contrast.=names(cmat))
 if (hasName(object@grid, ".offset."))
 grid[[".offset."]] = t(cmat) %*% object@grid[[".offset."]]
 by.rows = list(seq_along(object@linfct[ , 1]))
 }

 # NOTE: The kronecker thing here depends on the grid being regular.
 # Irregular grids are handled by .neted_contrast
 else {
 tcmat = kronecker(.diag(rep(1,length(by.rows))), tcmat)
 linfct = tcmat %*% linfct[unlist(by.rows), , drop = FALSE]
 tmp = expand.grid(con = names(cmat), by = seq_len(length(by.rows)))###unique(by.id))
 grid = data.frame(.contrast. = tmp$con)
 n.each = ncol(cmat)
 row.1st = sapply(by.rows, function(x) x[1])
 xlevs = list()
 for (v in by)
 xlevs[[v]] = rep(bylevs[row.1st, v], each=n.each)
 grid = cbind(grid, as.data.frame(xlevs))
 if (hasName(object@grid, ".offset."))
 grid[[".offset."]] = tcmat %*% object@grid[unlist(by.rows), ".offset."]
 }

 # Rename the .contrast. column  ordinarily to "contrast",
 # but otherwise a unique variation thereof
 con.pat = paste("^", name, "[0p]?", sep = "")
 n.prev.con = length(grep(con.pat, names(grid)))
 con.col = grep("\\.contrast\\.", names(grid))
 con.name = paste(name,
 ifelse(n.prev.con == 0, "", n.prev.con), sep="")
 names(grid)[con.col] = con.name

 row.names(linfct) = NULL
 misc = object@misc
 misc$initMesg = NULL # initial annotation likely will no longer apply
 misc$estName = "estimate"
 if (!is.null(et < attr(cmat, "type")))
 misc$estType = et
 else {
 is.con = all(abs(sapply(cmat, sum)) < .001)
 misc$estType = ifelse(is.con, "contrast", "prediction")
 }
 misc$methDesc = attr(cmat, "desc")
 misc$famSize = size = length(by.rows[[1]])
 misc$pri.vars = setdiff(names(grid), c(".offset.",".wgt."))
 if (missing(adjust)) adjust = attr(cmat, "adjust")
 if (is.null(adjust)) adjust = "none"
 if (!is.null(attr(cmat, "offset")))
 offset = attr(cmat, "offset")
 if (!is.null(offset)) {
 if(!hasName(grid, ".offset."))
 grid[[".offset."]] = 0
 grid[[".offset."]] = grid[[".offset."]] + rep(offset, length(by.rows))
 }
 misc$adjust = adjust
 misc$infer = c(FALSE, TRUE)
 misc$by.vars = by
 # save contrast coefs
 by.cols = seq_len(ncol(tcmat))
 if(!is.null(by.rows))
 by.cols[unlist(by.rows)] = by.cols # gives us inverse of by.rows order
 misc$orig.grid = orig.grid # save original grid
 misc$con.coef = tcmat[ , by.cols, drop = FALSE] # save contrast coefs
 # zap the transformation info except in very special cases
 if (!is.null(misc$tran)) {
 misc$orig.tran = misc$tran
 true.con = all(zapsmall(apply(cmat, 2, sum)) == 0) # each set of coefs sums to 0
 if (true.con && misc$tran == "log") {
 misc$orig.inv.lbl = misc$inv.lbl
 misc$inv.lbl = paste(misc$inv.lbl,"ratio",sep=".")
 misc$tran = "log"
 }
 else if (true.con && misc$tran == "logit") {
 misc$orig.inv.lbl = misc$inv.lbl
 misc$inv.lbl = "odds.ratio"
 misc$tran = "log.o.r."
 }
 else
 misc$tran = misc$tran.mult = NULL
 }

 # ensure we don't inherit inappropriate settings
 misc$null = misc$delta = misc$side = NULL

 object@roles$predictors = "contrast"
 levels = list()
 for (nm in setdiff(names(grid), ".offset."))
 levels[[nm]] = unique(grid[[nm]])

 result = new("lsmobj", object, linfct = linfct, levels = levels, grid = grid, misc = misc)
 if(!is.null(options)) {
 options$object = result
 result = do.call("update.ref.grid", options)
 }
 result
}


# return list of row indexes in tbl for each combination of by
# tbl should be a data.frame
.find.by.rows = function(tbl, by) {
 if (is.null(by))
 return(list(seq_len(nrow(tbl))))
 if (any(is.na(match(by, names(tbl)))))
 stop("'by' variables are not all in the grid")
 bylevs = tbl[ , by, drop = FALSE]
 by.id = do.call("paste", bylevs)
 uids = unique(by.id)
 result = lapply(uids, function(id) which(by.id == id))
 names(result) = uids
 result
}


# confint method
confint.ref.grid = function(object, parm, level=.95, ...) {
 summary(object, infer=c(TRUE,FALSE), level=level, ...)
}

# test S3 generic and method
test = function(object, null, ...) {
 UseMethod("test")
}


test.ref.grid = function(object, null = 0,
 joint = FALSE, verbose = FALSE, rows, by, ...) {
# if joint = FALSE, this is a courtesy method for 'contrast'
# else it computes the F test or Wald test of H0: L*beta = null
# where L = object@linfct
 if (!joint) {
 if (missing(by))
 summary(object, infer=c(FALSE,TRUE), null = null, ...)
 else
 summary(object, infer=c(FALSE,TRUE), null = null, by = by, ...)
 }
 else {
 if(verbose) {
 cat("Joint test of the following linear predictions\n")
 print(cbind(object@grid, equals = null))
 }
 L = object@linfct
 bhat = object@bhat
 estble.idx = which(!is.na(object@bhat))
 bhat = bhat[estble.idx]
 est.flag = !is.na(object@nbasis[1])

 ### L = L[, estble.idx, drop = FALSE]
 if (!missing(rows))
 by.rows = list(sel.rows = rows)
 else {
 by.rows = list(all = seq_len(nrow(L)))
 if(missing(by))
 by = object@misc$by.vars
 if (!is.null(by))
 by.rows = .find.by.rows(object@grid, by)
 }

 lindep = nonest = FALSE

 result = lapply(by.rows, function(rows) {
 LL = L[rows, , drop = FALSE]
 # estract est'ble rows
 if(est.flag) {
 erows = estimability::is.estble(LL, object@nbasis)
 nonest << nonest  (sum(erows) < nrow(LL))
 LL = LL[erows, estble.idx, drop = FALSE]
 }
 # Check rank
 qrLt = qr(t(LL)) # this will work even if LL has 0 rows
 r = qrLt$rank
 if (r == 0)
 return(c(df1 = 0, df2 = NA, F = NA, p.value = NA))
 if (r < nrow(LL)) {
 if(!all(null == 0))
 stop("Rows are linearly dependent  cannot do the test when 'null' != 0")
 else
 lindep << TRUE
 }
 tR = t(qr.R(qrLt))[1:r, 1:r, drop = FALSE]
 tQ = t(qr.Q(qrLt))[1:r, , drop = FALSE]
 if(length(null) < r) null = rep(null, r)
 z = tQ %*% bhat  solve(tR, null[1:r])
 zcov = tQ %*% object@V %*% t(tQ)
 F = sum(z * solve(zcov, z)) / r
 df2 = object@dffun(tQ, object@dfargs)
 if (is.na(df2))
 p.value = pchisq(F*r, r, lower.tail = FALSE)
 else
 p.value = pf(F, r, df2, lower.tail = FALSE)
 c(round(c(df1 = r, df2 = df2), 2), F = round(F, 3), p.value = p.value)
 })

 result = as.data.frame(t(as.data.frame(result)))
 if (!missing(by)) {
 fbr = sapply(by.rows, "[", 1)
 result = cbind(object@grid[fbr, by, drop = FALSE], result)
 }
 class(result) = c("summary.ref.grid", "data.frame")
 attr(result, "estName") = "F"
 if (lindep)
 message("There are linearly dependent rows  df are reduced accordingly")
 if (nonest)
 message("Some rows are nonestimable and were excluded")

 result
 }
}

# pairs method
pairs.ref.grid = function(x, reverse = FALSE, ...) {
 object = x # for my sanity
 if (reverse)
 contrast(object, method = "revpairwise", ...)
 else
 contrast(object, method = "pairwise", ...)
}


# coef method  returns contrast coefficients, or identity matrix if no contrasts
coef.ref.grid = function(object, ...) {
 if (is.null(cc < object@misc$con.coef)) {
 message("No contrast coefficients are available")
 return (NULL)
 }
 cc = as.data.frame(t(cc))
 names(cc) = paste("c", seq_len(ncol(cc)), sep = ".")
 cbind(object@misc$orig.grid, cc)
}





# Check if model contains a term containing all elts of facs
# Note: if an lstrends call, we want to include trend var in facs
# terms is terms() component of model
.some.term.contains = function(facs, terms) {
 for (trm in attr(terms, "term.labels")) {
 if(all(sapply(facs, function(f) length(grep(f,trm))>0)))
 if (length(.all.vars(as.formula(paste("~",trm)))) > length(facs))
 return(TRUE)
 }
 return(FALSE)
}

# Construct a new lsmobj with given arguments
lsmobj = function(bhat, V, levels, linfct, df = NA, post.beta = matrix(NA), ...) {
 if ((nrow(V) != ncol(V))  (nrow(V) != ncol(linfct))  (length(bhat) != ncol(linfct)))
 stop("bhat, V, and linfct are incompatible")
 if (!is.list(levels))
 levels = list(level = levels)
 grid = do.call(expand.grid, levels)
 if (nrow(grid) != nrow(linfct))
 stop("linfct should have ", nrow(grid), "rows")
 model.info = list(call = match.call(), xlev = levels)
 roles = list(predictors= names(grid), responses=character(0), multresp=character(0))
 if (is.function(df)) {
 dffun = df
 dfargs = list(...)$dfargs
 }
 else {
 dffun = function(x, dfargs) dfargs$df
 dfargs = list(df = df)
 }
 misc = list(estName = "estimate", estType = "prediction", infer = c(TRUE,FALSE), level = .95,
 adjust = "none", famSize = nrow(linfct),
 avgd.over = character(0), pri.vars = names(grid),
 methDesc = "lsmobj")
 result = new("lsmobj", model.info=model.info, roles=roles, grid=grid,
 levels = levels, matlevs=list(),
 linfct=linfct, bhat=bhat, nbasis=all.estble, V=V,
 dffun=dffun, dfargs=dfargs, misc=misc, post.beta=post.beta)

 update(result, ..., silent=TRUE)
}
diff pruN 2.27623/R/lsmip.R 2.3001/R/lsmip.R
 2.27623/R/lsmip.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/lsmip.R 19700101 00:00:00.000000000 +0000
@@ 1,123 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# lsmip code  interaction plots

lsmip = function(object, formula, ...)
 UseMethod("lsmip")

# object  a model object supported by lsmeans
# formula  a formula of the form x.factors ~ trace.factors  panel.factors
lsmip.default = function(object, formula, type,
 pch=c(1,2,6,7,9,10,15:20), lty=1, col=NULL, plotit = TRUE, ...) {
 if (!requireNamespace("lattice"))
 stop("This function requires the 'lattice' package be installed.")
 if (length(formula) < 3)
 formula = .reformulate(as.character(formula)[[2]], response = ".single.")

 # Glean the parts of ... to use in lsmeans call
 # arguments allowed to be passed
 lsa.allowed = c("at","trend","cov.reduce","fac.reduce")
 xargs = list(...)
 lsmopts = list(...)
 for (arg in names(xargs)) {
 idx = pmatch(arg, lsa.allowed)
 if (!is.na(idx)) {
 opt = lsa.allowed[idx]
 lsmopts[[opt]] = xargs[[arg]]
 xargs[[arg]] = NULL
 }
 }

 allvars = setdiff(.all.vars(formula), ".single.")
 lsmopts$object = object
 lsmopts$specs = .reformulate(allvars)
 lsmo = do.call("lsmeans", lsmopts)
 if(missing(type)) {
 type = get.lsm.option("summary")$predict.type
 if (is.null(type))
 type = .get.predict.type(lsmo@misc)
 }
 type = .validate.type(type)

 lsm = predict(lsmo, type = type)
 lsms = cbind(lsmo@grid, lsmean = lsm)

 # Set up trace vars and key
 tvars = .all.vars(update(formula, . ~ 1))
 if (all(tvars == ".single.")) {
 lsms$.single. = 1
 my.key = function(tvars) list()
 }
 else {
 my.key = function(tvars)
 list(space="right",
 title = paste(tvars, collapse=" * "),
 points = TRUE,
 lines=length(lty) > 1,
 cex.title=1)
 }
 tv = do.call(paste, lsms[tvars])
 lsms$tvar = factor(tv, levels=unique(tv))

 # figure out 'x' and 'by' vars
 rhs = strsplit(as.character(formula[3]), "\\")[[1]]
 xvars = .all.vars(stats::reformulate(rhs[[1]]))
 xv = do.call(paste, lsms[xvars])
 lsms$xvar = factor(xv, levels = unique(xv))
 lsms = lsms[order(lsms$xvar), ]
 plotform = lsmean ~ xvar

 # see if we have any 'by' vars
 if (length(rhs) > 1) {
 byvars = .all.vars(stats::reformulate(rhs[[2]]))
 plotform = as.formula(paste("lsmean ~ xvar ", paste(byvars, collapse="*")))
 }

 # The strips the way I want them
 my.strip = lattice::strip.custom(strip.names = c(TRUE,TRUE), strip.levels = c(TRUE,TRUE), sep = " = ")

 TP = TP.orig = lattice::trellis.par.get()
 TP$superpose.symbol$pch = pch
 TP$superpose.line$lty = lty
 if (!is.null(col)) TP$superpose.symbol$col = TP$superpose.line$col = col
 lattice::trellis.par.set(TP)

 xlab = ifelse(is.null(xargs$xlab),
 paste("Levels of", paste(xvars, collapse=" * ")), xargs$xlab)
 rspLbl = paste("Predicted",
 ifelse(is.null(lsmo@misc$inv.lbl), "response", lsmo@misc$inv.lbl))
 ylab = ifelse(is.null(xargs$ylab),
 ifelse(type == "response", rspLbl, "Linear prediction"),
 xargs$ylab)

 # remove the unneeded stuff from xlabs
 xargs = xargs[setdiff(names(xargs), c("xlab","ylab"))]
 plotspecs = list(x = plotform, data = lsms, groups = ~ tvar,
 xlab = xlab, ylab = ylab,
 strip = my.strip, auto.key = my.key(tvars), type=c("p","l"))
 grobj = do.call(lattice::xyplot, c(plotspecs, xargs))
 if (plotit)
 print(grobj)
 attr(lsms, "lattice") = grobj
 lattice::trellis.par.set(TP.orig)
 invisible(lsms)
}
diff pruN 2.27623/R/lsm.list.R 2.3001/R/lsm.list.R
 2.27623/R/lsm.list.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/lsm.list.R 19700101 00:00:00.000000000 +0000
@@ 1,67 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# Methods for lsm.list objects

# Summary method for an lsm.list
summary.lsm.list < function(object, ...)
 lapply(object, function(x) {
 if (inherits(x, "summary.ref.grid")) x
 else summary(x, ...)
 })

print.lsm.list < function(x, ...)
 print(summary(x, ...))

str.lsm.list = function(object, ...) {
 for(nm in names(object)) {
 cat(paste("$", nm, "\n", sep=""))
 str(object[[nm]])
 cat("\n")
 }
}

# Courtesy methods to make it more friendly for followups
contrast.lsm.list = function(object, ... , which = 1) {
 contrast(object[[which]], ...)
}

pairs.lsm.list = function(x, ..., which = 1) {
 pairs(x[[which]], ...)
}

test.lsm.list = function(object, ..., which = 1) {
 test(object[[which]], ...)
}

confint.lsm.list = function(object, ..., which = 1) {
 confint(object[[which]], ...)
}

cld.lsm.list = function(object, ..., which = 1) {
 cld(object[[which]], ...)
}

coef.lsm.list = function(object, ..., which = 1) {
 coef(object[[which]], ...)
}


diff pruN 2.27623/R/lstrends.R 2.3001/R/lstrends.R
 2.27623/R/lstrends.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/lstrends.R 19700101 00:00:00.000000000 +0000
@@ 1,104 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### Code for lstrends


### lstrends function
lstrends = function(model, specs, var, delta.var=.01*rng, data,
 transform = c("none", "response"), ...) {
 estName = paste(var, "trend", sep=".") # Do now as I may replace var later

 if (missing(data)) {
 data = try(recover.data (model, data = NULL))
 if (inherits(data, "tryerror"))
 stop("Possible remedy: Supply the data used in the 'data' argument")
 }
 else # attach needed attributes to given data
 data = recover.data(model, data = data)

 x = data[[var]]
 fcn = NULL # differential
 if (is.null(x)) {
 fcn = var
 var = .all.vars(as.formula(paste("~",var)))
 if (length(var) > 1)
 stop("Can only support a function of one variable")
 else {
 x = data[[var]]
 if (is.null(x)) stop("Variable '", var, "' is not in the dataset")
 }
 }
 rng = diff(range(x))
 if (delta.var == 0) stop("Provide a nonzero value of 'delta.var'")

 RG = orig.rg = ref.grid(model, data = data, ...)

 grid = RG@grid
 if (!is.null(mr < RG@roles$multresp)) {
 # use the grid value only for the 1st mult resp (no dupes)
 if (length(mr) > 0)
 grid = grid[grid[[mr]] == RG@levels[[mr]][1], ]
 }
 grid[[var]] = grid[[var]] + delta.var

 basis = lsm.basis(model, attr(data, "terms"), RG@roles$xlev, grid, ...)
 if (is.null(fcn))
 newlf = (basis$X  RG@linfct) / delta.var
 else {
 y0 = with(RG@grid, eval(parse(text = fcn)))
 yh = with(grid, eval(parse(text = fcn)))
 diffl = (yh  y0)
 if (any(diffl == 0)) warning("Some differentials are zero")
 newlf = (basis$X  RG@linfct) / diffl
 }

 transform = match.arg(transform)

 # Now replace linfct w/ difference quotient
 RG@linfct = newlf
 RG@roles$trend = var
 if(hasName(RG@misc, "tran")) {
 tran = RG@misc$tran
 if (is.list(tran)) tran = tran$name
 if (transform == "response") {
 prd = .est.se.df(orig.rg, do.se = FALSE)
 lnk = attr(prd, "link")
 deriv = lnk$mu.eta(prd[[1]])
 RG@linfct = diag(deriv) %*% RG@linfct
 RG@misc$initMesg = paste("Trends are obtained after backtransforming from the", tran, "scale")
 }
 else
 RG@misc$initMesg = paste("Trends are based on the", tran, "(transformed) scale")
 }

 RG@misc$tran = RG@misc$tran.mult = NULL
 RG@misc$estName = estName
 RG@misc$methDesc = "lstrends"

 .save.ref.grid(RG) # save in .Last.ref.grid, if enabled

 # args for lsmeans calls
 args = list(object=RG, specs=specs, ...)
 args$at = args$cov.reduce = args$mult.levs = args$vcov. = args$data = args$trend = NULL
 do.call("lsmeans", args)
}

diff pruN 2.27623/R/MCMCsupport.R 2.3001/R/MCMCsupport.R
 2.27623/R/MCMCsupport.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/MCMCsupport.R 19700101 00:00:00.000000000 +0000
@@ 1,283 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# Support for MCMCglmm class and possibly more MCMCbased models

# Method to create a coda 'mcmc' or 'mcmc.list' object from a ref.grid
# (dots not supported, unfortunately)
# If sep.chains is TRUE and there is more than one chain, an mcmc.list is returned
as.mcmc.ref.grid = function(x, names = TRUE, sep.chains = TRUE, ...) {
 object = x
 if (is.na(x@post.beta[1]))
 stop("No posterior sample  can't make an 'mcmc' object")
 mat = x@post.beta %*% t(x@linfct)
 if(!is.null(offset < x@grid[[".offset."]])) {
 n = nrow(mat)
 mat = mat + matrix(rep(offset, each = n), nrow = n)
 }
 nm = setdiff(names(x@grid), c(".wgt.",".offset."))
 if (any(names)) {
 names = rep(names, length(nm))
 for (i in seq_along(nm))
 if(names[i]) x@grid[nm[i]] = paste(nm[i], x@grid[[nm[i]]])
 }
 if(is.null(dimnames(mat)))
 dimnames(mat) = list(seq_len(nrow(mat)), seq_len(ncol(mat)))
 dimnames(mat)[[2]] = do.call(paste, c(x@grid[, nm, drop = FALSE], sep=", "))
 n.chains = attr(x@post.beta, "n.chains")
 if (!sep.chains  is.null(n.chains)  (n.chains == 1))
 coda::mcmc(mat, ...)
 else {
 n = nrow(mat) / n.chains
 seqn = seq_len(n)
 chains = lapply(seq_len(n.chains), function(i) coda::mcmc(mat[n*(i  1) + seqn, , drop = FALSE]))
 coda::mcmc.list(chains)
 }
}

# I'm taking out this hack and will appeal to CRAN to make a check exception
#
# ### Hack to work around CRAN check that thinks as.mcmc.list should be an S3 method
# ### Correspondingly, in NAMESPACE, don't import coda's generic of as.mcmc.list
# ### but register S3method(as.mcmc, list)
# as.mcmc.list = function(x, ...) {
# if(inherits(x, "list")) {
# NextMethod("as.mcmc") # presumably this throws an error
# }
# else {
# UseMethod("as.mcmc.list")
# }
# }

### as.mcmc.list  guaranteed to return a list
as.mcmc.list.ref.grid = function(x, names = TRUE, ...) {
 result = as.mcmc.ref.grid(x, names = names, sep.chains = TRUE, ...)
 if(!inherits(result, "mcmc.list"))
 result = coda::mcmc.list(result)
 result
}


# Currently, data is required, as call is not stored
recover.data.MCMCglmm = function(object, data, ...) {
 # if a multivariate response, stack the data with `trait` variable
 yvars = .all.vars(update(object$Fixed$formula, ". ~ 1"))
 if(length(yvars) > 1) {
# for (v in yvars) data[[v]] = NULL
 dat = data
 for (i in seq_len(length(yvars)  1))
 data = rbind(data, dat)
 data$trait = factor(rep(yvars, each = nrow(dat)))
 }
 attr(data, "call") = object$Fixed
 attr(data, "terms") = trms = delete.response(terms(object$Fixed$formula))
 attr(data, "predictors") = .all.vars(delete.response(trms))
 attr(data, "responses") = yvars
 data
}

lsm.basis.MCMCglmm = function(object, trms, xlev, grid, vcov., ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = NULL)
 Sol = as.matrix(object$Sol)[, seq_len(object$Fixed$nfl)] # toss out random effects if included
 bhat = apply(Sol, 2, mean)
 if (missing(vcov.))
 V = cov(Sol)
 else
 V = .my.vcov(object, vcov.)
 misc = list()
 list(X = X, bhat = bhat, nbasis = matrix(NA), V = V,
 dffun = function(k, dfargs) NA, dfargs = list(),
 misc = misc, post.beta = Sol)
}


### Support for MCMCpack , maybe others that produce mcmc objects
### Whether it works depends on:
### 1. if there is a "call" attribute with a formula or fixed member
### 2. if it's right, even then
### Alternatively, maybe providing formula and data will do the trick

recover.data.mcmc = function(object, formula, data, ...) {
 if (missing(formula)) {
 cl = attr(object, "call")
 if (is.null(cl$formula))
 cl$formula = cl$fixed
 if (is.null(cl$formula))
 return("No fixedeffects formula found")
 data = NULL
 }
 else {
 if (missing(formula)  missing(data))
 return("Requires both formula and data to proceed")
 cl = call("mcmc.proxy", formula = formula, data = quote(data))
 }
 trms = delete.response(terms(eval(cl$formula, parent.frame())))
 recover.data(cl, trms, NULL, data, ...)
}

lsm.basis.mcmc = function(object, trms, xlev, grid, vcov., ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = NULL)
 samp = as.matrix(object)[, seq_len(ncol(X)), drop = FALSE]
 bhat = apply(samp, 2, mean)
 if (missing(vcov.))
 V = cov(samp)
 else
 V = .my.vcov(object, vcov.)
 misc = list()
 list(X = X, bhat = bhat, nbasis = matrix(NA), V = V,
 dffun = function(k, dfargs) NA, dfargs = list(),
 misc = misc, post.beta = samp)
}


### Support for mcmc.list
recover.data.mcmc.list = function(object, formula, data, ...) {
 recover.data.mcmc(object[[1]], formula, data, ...)
}

lsm.basis.mcmc.list = function(object, trms, xlev, grid, vcov., ...) {
 result = lsm.basis.mcmc(object[[1]], trms, xlev, grid, vcov, ...)
 cols = seq_len(ncol(result$post.beta))
 for (i in 2:length(object))
 result$post.beta = rbind(result$post.beta,
 as.matrix(object[[i]])[, cols, drop = FALSE])
 attr(result$post.beta, "n.chains") = length(object)
 result
}


### support for CARBayes package  currently MUST supply data and have
### default contrasts matching what was used in fitting the mdoel
recover.data.carbayes = function(object, data, ...) {
 if(is.null(data)) # Try to recover data from parent frame
 data = model.frame(object$formula, data = parent.frame())
 cl = call("carbayes.proxy", formula = object$formula, data = quote(data))
 trms = delete.response(terms(eval(object$formula, parent.frame())))
 recover.data(cl, trms, NULL, data, ...)
}

lsm.basis.carbayes = function(object, trms, xlev, grid, ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = attr(object$X, "contrasts"))
 samp = as.matrix(object$samples$beta)
 bhat = apply(samp, 2, mean)
 V = cov(samp)
 misc = list()
 list(X = X, bhat = bhat, nbasis = matrix(NA), V = V,
 dffun = function(k, dfargs) NA, dfargs = list(),
 misc = misc, post.beta = samp)
}


### Support for the rstanarm package (stanreg objects)
###
recover.data.stanreg = function(object, ...) {
 recover.data.lm(object, ...)
}

# note: mode and rescale are ignored for some models
lsm.basis.stanreg = function(object, trms, xlev, grid, mode, rescale, ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 if(is.null(contr < object$contrasts))
 contr = attr(model.matrix(object), "contrasts")
 X = model.matrix(trms, m, contrasts.arg = contr)
 bhat = fixef(object)
 V = vcov(object)
 misc = list()
 if (!is.null(object$family)) {
 if (is.character(object$family)) # work around bug for stan_polr
 misc$tran = object$method
 else
 misc = .std.link.labels(object$family, misc)
 }
 if(!is.null(object$zeta)) { # Polytomous regression model
 if (missing(mode))
 mode = "latent"
 else
 mode = match.arg(mode,
 c("latent", "linear.predictor", "cum.prob", "exc.prob", "prob", "mean.class"))

 xint = match("(Intercept)", colnames(X), nomatch = 0L)
 if (xint > 0L)
 X = X[, xint, drop = FALSE]
 k = length(object$zeta)
 if (mode == "latent") {
 if (missing(rescale))
 rescale = c(0,1)
 X = rescale[2] * cbind(X, matrix( 1/k, nrow = nrow(X), ncol = k))
 bhat = c(bhat, object$zeta  rescale[1] / rescale[2])
 misc = list(offset.mult = rescale[2])
 }
 else {
 bhat = c(bhat, object$zeta)
 j = matrix(1, nrow=k, ncol=1)
 J = matrix(1, nrow=nrow(X), ncol=1)
 X = cbind(kronecker(j, X), kronecker(diag(1,k), J))
 link = object$method
 if (link == "logistic") link = "logit"
 misc = list(ylevs = list(cut = names(object$zeta)),
 tran = link, inv.lbl = "cumprob", offset.mult = 1)
 if (mode != "linear.predictor") {
 misc$mode = mode
 misc$postGridHook = ".clm.postGrid" # we probably need to adapt this
 }
 }

 misc$respName = as.character(terms(object))[2]
 }
 samp = as.matrix(object$stanfit)[, names(bhat)]
 attr(samp, "n.chains") = object$stanfit@sim$chains
 list(X = X, bhat = bhat, nbasis = estimability::all.estble, V = V,
 dffun = function(k, dfargs) NA, dfargs = list(),
 misc = misc, post.beta = samp)
}


### see if we can create a usable stanfit object from post.beta
as.stanfit = function(object, names = TRUE, ...) {
 if(!inherits(object, "ref.grid"))
 stop("Not a 'ref.grid' or 'lsmobj' object")
 mcmcl = as.mcmc.list.ref.grid(object, names = names, ...)
 samples = lapply(mcmcl, as.data.frame)
 nm = names(samples[[1]])
 nm = gsub(" ", "_", nm)
 for (s in samples)
 names(s) = nm
 chains = attr(object@post.beta, "n.chains")
 iter = nrow(as.matrix(mcmcl[[1]]))
 if(is.null(chains)) chains = 1
 dims = as.list(rep(1, length(nm)))
 names(dims) = nm
 perm = lapply(seq_len(chains), function(x) seq_len(iter))
 sa = list(iter = iter, thin = 1, seed = 0, warmup = 0, init = "random",
 algorithm = "ref.grid", save_warmup = FALSE, method = "sampling", control = list())
 stan_args = lapply(seq_len(chains), function(x) c(chain_id = x, sa))
 sim = list(samples = samples, iter = iter, thin = 1, warmup = 0,
 chains = chains, n_save = rep(iter, chains), warmup2 = rep(0, chains),
 permutation = perm, pars_oi = nm, dims_oi = dims, fnames_oi = nm,
 n_flatnames = length(nm))
 nullmod = new("stanmodel")
 new("stanfit", model_name = "continuous", model_pars = nm, par_dims = dims,
 mode = as.integer(0), sim = sim, inits = list(0), stan_args = stan_args,
 stanmodel = nullmod, date = as.character(Sys.time()), .MISC = new.env())
}
diff pruN 2.27623/R/multinomsupport.R 2.3001/R/multinomsupport.R
 2.27623/R/multinomsupport.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/multinomsupport.R 19700101 00:00:00.000000000 +0000
@@ 1,90 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### Multinomial modeling

### Example for testing
### From: http://www.ats.ucla.edu/stat/r/dae/mlogit.htm
# library(foreign)
# ml < read.dta("http://www.ats.ucla.edu/stat/data/hsbdemo.dta")
# library(nnet)
# ml$prog2 < relevel(ml$prog, ref = "academic")
# test < multinom(prog2 ~ ses + write, data = ml)
#

# same as recover.data.lm
recover.data.multinom = function(object, ...) {
 fcall = object$call
 recover.data(fcall, delete.response(terms(object)), object$na.action, ...)
}

lsm.basis.multinom = function(object, trms, xlev, grid,
 mode = c("prob", "latent"), ...) {
 mode = match.arg(mode)
 bhat = t(coef(object))
 V = .my.vcov(object, ...)
 k = ncol(bhat)
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = object$contrasts)
 # recenter for latent predictions
 pat = (rbind(0, diag(k + 1, k))  1) / (k + 1)
 X = kronecker(pat, X)
 nbasis = estimability::all.estble
 nbasis = kronecker(rep(1,k), nbasis)
 misc = list(tran = "log", inv.lbl = "e^y")
 dfargs = list(df = object$edf)
 dffun = function(k, dfargs) dfargs$df
 ylevs = list(class = object$lev)
 if (is.null(ylevs)) ylevs = list(class = seq_len(k))
 names(ylevs) = as.character(object$call$formula[[2]])
 misc$ylevs = ylevs
 if (mode == "prob")
 misc$postGridHook = .multinom.postGrid
 list(X = X, bhat = as.numeric(bhat), nbasis = nbasis, V = V,
 dffun = dffun, dfargs = dfargs, misc = misc)
}

# postprocessing of ref.grid for "prob" mode
.multinom.postGrid = function(object) {
 # will replace portions of these as we go
 bhat = object@bhat
 linfct = object@linfct
 misc = object@misc
 # grid will have multresp as slowestvarying factor...
 idx = matrix(seq_along(linfct[, 1]),
 ncol = length(object@levels[[object@roles$multresp]]))
 for (i in 1:nrow(idx)) {
 rows = idx[i, ]
 exp.psi = exp(linfct[rows, , drop = FALSE] %*% object@bhat)
 p = as.numeric(exp.psi / sum(exp.psi))
 bhat[rows] = p
 A = .diag(p)  outer(p, p) # partial derivs
 linfct[rows, ] = A %*% linfct[rows, ]
 }
 misc$postGridHook = misc$tran = misc$inv.lbl = NULL
 misc$estName = "prob"

 object@bhat = bhat
 object@V = linfct %*% tcrossprod(object@V, linfct)
 object@linfct = diag(1, length(bhat))
 object@misc = misc
 object
}
\ No newline at end of file
diff pruN 2.27623/R/nested.R 2.3001/R/nested.R
 2.27623/R/nested.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/nested.R 19700101 00:00:00.000000000 +0000
@@ 1,362 +0,0 @@
##############################################################################
# Copyright (c) 20122017 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# Code supporting nested models

# This code replies on nested structures specified in a named list like
# list(a = "b", c = c("d", "e"))
# ... to denote a %in% b, c %in% d*e

# Internal function to deal with nested structures.
# rgobj  a ref.grid
# specs, ...  arguments for lsmeans
# nesting  a named list of nesting info
# This function works by subsetting rgobj as needed, and applying lsmeans
# to each subsetted object
# This is a servant to lsmeans.character.ref.grid, so we can assume specs is character
.nested_lsm = function(rgobj, specs, by = NULL, ..., nesting) {
 # # Trap something not supported for these... This doesn't work
 # dots = list(...)
 # if("weights" %in% dots)
 # if(!is.na(pmatch(dots$weights, "show.levels")))
 # stop('weights = "show.levels" is not supported for nested models.')

 #### Two issues to worry about....
 # (1) specs contains nested factors. We need to include their grouping factors
 xspecs = intersect(union(specs, by), names(nesting))
 if (length(xspecs) > 0) {
 xgrps = unlist(nesting[xspecs])
 specs = union(union(xspecs, xgrps), specs) # expanded specs with flagged ones first
 by = setdiff(by, xspecs) # can't use nested factors for grouping
 }
 # (2) If we average over any nested factors, we need to do it separately
 avg.over = setdiff(names(rgobj@levels), union(specs, by))
 afacs = intersect(names(nesting), avg.over) ### DUH!names(nesting)[names(nesting) %in% avg.over]
 if (length(afacs) == 0) { # no nesting issues; just use lsmeans
 result = lsmeans(rgobj, specs, by = by, ...)
 }
 else { # we need to handle each group separately
 sz = sapply(afacs, function(nm) length(nesting[[nm]]))
 # use highestorder one first: potentially, we end up calling this recursively
 afac = afacs[rev(order(sz))][1]
 grpfacs = nesting[[afac]]
 gspecs = union(specs, union(by, grpfacs))
 grpids = as.character(interaction(rgobj@grid[, grpfacs]))
 grps = do.call(expand.grid, rgobj@levels[grpfacs]) # all combinations of group factors
 result = NULL
 rg = rgobj
 for (i in seq_len(nrow(grps))) {
 sig = as.character(interaction(grps[i, ]))
 rows = which(grpids == sig)
 grd = rgobj@grid[rows, , drop = FALSE]
 lf = rgobj@linfct[rows, , drop = FALSE]
 # Reduce grid to infacs that actually appear in this group
 nzg = grd[grd$.wgt. > 0, , drop = FALSE]
 rows = integer(0)
 # focus on levels of afac that exist in this group
 levs = unique(nzg[[afac]])
 rg@levels[[afac]] = levs
 rows = union(rows, which(grd[[afac]] %in% levs))
 rg@grid = grd[rows, , drop = FALSE]
 rg@linfct = lf[rows, , drop = FALSE]
 for (j in seq_along(grpfacs))
 rg@levels[[grpfacs[j]]] = grps[i, j]
 lsm = suppressMessages(lsmeans(rg, gspecs, ...))
 if (is.null(result))
 result = lsm
 else {
 result@grid = rbind(result@grid, lsm@grid)
 result@linfct = rbind(result@linfct, lsm@linfct)
 }
 }
 for (j in seq_along(grpfacs))
 result@levels[grpfacs[j]] = rgobj@levels[grpfacs[j]]

 result@misc$avgd.over = setdiff(union(result@misc$avgd.over, avg.over), gspecs)
 result@misc$display = NULL
 nkeep = intersect(names(nesting), names(result@levels))
 if (length(nkeep) > 0)
 result@model.info$nesting = nesting[nkeep]
 else
 result@model.info$nesting = NULL

 # Note: if any nesting remains, this next call recurs back to this function
 result = lsmeans(result, specs, by = by, ...)
 }

 if (length(xspecs) > 0)
 result@misc$display = .find.nonempty.nests(result, xspecs, nesting)

 # preserve any nesting that still exists
 nesting = nesting[names(nesting) %in% names(result@levels)]
 result@model.info$nesting = if (length(nesting) > 0) nesting else NULL
 result
}


### contrast function for nested structures
.nested_contrast = function(rgobj, method = "eff", by = NULL, adjust, ...) {
 nesting = rgobj@model.info$nesting
 # Prevent meaningless cases  if A %in% B, we can't have A in 'by' without B
 # Our remedy will be to EXPAND the by list
 for (nm in intersect(by, names(nesting)))
 if (!all(nesting[[nm]] %in% by)) {
 by = union(by, nesting[[nm]])
 message("Note: Grouping factor(s) for '", nm, "' have been added to the 'by' list.")
 }
 facs = setdiff(names(nesting), by)
 if (length(facs) == 0)
 stop("There are no factor levels left to contrast. Try taking nested factors out of 'by'.")

 if(!is.character(method))
 stop ("Noncharacter contrast methods are not supported with nested objects")

 testcon = get(paste0(method, ".lsmc"))(1:3)
 if(missing(adjust))
 adjust = attr(testcon, "adjust")
 estType = attr(testcon, "type")

 wkrg = rgobj # working copy
 facs = setdiff(names(wkrg@levels), by) # these are the factors we'll combine & contrast
 if (!is.null(display < wkrg@misc$display))
 wkrg = wkrg[which(display), drop.levels = TRUE]
 wkrg@model.info$nesting = wkrg@misc$display = NULL
 by.rows = .find.by.rows(wkrg@grid, by)
 if(length(by.rows) == 1)
 result = contrast(wkrg, method = method, by = by, ...)
 else {
 result = lapply(by.rows, function(rows) {
 contrast.ref.grid(wkrg[rows, drop.levels = TRUE], method = method,
 by = by, adjust = adjust, ...)
 })
 # Have to define .wgt. for nested ref.grid. Use average weight  seems most sensible
 for (i in seq_along(by.rows))
 result[[i]]@grid$.wgt. = mean(wkrg@grid[[".wgt."]][by.rows[[i]]])
 result$adjust = ifelse(is.null(adjust), "none", adjust)
 result = do.call(rbind.ref.grid, result)
 result = update(result, by = by,
 estType = ifelse(is.null(estType), "contrast", estType))
 cname = setdiff(names(result@levels), by)
 result@model.info$nesting[[cname]] = by
 }
 result@misc$orig.grid = result@misc$con.code = NULL

 for (nm in by) {
 if (nm %in% names(nesting))
 result@model.info$nesting[[nm]] = intersect(nesting[[nm]], by)
 }
 result
}


# Internal function to find nonempty cells in nested structures in rgobj for xfacs
# Returns logical vector, FALSE are rows of the grid we needn't display
.find.nonempty.nests = function(rgobj, xfacs, nesting = rgobj@model.info$nesting) {
 grid = rgobj@grid
 keep = rep(TRUE, nrow(grid))
 for (x in xfacs) {
 facs = union(x, nesting[[x]])
 combs = do.call(expand.grid, rgobj@levels[facs])
 levs = as.character(interaction(combs))
 glevs = as.character(interaction(grid[facs]))

 for (lev in levs) {
 idx = which(glevs == lev)
 if (all(grid$.wgt.[idx] == 0)) {
 keep[idx] = FALSE
 levs[levs==lev] = ""
 }
 }
 }
 keep
}


# Internal function to find nesting
# We look at two things:
# (1) structural nesting  i.e., any combinations of
# factors A and B for which each level of A occurs with one and only one
# level of B. If so, we deem A %in% B.
# (2) Modelterm nesting  cases where a factor appears not as a main effect
# but only in higherorder terms. This is discovered using the 1s and 2s in
# trms$factors
# The function returns a named list, e.g., list(A = "B")
# If none found, an empty list is returned.
.find_nests = function(grid, trms, levels) {
 result = list()

 # only consider cases where levels has length > 1
 lng = sapply(levels, length)
 nms = names(levels[lng > 1])
 if (length(nms) < 2)
 return (result)
 g = grid[grid$.wgt. > 0, nms, drop = FALSE]
 for (nm in nms) {
 x = levels[[nm]]
 # exclude other factors this is already nested in
 excl = sapply(names(result), function(lnm)
 ifelse(nm %in% result[[lnm]], lnm, ""))
 otrs = setdiff(nms[!(nms == nm)], excl)
 max.levs = sapply(otrs, function(n) {
 max(sapply(x, function(lev) length(unique(g[[n]][g[[nm]] == lev]))))
 })
 if (any(max.levs == 1))
 result[[nm]] = otrs[max.levs == 1]
 }

 # Now look at factors attribute
 fac = attr(trms, "factors")
 if (!is.null(fac)) {
 fac = fac[intersect(nms, row.names(fac)), , drop = FALSE]
 for (j in seq_len(ncol(fac))) {
 if (any(fac[, j] == 2)) {
 nst = nms[fac[, j] == 1]
 for (nm in nst)
 result[[nm]] = nms[fac[, j] == 2]
 }
 }
 }

 result
}

# internal function to format a list of nested levels
.fmt.nest = function(nlist) {
 if (length(nlist) == 0)
 "none"
 else {
 tmp = lapply(nlist, function(x)
 if (length(x) == 1) x
 else paste0("(", paste(x, collapse = "*"), ")")
 )
 paste(sapply(names(nlist), function (nm) paste0(nm, " %in% ", tmp[[nm]])),
 collapse = ", ")
 }
}

# internal function to parse a nesting string & return a list
# spec can be a named list, character vector ####, or formula
.parse_nest = function(spec) {
 if (is.null(spec))
 return(NULL)
 if (is.list(spec))
 return (spec)
 result = list()
 # break up any comma delimiters
 spec = trimws(unlist(strsplit(spec, ",")))
 for (s in spec) {
 parts = strsplit(s, "[ ]+%in%[ ]+")[[1]]
 grp = .all.vars(stats::reformulate(parts[2]))
 result[[parts[[1]]]] = grp
 }
 if(length(result) == 0)
 result = NULL
 result
}


### Create a grouping factor and add it to a ref grid
# object  a ref.grid
# newname  name of new factor to be created
# refname  name of existing factor that will be nested in new factor
# newlevs  corresponding levels of new factor (length = # levels of ref factor)
# (make newlevs a factor if you want levels in a particular order)
add_grouping = function(object, newname, refname, newlevs) {
 if(!is.null(object@model.info$nesting[[refname]]))
 stop("'", refname, "' is already nested in another factor; cannot regroup it")
 rlevs = object@levels[[refname]]
 if (length(newlevs) != length(rlevs))
 stop("Length of 'newlevs' doesn't match # levels of '", refname, "'")
 newlevs = factor(newlevs)
 glevs = levels(newlevs)
 k = length(glevs)

 one = matrix(1, nrow = k, ncol = 1)
 object@linfct = kronecker(one, object@linfct)
 object@levels[[newname]] = glevs

 wgt = object@grid$.wgt.
 offset = object@grid$.offset.
 ogrid = object@grid[setdiff(names(object@grid), c(".wgt.", ".offset."))]
 grid = data.frame()
 valid = logical(0) # flag for rows that make sense
 for (i in 1:k) {
 g = ogrid
 g[[newname]] = glevs[i]
 g$.wgt. = wgt
 g$.offset. = offset
 grid = rbind(grid, g)
 alevs = rlevs[newlevs == glevs[i]]
 valid = c(valid, g[[refname]] %in% alevs)
 }
 # screen out invalid rows
 grid[!valid, ".wgt."] = 0
 object@linfct[!valid, ] = NaN
 object@misc$pri.vars = c(object@misc$pri.vars, newname)
 if(is.null(disp < object@misc$display))
 object@misc$display = valid
 else
 object@misc$display = disp & valid
 object@grid = grid

 # update nesting structure
 nesting = object@model.info$nesting
 if (is.null(nesting))
 nesting = list()
 for (nm in names(nesting))
 if (refname %in% nesting[[nm]])
 nesting[[nm]] = c(nesting[[nm]], newname)
 nesting[[refname]] = newname
 object@model.info$nesting = nesting

 object
}


# ### I'm removing this because I now think it creates more problems than it solves
# #
# # courtesy function to create levels for a nested structure factor %in% nest
# # factor: factor (or interaction() result)
# # ...: factors in nest
# # SAS: if (FALSETRUE), reference level in each nest is (firstlast)
# nested = function(factor, ..., SAS = FALSE) {
# nfacs = list(...)
# if (length(nfacs) == 0)
# return(factor)
# nfacs$drop = TRUE
# nest = do.call(interaction, nfacs)
# result = as.character(interaction(factor, nest, sep = ".in."))
# ores = unique(sort(result))
# nlev = levels(nest)
# flev = levels(factor)
# refs = lapply(nlev, function(nst) {
# r = ores[ores %in% paste0(flev, ".in.", nst)]
# ifelse (SAS, rev(r)[1], r[1])
# })
# result[result %in% refs] = ".nref."
# ores[ores %in% refs] = ".nref."
# ores = setdiff(ores, ".nref.")
# if (SAS)
# factor(result, levels = c(ores, ".nref."))
# else
# factor(result, levels = c(".nref.", ores))
# }

diff pruN 2.27623/R/nonlinsupport.R 2.3001/R/nonlinsupport.R
 2.27623/R/nonlinsupport.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/nonlinsupport.R 19700101 00:00:00.000000000 +0000
@@ 1,91 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# experimental support for nls, nlme objects

recover.data.nls = function(object, ...) {
 fcall = object$call
 trms = terms(.reformulate(names(object$dataClasses)))
 recover.data(fcall, trms, object$na.action, ...)
}

lsm.basis.nls = function(object, trms, xlev, grid, ...) {
 Vbeta = .my.vcov(object, ...)
 env = object$m$getEnv()
 for (nm in names(grid)) env[[nm]] = grid[[nm]]
 pars = object$m$getAllPars()
 DD = deriv(object$m$formula(), names(pars))
 ests = eval(DD, env)
 bhat = as.numeric(ests)
 grad = attr(ests, "gradient")
 V = grad %*% Vbeta %*% t(grad)
 X = diag(1, nrow(grid))
 list(X=X, bhat=bhat, nbasis=all.estble, V=V,
 dffun=function(k, dfargs) NA, dfargs=list(),
 misc=list())
}


### For nlme objects, we can do stuff with the fixed part of the model
### Additional REQUIRED argument is 'param'  parameter name to explore
recover.data.nlme = function(object, param, ...) {
 if(missing(param))
 return("'param' argument is required for nlme objects")
 fcall = object$call
 if (!is.null(fcall$weights))
 fcall$weights = nlme::varWeights(object$modelStruct)
 fixed = fcall$fixed
 if (is.call(fixed))
 fixed = eval(fixed, envir = parent.frame())
 if(!is.list(fixed))
 fixed = list(fixed)
 form = NULL
 for (x in fixed)
 if (param %in% all.names(x)) form = x
 if (is.null(form))
 return(paste("Can't find '", param, "' among the fixed parameters", sep = ""))
 fcall$weights = NULL
 #trms = delete.response(terms(update(terms(object), form)))
 trms = delete.response(terms(form))
 if (length(.all.vars(trms)) == 0)
 return(paste("No predictors for '", param, "' in fixed model", sep = ""))
 recover.data(fcall, trms, object$na.action, ...)
}

lsm.basis.nlme = function(object, trms, xlev, grid, param, ...) {
 idx = object$map$fmap[[param]]
 V = object$varFix[idx, idx, drop = FALSE]
 bhat = object$coefficients$fixed[idx]
 contr = attr(object$plist[[param]]$fixed, "contrasts")
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = contr)
 dfx = object$fixDF$X[idx]
 dfx[1] = min(dfx) # I'm assuming 1st one is intercept
 dffun = function(k, dfargs) { # containment df
 idx = which(abs(k) > 1e6)
 ifelse(length(idx) > 0, min(dfargs$dfx[idx]), NA)
 }
 list(X = X, bhat = bhat, nbasis = estimability::all.estble,
 V = V, dffun = dffun, dfargs = list(dfx = dfx),
 misc = list(estName = param))
}


diff pruN 2.27623/R/ordinalsupport.R 2.3001/R/ordinalsupport.R
 2.27623/R/ordinalsupport.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/ordinalsupport.R 19700101 00:00:00.000000000 +0000
@@ 1,361 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### support for the ordinal package

recover.data.clm = function(object, mode = "latent", ...) {
 if (!is.na(pmatch(mode, "scale"))) {
 if (is.null(trms < object$S.terms))
 return("Specified mode=\"scale\", but no scale model is present") # ref.grid's error handler takes it from here
 recover.data(object$call, trms, object$na.action, ...)
 }
 else if (is.null(object$S.terms) && is.null(object$nom.terms))
 recover.data.lm(object, ...)
 else { # bringin predictors from loc, scale, and nom models
 trms = delete.response(object$terms)
 x.preds = union(.all.vars(object$S.terms), .all.vars(object$nom.terms))
 x.trms = terms(update(trms, .reformulate(c(".", x.preds))))
 recover.data(object$call, x.trms, object$na.action, ...)
 }
}

# For now at least, clmm doesn't cover scale, nominal options
recover.data.clmm = recover.data.lm

# Note: For ALL thresholds, object$Theta has all the threshold values
# for the different cuts (same as object$alpha when threshold=="flexible")
# and object$tJac is s.t. tJac %*% alpha = Theta
# Note also that some functions of cut are constrained to be zero when
# threshold != "flexible". Can get basis using nonest.basis(t(tJac))
#
# opt arg 'mode'  determines what goes into ref.grid
# 'rescale'  (loc, scale) for linear transformation of latent result

lsm.basis.clm = function (object, trms, xlev, grid,
 mode = c("latent", "linear.predictor", "cum.prob", "exc.prob", "prob", "mean.class", "scale"),
 rescale = c(0,1), ...) {
 # general stuff
 mode = match.arg(mode)
 if (mode == "scale")
 return (.lsm.basis.clm.scale(object, trms, xlev, grid, ...))

 if (is.null(object$contrasts))
 warning("Contrasts used to fit the model are unknown.\n",
 "Defaulting to system option, but results may be wrong.")
 bhat = coef(object)
 V = .my.vcov(object, ...)
 tJac = object$tJac
 dffun = function(...) NA
 link = as.character(object$info$link)
 cnm = dimnames(object$tJac)[[1]]
 if (is.null(cnm))
 cnm = paste(seq_len(nrow(tJac)), "", 1 + seq_len(nrow(tJac)), sep = "")
 misc = list()

 # My strategy is to piece together the needed matrices for each threshold parameter
 # Then assemble the results

 ###  Location part  ###
 contrasts = object$contrasts
 # Remember trms was trumpedup to include scale and nominal predictors.
 # Recover the actual terms for the principal model
 trms = delete.response(object$terms)
 m = model.frame(trms, grid, na.action = na.pass, xlev = object$xlevels)
 X = model.matrix(trms, m, contrasts.arg = contrasts)
 xint = match("(Intercept)", colnames(X), nomatch = 0L)
 if (xint > 0L) {
 X = X[, xint, drop = FALSE]
 }

 ###  Nominal part  ###
 if (is.null(object$nom.terms))
 NOM = matrix(1, nrow = nrow(X))
 else {
 mn = model.frame(object$nom.terms, grid, na.action = na.pass, xlev = object$nom.xlevels)
 NOM = model.matrix(object$nom.terms, mn, contrasts.arg = object$nom.contrasts)
 }
 bigNom = kronecker(tJac, NOM)
 # cols are in wrong order... I'll get the indexes by transposing a matrix of subscripts
 if (ncol(NOM) > 1)
 bigNom = bigNom[, as.numeric(t(matrix(seq_len(ncol(bigNom)), nrow=ncol(NOM))))]

 ###  Scale part  ###
 if (!is.null(object$S.terms)) {
 ms = model.frame(object$S.terms, grid, na.action = na.pass, xlev = object$S.xlevels)
 S = model.matrix(object$S.terms, ms, contrasts.arg = object$S.contrasts)
 S = S[, names(object$zeta), drop = FALSE]
 if (!is.null(attr(object$S.terms, "offset"))) {
 soff = .get.offset(object$S.terms, grid)
 # we'll add a column to S and adjust bhat and V accordingly
 S = cbind(S, offset = soff)
 bhat = c(bhat, offset = 1)
 V = rbind(cbind(V, offset = 0), offset = 0)
 }
 si = misc$scale.idx = length(object$alpha) + length(object$beta) + seq_len(ncol(S))
 # Make sure there are no name clashes
 names(bhat)[si] = paste(".S", names(object$zeta), sep=".")
 misc$estHook = ".clm.estHook"
 misc$vcovHook = ".clm.vcovHook"
 }
 else
 S = NULL

 ###  Get nonestimability basis  ###
 nbasis = snbasis = estimability::all.estble
 if (any(is.na(bhat))) {
 #####mm = model.matrix(object)
 # workaround to fact that model.matrix doesn't get the contrasts right...
 mf = update(object, method = "model.frame")$mf
 mm = list(X = model.matrix(object$terms, data=mf, contrasts.arg = object$contrasts))
 if (any(is.na(c(object$alpha, object$beta)))) {
 NOMX = mm$X
 if (is.null(mm$NOM))
 NOMX = mm$X
 else {
 ##NOMX = cbind(mm$NOM, mm$X[, 1, drop=false])
 mmNOM = model.matrix(object$nom.terms, data = mf, contrasts.arg = object$nom.contrasts)
 NOMX = cbind(mmNOM, mm$X[, 1])
 }
 nbasis = estimability::nonest.basis(NOMX)
 # replicate and reverse the sign of the NOM parts
 nomcols = seq_len(ncol(NOM))
 nbasis = apply(nbasis, 2, function(x)
 c(rep(x[nomcols], each = length(object$alpha)), x[nomcols]))
 }
 if (!is.null(mm$S)) {
 if (any(is.na(object$zeta))) {
 ####snbasis = nonest.basis(mm$S)
 mmS = model.matrix(object$S.terms, data = mf, contrasts.arg = object$S.contrasts)
 snbasis = estimability::nonest.basis(mmS)
 # put intercept part at end
 snbasis = rbind(snbasis[1, , drop=FALSE], snbasis[1, ])
 if (!is.null(attr(object$S.terms, "offset")))
 snbasis = rbind(snbasis, 0)
 snbasis = rbind(matrix(0, ncol=ncol(snbasis), nrow=min(si)1), snbasis)
 # Note scale intercept is included, so tack it on to the end of everything
 S = cbind(S, .S.intcpt = 1)
 bhat = c(bhat, .S.intcpt = 0)
 V = rbind(cbind(V, .S.intcpt = 0), .S.intcpt = 0)
 si = misc$scale.idx = c(si, 1 + max(si))
 }
 }
 if (is.na(nbasis[1])) # then only nonest part is scale
 nbasis = snbasis
 else {
 if (!is.null(S)) # pad nbasis with zeros when there's a scale model
 nbasis = rbind(nbasis, matrix(0, nrow=length(si), ncol=ncol(nbasis)))
 if (!is.na(snbasis[1]))
 nbasis = cbind(nbasis, snbasis)
 }
 }

 if (mode == "latent") {
 # Create constant columns for means of scale and nominal parts
 J = matrix(1, nrow = nrow(X))
 nomm = rescale[2] * apply(bigNom, 2, mean)
 X = rescale[2] * X
 if (!is.null(S)) {
 sm = apply(S, 2, mean)
 X = cbind(X, kronecker(J, matrix(sm, nrow = 1)))
 }
 bigX = cbind(kronecker(J, matrix(nomm, nrow = 1)), X)
 misc$offset.mult = misc$offset.mult * rescale[2]
 intcpt = seq_len(ncol(tJac))
 bhat[intcpt] = bhat[intcpt]  rescale[1] / rescale[2]
 }
 else { ###  Piece together big matrix for each threshold  ###
 misc$ylevs = list(cut = cnm)
 misc$tran = link
 misc$inv.lbl = "cumprob"
 misc$offset.mult = 1
 if (!is.null(S))
 X = cbind(X, S)
 J = matrix(1, nrow=nrow(tJac))
 bigX = cbind(bigNom, kronecker(J, X))
 if (mode != "linear.predictor") {
 misc$mode = mode
 misc$respName = as.character(object$terms)[2]
 misc$postGridHook = ".clm.postGrid"
 }
 }

 dimnames(bigX)[[2]] = names(bhat)

 list(X = bigX, bhat = bhat, nbasis = nbasis, V = V, dffun = dffun,
 dfargs = list(), misc = misc)
}

# fuction called at end of ref.grid
# I use this for polr as well
# Also used for stanreg result of stan_polr & potentially other MCMC ordinal models
.clm.postGrid = function(object) {
 mode = object@misc$mode
 object@misc$postGridHook = object@misc$mode = NULL
 object = regrid(object, TRUE)
 if(object@misc$estName == "exc.prob") { # backtransforming yields exceedance probs
 object@bhat = 1  object@bhat
 if(!is.null(object@post.beta[1]))
 object@post.beta = 1  object@post.beta
 object@misc$estName = "cum.prob"
 }
 if (mode == "prob") {
 object = .clm.prob.grid(object)
 }
 else if (mode == "mean.class") {
 object = .clm.mean.class(object)
 }
 else if (mode == "exc.prob") {
 object@bhat = 1  object@bhat
 if(!is.null(object@post.beta[1]))
 object@post.beta = 1  object@post.beta
 object@misc$estName = "exc.prob"
 }
 # (else mode == "cum.prob" and it's all OK)
 object@misc$respName = NULL # cleanup
 object
}


# Make the linearpredictor ref.grid into one for class probabilities
# This assumes that object has already been regridded and backtransformed
.clm.prob.grid = function(object, thresh = "cut", newname = object@misc$respName) {
 byv = setdiff(names(object@levels), thresh)
 newrg = contrast(object, ".diff_cum", by = byv)
 if (!is.null(wgt < object@grid[[".wgt."]])) {
 km1 = length(object@levels[[thresh]])
 wgt = wgt[seq_len(length(wgt) / km1)] # unique weights for byv combs
 newrg@grid[[".wgt."]] = rep(wgt, each = km1 + 1)
 }
 # proceed to disavow that this was ever exposed to 'lsmeans' or 'contrast'
 class(newrg) = "ref.grid"
 misc = newrg@misc
 misc$infer = c(FALSE,FALSE)
 misc$estName = "prob"
 misc$pri.vars = misc$by.vars = misc$con.coef = misc$orig.grid = NULL
 newrg@misc = misc
 names(newrg@levels)[1] = names(newrg@grid)[1] = newname
 newrg@roles = object@roles
 newrg@roles$multresp = newname
 newrg
}

.clm.mean.class = function(object) {
 prg = .clm.prob.grid(object, newname = "class")
 byv = setdiff(names(prg@levels), "class")
 lf = as.numeric(prg@levels$class)
 newrg = contrast(prg, list(mean = lf), by = byv)
 newrg = update(newrg, infer = c(FALSE, FALSE),
 pri.vars = NULL, by.vars = NULL, estName = "mean.class")
 newrg@levels$contrast = newrg@grid$contrast = NULL
 prg@roles$multresp = NULL
 newrg@roles = prg@roles
 class(newrg) = "ref.grid"
 newrg
}

# Contrast fcn for turning estimates of cumulative probabilities
# into cell probabilities
.diff_cum.lsmc = function(levs, sep = "", ...) {
 plevs = unique(setdiff(unlist(strsplit(levs, sep, TRUE)), sep))
 k = 1 + length(levs)
 if (length(plevs) != k)
 plevs = seq_len(k)
 M = matrix(0, nrow = length(levs), ncol = k)
 for (i in seq_along(levs))
 M[i, c(i,i+1)] = c(1,1)
 dimnames(M) = list(levs, plevs)
 M = as.data.frame(M)
 attr(M, "desc") = "Differences of cumulative probabilities"
 attr(M, "adjust") = "none"
 attr(M, "offset") = c(rep(0, k1), 1)
 M
}

#### replacement estimation routines for cases with a scale param

## workhorse for estHook and vcovHook functions
.clm.hook = function(object, tol = 1e8) {
 scols = object@misc$scale.idx
 bhat = object@bhat
 active = !is.na(bhat)
 bhat[!active] = 0
 linfct = object@linfct
 estble = estimability::is.estble(linfct, object@nbasis, tol) ###apply(linfct, 1, .is.estble, object@nbasis, tol)
 estble[!estble] = NA
 rsigma = estble * as.numeric(linfct[, scols, drop = FALSE] %*% object@bhat[scols])
 rsigma = exp(rsigma) * estble
 # I'll do the scaling later
 eta = as.numeric(linfct[, scols, drop = FALSE] %*% bhat[scols])
 if (!is.null(object@grid$.offset.))
 eta = eta + object@grid$.offset.
 for (j in scols) linfct[, j] = eta * linfct[, j]
 linfct = (.diag(rsigma) %*% linfct) [, active, drop = FALSE]
 list(est = eta * rsigma, V = linfct %*% tcrossprod(object@V, linfct))
}

.clm.estHook = function(object, do.se = TRUE, tol = 1e8, ...) {
 raw.matl = .clm.hook(object, tol)
 SE = if (do.se) sqrt(diag(raw.matl$V)) else NA
 cbind(est = raw.matl$est, SE = SE, df = NA)
}

.clm.vcovHook = function(object, tol = 1e8, ...) {
 .clm.hook(object, tol)$V
}

### Special lsm.basis fcn for the scale model
.lsm.basis.clm.scale = function(object, trms, xlev, grid, ...) {
 m = model.frame(trms, grid, na.action = na.pass, xlev = xlev)
 X = model.matrix(trms, m, contrasts.arg = object$S.contrasts)
 bhat = c(`(intercept)` = 0, object$zeta)
 nbasis = estimability::all.estble
 if (any(is.na(bhat))) {
 mf = update(object, method = "model.frame")$mf
 S = model.matrix(trms, mf, contrasts.arg = object$S.contrasts)
 nbasis = estimability::nonest.basis(S)
 }
 k = sum(!is.na(bhat))  1
 V = .my.vcov(object, ...)
 pick = nrow(V)  k + seq_len(k)
 V = V[pick, pick, drop = FALSE]
 V = cbind(0, rbind(0,V))
 misc = list(tran = "log")
 list(X = X, bhat = bhat, nbasis = nbasis, V = V,
 dffun = function(...) NA, dfargs = list(), misc = misc)
}

lsm.basis.clmm = function (object, trms, xlev, grid, ...) {
 if(is.null(object$Hessian)) {
 message("Updating the model to obtain the Hessian...")
 object = update(object, Hess = TRUE)
 }
 # borrowed from Maxime's code  need to understand this better, e.g. when it happens
 H = object$Hessian
 if (any(apply(object$Hessian, 1, function(x) all(x == 0)))) {
 H = H[names(coef(object)), names(coef(object))]
 object$Hessian = H
 }
 result = lsm.basis.clm(object, trms, xlev, grid, ...)
 # strip off covariances of random effects
 keep = seq_along(result$bhat)
 result$V = result$V[keep,keep]
 result
}
diff pruN 2.27623/R/plot.lsm.R 2.3001/R/plot.lsm.R
 2.27623/R/plot.lsm.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/plot.lsm.R 19700101 00:00:00.000000000 +0000
@@ 1,275 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# S3 plot method for lsmobj objects (NOT ref.grid as relies on pri.fac attribute etc.)
# ... are arguments sent to update()


plot.lsmobj = function(x, y, type, intervals = TRUE, comparisons = FALSE,
 alpha = .05, adjust = "tukey", int.adjust = "none", ...) {
 if(!missing(type))
 object = update(x, predict.type = type, ..., silent = TRUE)
 else
 object = update(x, ..., silent = TRUE)
 if (missing(int.adjust)) {
 int.adjust = object@misc$adjust
 if (is.null(int.adjust))
 int.adjust = "none"
 }
 summ = summary(object, infer = c(TRUE, FALSE), adjust = int.adjust)
 estName = attr(summ, "estName")
 extra = NULL
 if(comparisons) {
 extra = object
 extra@misc$comp.alpha = alpha
 extra@misc$comp.adjust = adjust
 }
 .plot.srg(x=summ, intervals = intervals, extra = extra, ...)
}

# May use in place of plot.lsmobj but no control over level etc.
# extra is a placeholder for comparisoninterval stuff
plot.summary.ref.grid = function(x, y, horizontal = TRUE, xlab, ylab, layout, ...) {
 .plot.srg (x, y, horizontal, xlab, ylab, layout, ...)
}

# Workhorse for plot.summary.ref.grid
.plot.srg = function(x, y, horizontal = TRUE, xlab, ylab, layout, intervals = TRUE, extra = NULL, ...) {

 if (!requireNamespace("lattice"))
 stop("This function requires the 'lattice' package be installed.")

 summ = x # so I don't get confused
 estName = "the.lsmean"
 names(summ)[which(names(summ) == attr(summ, "estName"))] = estName
 clNames = attr(summ, "clNames")
 if (is.null(clNames)) {
 warning("No information available to display confidence limits")
 lcl = ucl = summ[[estName]]
 }
 else {
 lcl = summ[[clNames[1]]]
 ucl = summ[[clNames[2]]]
 }

 # Panel functions...
 prepanel.ci = function(x, y, horizontal=TRUE, intervals=TRUE,
 lcl, ucl, subscripts, ...) {
 x = as.numeric(x)
 lcl = as.numeric(lcl[subscripts])
 ucl = as.numeric(ucl[subscripts])
 if (!intervals) # no special scaling needed
 list()
 else if (horizontal)
 list(xlim = range(x, ucl, lcl, finite = TRUE))
 else
 list(ylim = range(y, ucl, lcl, finite = TRUE))
 }
 panel.ci < function(x, y, horizontal=TRUE, intervals=TRUE,
 lcl, ucl, lcmpl, rcmpl, subscripts, pch = 16,
 lty = dot.line$lty, lwd = dot.line$lwd,
 col = dot.symbol$col, col.line = dot.line$col, ...) {
 dot.line < lattice::trellis.par.get("dot.line")
 dot.symbol < lattice::trellis.par.get("dot.symbol")
 x = as.numeric(x)
 y = as.numeric(y)
 lcl = as.numeric(lcl[subscripts])
 ucl = as.numeric(ucl[subscripts])
 compare = !is.null(lcmpl)
 if(compare) {
 lcmpl = as.numeric(lcmpl[subscripts])
 rcmpl = as.numeric(rcmpl[subscripts])
 }
 if(horizontal) {
 lattice::panel.abline(h = unique(y), col = col.line, lty = lty, lwd = lwd)
 if(intervals)
 lattice::panel.arrows(lcl, y, ucl, y, col = col, length = .6, unit = "char", angle = 90, code = 3)
 if(compare) {
 s = (x > min(x))
 lattice::panel.arrows(lcmpl[s], y[s], x[s], y[s], length = .5, unit = "char", code = 1, col = "red", type = "closed", fill="red")
 s = (x < max(x))
 lattice::panel.arrows(rcmpl[s], y[s], x[s], y[s], length = .5, unit = "char", code = 1, col = "red", type = "closed", fill="red")
 }
 }
 else {
 lattice::panel.abline(v = unique(x), col = col.line, lty = lty, lwd = lwd)
 if(intervals)
 lattice::panel.arrows(x, lcl, x, ucl, col=col, length = .6, unit = "char", angle = 90, code = 3)
 if(compare) {
 s = (y > min(y))
 lattice::panel.arrows(x[s], lcmpl[s], x[s], y[s], length = .5, unit = "char", code = 1, col = "red", type = "closed", fill="red")
 s = (y < max(y))
 lattice::panel.arrows(x[s], rcmpl[s], x[s], y[s], length = .5, unit = "char", code = 1, col = "red", type = "closed", fill="red")
 }
 }
 lattice::panel.xyplot(x, y, pch=16, ...)
 }
 my.strip = lattice::strip.custom(strip.names = c(TRUE,TRUE), strip.levels = c(TRUE,TRUE), sep = " = ")

 priv = attr(summ, "pri.vars")
 pf = do.call(paste, summ[priv])
 summ$pri.fac = factor(pf, levels=unique(pf))
 chform = ifelse(horizontal,
 paste("pri.fac ~", estName),
 paste(estName, "~ pri.fac"))

 byv = attr(summ, "by.vars")
 if (!is.null(byv) && length(byv) > 0) {
 chform = paste(chform, "", paste(byv, collapse="*"))
 lbv = do.call("paste", summ[byv]) # strings for matching by variables
 ubv = unique(lbv)
 }
 else {
 lbv = rep(1, nrow(summ))
 ubv = 1
 }


 # Obtain comparison limits
 if (!is.null(extra)) {
 # we need to work on the linear predictor scale
 # typeid = 1 > response, 2 > other
 typeid = pmatch(extra@misc$predict.type, "response", nomatch = 2)
 if(length(typeid) < 1) typeid = 2
 if (typeid == 1)
 est = predict(extra, type = "lp")
 else
 est = summ[[estName]]

 alpha = extra@misc$comp.alpha
 adjust = extra@misc$comp.adjust
 psumm = confint(pairs(extra), level = 1  alpha, type = "lp", adjust = adjust)
 k = ncol(psumm)
 del = (psumm[[k]]  psumm[[k1]]) / 4 # half the halfwidth, on lp scale
 diff = psumm[[attr(psumm, "estName")]]
 overlap = apply(psumm[ ,(k1):k], 1, function(x) 2*min(x[1],x[2])/(x[2]x[1]))

 # figure out by variables and indexes (lbv, ubv already defined)
 if(is.null(byv))
 pbv = rep(1, nrow(psumm))
 else
 pbv = do.call("paste", psumm[byv])
 neach = length(lbv) / length(ubv)
 # indexes for pairs results  est[id1]  est[id2]
 id1 = rep(seq_len(neach1), rev(seq_len(neach1)))
 id2 = unlist(sapply(seq_len(neach1), function(x) x + seq_len(neachx)))
 # list of psumm row numbers involved in each summ row
 involved = lapply(seq_len(neach), function(x) union(which(id2==x), which(id1==x)))

 # initialize arrays
 mind = numeric(length(lbv)) # for minima of del
 llen = rlen = numeric(neach) # for left and right arrow lengths
 npairs = length(id1)
 iden = diag(rep(1, 2*neach))

 for (by in ubv) {
 d = del[pbv == by]
 rows = which(lbv == by)
 for(i in seq_len(neach))
 mind[rows[i]] = min(d[involved[[i]]])

 # Set up regression equations to match arrow overlaps with interval overlaps
 # We'll add rows later (with weights 1) to match with mind values
 lmat = rmat = matrix(0, nrow = npairs, ncol = neach)
 y = numeric(npairs)
 v1 = 1  overlap[pbv == by]
 dif = diff[pbv == by]
 for (i in seq_len(npairs)) {
 #wgt = 6 * max(0, ifelse(v1[i] < 1, v1[i], 2v1[i]))
 wgt = 3 + 20 * max(0, .5  (1  v1[i])^2)
 # really this is sqrt of weight
 if (dif[i] > 0) # id2 <> id1
 lmat[i, id1[i]] = rmat[i, id2[i]] = wgt*v1[i]
 else # id1 <> id2
 rmat[i, id1[i]] = lmat[i, id2[i]] = wgt*v1[i]
 y[i] = wgt * abs(dif[i])
 }
 X = rbind(cbind(lmat, rmat),iden)
 y = c(y, rep(mind[rows], 2))
 soln = qr.coef(qr(X), y)
 ll = llen[rows] = soln[seq_len(neach)]
 rl = rlen[rows] = soln[neach + seq_len(neach)]

 # Perhaps put some kind of a check here?
 for (i in seq_len(npairs)) {
 v = 1  v1[i]
 obsv = 1  abs(dif[i]) / ifelse(dif[i] > 0,
 ll[id1[i]] + rl[id2[i]],
 rl[id1[i]] + ll[id2[i]])
 if (v*obsv < 0)
 message("Comparison discrepancy in group ", by,
 ", ", psumm[i, 1],
 ":\n Target overlap = ", round(v, 4),
 ", overlap on graph = ", round(obsv, 4))
 }
 }
 # shorten arrows that go past the data range
 rng = range(est)
 ii = which(est  llen < rng[1])
 llen[ii] = est[ii]  rng[1]
 ii = which(est + rlen > rng[2])
 rlen[ii] = rng[2]  est[ii]

 invtran = I
 if (typeid == 1) {
 tran = extra@misc$tran
 if(is.character(tran)) {
 link = try(make.link(tran), silent=TRUE)
 if (!inherits(link, "tryerror"))
 invtran = link$linkinv
 }
 else if (is.list(tran))
 invtran = tran$linkinv
 }

 lcmpl = invtran(est  llen)
 rcmpl = invtran(est + rlen)
 }
 else lcmpl = rcmpl = NULL


 if (missing(layout)) {
 layout = c(1, length(ubv))
 if(!horizontal)
 layout = rev(layout)
 }

 facName = paste(priv, collapse=":")
 form = as.formula(chform)
 if (horizontal) {
 if (missing(xlab)) xlab = attr(summ, "estName")
 if (missing(ylab)) ylab = facName
 lattice::dotplot(form, prepanel=prepanel.ci, panel=panel.ci,
 strip = my.strip, horizontal = TRUE,
 ylab = ylab, xlab = xlab,
 data = summ, intervals = intervals, lcl=lcl, ucl=ucl,
 lcmpl=lcmpl, rcmpl=rcmpl, layout = layout, ...)
 }
 else {
 if (missing(xlab)) xlab = facName
 if (missing(ylab)) ylab = estName
 lattice::dotplot(form, prepanel=prepanel.ci, panel=panel.ci,
 strip = my.strip, horizontal = FALSE,
 xlab = xlab, ylab = ylab,
 data = summ, intervals = intervals, lcl=lcl, ucl=ucl,
 lcmpl=lcmpl, rcmpl=rcmpl, layout = layout, ...)
 }
}
diff pruN 2.27623/R/pmmeans.R 2.3001/R/pmmeans.R
 2.27623/R/pmmeans.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/pmmeans.R 19700101 00:00:00.000000000 +0000
@@ 1,68 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### Support for overriding "ls" with "pm" in names

### generalpurpose wrapper for creating pmxxxxx functions
.pmwrap = function(lsfcn, ...) {
 result = lsfcn(...)

 if (inherits(result, "ref.grid"))
 result = .sub.ls.pm(result)
 else if(inherits(result, "lsm.list")) {
 for (i in seq_along(result))
 result[[i]] = .sub.ls.pm(result[[i]])
 names(result) = gsub("^ls", "pm", names(result))
 }
 result
}

# returns an updated ref.grid or lsmobj with setName "ls..." replaced by "pm..."
.sub.ls.pm = function(object) {
 nm = object@misc$estName
 update(object, estName = gsub("^ls", "pm", nm))
}

### Exported implementations

pmmeans = function(...)
 .pmwrap(lsmeans, ...)

# uh, maybe not... pmms = pmmeans

pmtrends = function(...)
 .pmwrap(lstrends, ...)


pmmip = function(...)
 lsmip(...)

pmm = function(...)
 lsm(...)

pmmobj = function(...)
 .pmwrap(lsmobj, ...)

pmm.options = function(...)
 lsm.options(...)

get.pmm.option = function(...)
 get.lsm.option(...)
diff pruN 2.27623/R/rbind.R 2.3001/R/rbind.R
 2.27623/R/rbind.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/rbind.R 19700101 00:00:00.000000000 +0000
@@ 1,91 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# rbind method for ref.grid objects

rbind.ref.grid = function(..., deparse.level = 1, adjust = "bonferroni") {
 objs = list(...)
 if (!all(sapply(objs, inherits, "ref.grid")))
 stop("All objects must inherit from 'ref.grid'")
 bhats = lapply(objs, function(o) o@bhat)
 bhat = bhats[[1]]
 if(!all(sapply(bhats, function(b) (length(b) == length(bhat))
 && (sum((b  bhat)^2, na.rm = TRUE) == 0))))
 stop("All objects must have the same fixed effects")
 Vs = lapply(objs, function(o) o@V)
 V = Vs[[1]]
 if(!all(sapply(Vs, function(v) sum((v  V)^2) == 0)))
 stop("All objects must have the same covariances")
 obj = objs[[1]]
 linfcts = lapply(objs, function(o) o@linfct)
 obj@linfct = do.call(rbind, linfcts)
 bnms = unlist(lapply(objs, function(o) o@misc$by.vars))
 grids = lapply(objs, function(o) o@grid)
 gnms = unique(c(bnms, unlist(lapply(grids, names))))
 gnms = setdiff(gnms, c(".wgt.", ".offset.")) # exclude special names
 grid = data.frame(.tmp. = seq_len(n < nrow(obj@linfct)))
 for (g in gnms)
 grid[[g]] = rep(".", n)
 grid[[".wgt."]] = grid[[".offset."]] = 0
 grid$.tmp. = NULL
 n.before = 0
 for (g in grids) {
 rows = n.before + seq_along(g[[1]])
 n.before = max(rows)
 for (nm in setdiff(names(g), c(".wgt.", ".offset.")))
 grid[rows, nm] = as.character(g[[nm]])
 if (!is.null(g$.wgt.)) grid[rows, ".wgt."] = g$.wgt.
 if (!is.null(g$.offset.)) grid[rows, ".wgt."] = g$.offset.
 }
 if (all(grid$.wgt. == 0))
 grid$.wgt. = 1
 if (all(grid$.offset. == 0))
 grid$.offset. = NULL
 avgd.over = unique(unlist(lapply(objs, function(o) o@misc$avgd.over)))
 attr(avgd.over, "qualifier") = " some or all of"
 obj@grid = grid
 obj@levels = lapply(gnms, function(nm) unique(grid[[nm]]))
 names(obj@levels) = gnms
 update(obj, pri.vars = gnms, by.vars = NULL, adjust = adjust,
 famSize = round((1 + sqrt(1 + 8*n)) / 2, 3),
 estType = "contrast", infer = c(FALSE, TRUE),
 avgd.over = avgd.over)
}


### Subset a reference grid
# if drop = TRUE, the levels of factors are reduced
"[.ref.grid" = function(x, i, adjust, drop.levels = TRUE, ...) {
 x@linfct = x@linfct[i, , drop = FALSE]
 x@grid = x@grid[i, , drop = FALSE]
 x = update(x, pri.vars = names(x@grid), famSize = length(i))
 x@misc$by.vars = NULL
 if(!missing(adjust))
 x@misc$adjust = adjust
 if(!is.null(disp < x@misc$display))
 x@misc$display = disp[i]
 if (drop.levels) {
 for (nm in names(x@levels))
 x@levels[[nm]] = unique(x@grid[[nm]])
 }
 x
}

diff pruN 2.27623/R/ref.grid.R 2.3001/R/ref.grid.R
 2.27623/R/ref.grid.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/ref.grid.R 20181102 19:06:33.000000000 +0000
@@ 1,5 +1,5 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
+# Copyright (c) 20122018 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
@@ 19,647 +19,44 @@
# . #
##############################################################################
# Reference grid code
+ref.grid = function(object, ...)
+ emmeans::ref_grid(object, ...)
+recover.data = function(object, ...)
+ emmeans::recover_data(object, ...)
# Change to cov.reduce specification: can be...
# a function: is applied to all covariates
# named list of functions: applied to those covariates (else mean is used)
# TRUE  same as mean
# FALSE  same as function(x) sort(unique(x))

ref.grid < function(object, at, cov.reduce = mean, mult.name, mult.levs,
 options = get.lsm.option("ref.grid"), data, df, type,
 transform = c("none", "response", "mu", "unlink", "log"),
 nesting, ...)
{
 transform = match.arg(transform)
 if (!missing(df)) {
 if(is.null(options)) options = list()
 options$df = df
 }

 # recover the data
 if (missing(data)) {
 data = try(recover.data (object, data = NULL, ...))
 if (inherits(data, "tryerror"))
 stop("Perhaps a 'data' or 'params' argument is needed")
 }
 else # attach needed attributes to given data
 data = recover.data(object, data = data, ...)

 if(is.character(data)) # 'data' is in fact an error message
 stop(data)


 trms = attr(data, "terms")

 # find out if any variables are coerced to factors or vice versa
 coerced = .find.coerced(trms, data) # now list with members 'factors' and 'covariates'

 # convenience function
 sort.unique = function(x) sort(unique(x))

 # Ensure cov.reduce is a function or list thereof
 dep.x = list() # list of formulas to fit later
 fix.cr = function(cvr) {
 # cvr is TRUE or FALSE
 if(is.logical(cvr))
 if(cvr[1]) cvr = mean
 else cvr = sort.unique
 else if (inherits(cvr, "formula")) {
 if (length(cvr) < 3)
 stop("Formulas in 'cov.reduce' must be twosided")
 lhs = .all.vars(cvr)[1]
 dep.x[[lhs]] << cvr
 cvr = mean
 }
 else if (!inherits(cvr, c("function","list")))
 stop("Invalid 'cov.reduce' argument")
 cvr
 }

 # IMPORTANT: following stmts may also affect x.dep
 if (is.list(cov.reduce))
 cov.reduce = lapply(cov.reduce, fix.cr)
 else
 cov.reduce = fix.cr(cov.reduce)

 # zap any formulas that are also in 'at'
 if (!missing(at))
 for (xnm in names(at)) dep.x[[xnm]] = NULL


 # local cov.reduce function that works with function or named list
 cr = function(x, nm) {
 if (is.function(cov.reduce))
 cov.reduce(x)
 else if (hasName(cov.reduce, nm))
 cov.reduce[[nm]](x)
 else
 mean(x)
 }

 # initialize empty lists
 ref.levels = matlevs = xlev = list()

 for (nm in attr(data, "responses")) {
 y = data[[nm]]
 if (is.matrix(y))
 matlevs[[nm]] = apply(y, 2, mean)
 else
 ref.levels[[nm]] = mean(y)
 }

 for (nm in attr(data, "predictors")) {
 x = data[[nm]]

 # Save the original levels of factors, no matter what
 if (is.factor(x) && !(nm %in% coerced$covariates))
 xlev[[nm]] = levels(factor(x))
 # (applying factor drops any unused levels)

 # Now go thru and find reference levels...
 # mentioned in 'at' list but not coerced factor
 if (!(nm %in% coerced$factors) && !missing(at) && (hasName(at, nm)))
 ref.levels[[nm]] = at[[nm]]
 # factors not in 'at'
 else if (is.factor(x) && !(nm %in% coerced$covariates))
 ref.levels[[nm]] = levels(factor(x))
 else if (is.character(x))
 ref.levels[[nm]] = sort.unique(x)
 # matrices
 else if (is.matrix(x)) {
 # Matrices  reduce columns thereof, but don't add to baselevs
 matlevs[[nm]] = apply(x, 2, cr, nm)
 # if cov.reduce returns a vector, average its columns
 if (is.matrix(matlevs[[nm]]))
 matlevs[[nm]] = apply(matlevs[[nm]], 2, mean)
 }
 # covariate coerced, or not mentioned in 'at'
 else {
 # single numeric pred but coerced to a factor  use unique values
 # even if in 'at' list. We'll fix this up later
 if (nm %in% coerced$factors)
 ref.levels[[nm]] = sort.unique(x)

 # Ordinary covariates  summarize
 else
 ref.levels[[nm]] = cr(as.numeric(x), nm)
 }
 }

 # Now create the reference grid
 grid = do.call(expand.grid, ref.levels)

 # add any matrices
 for (nm in names(matlevs))
 grid[[nm]] = matrix(rep(matlevs[[nm]], each=nrow(grid)), nrow=nrow(grid))

 # resolve any covariate formulas
 for (xnm in names(dep.x)) {
 if (!all(.all.vars(dep.x[[xnm]]) %in% names(grid)))
 stop("Formulas in 'cov.reduce' must predict covariates actually in the model")
 xmod = lm(dep.x[[xnm]], data = data)
 grid[[xnm]] = predict(xmod, newdata = grid)
 ref.levels[[xnm]] = NULL
 }

 basis = lsm.basis(object, trms, xlev, grid, ...)

 misc = basis$misc

 ### Figure out if there is a response transformation...
 # next stmt assumes that model formula is 1st argument (2nd element) in call.
 # if not, we probably get an error or something that isn't a formula
 # and it is silently ignored
 lhs = try(eval(attr(data, "call")[[2]][3]), silent = TRUE)
 if (inherits(lhs, "formula")) { # response may be transformed
 tran = setdiff(.all.vars(lhs, functions = TRUE), c(.all.vars(lhs), "~", "cbind", "+", "", "*", "/", "^", "%%", "%/%"))
 if(length(tran) > 0) {
 tran = paste(tran, collapse = ".")
 # length > 1: Almost certainly unsupported, but facilitates a more informative error message

 # Look for a multiplier, e.g. 2*sqrt(y)
 tst = strsplit(strsplit(as.character(lhs[2]), "\\(")[[1]][1], "\\*")[[1]]
 if(length(tst) > 1) {
 mul = suppressWarnings(as.numeric(tst[1]))
 if(!is.na(mul))
 misc$tran.mult = mul
 tran = gsub("\\*\\.", "", tran)
 }
 if (tran == "linkfun")
 tran = as.list(environment(trms))
 if(is.null(misc$tran))
 misc$tran = tran
 else
 misc$tran2 = tran
 misc$inv.lbl = "response"
 }
 }

 # Take care of multivariate response
 multresp = character(0) ### ??? was list()
 ylevs = misc$ylevs
 if(!is.null(ylevs)) { # have a multivariate situation
 if (missing(mult.levs)) {
 if (missing(mult.name))
 mult.name = names(ylevs)[1]
 ref.levels[[mult.name]] = ylevs[[1]]
 multresp = mult.name
 MF = data.frame(ylevs)
 names(MF) = mult.name
 }
 else {
 k = prod(sapply(mult.levs, length))
 if (k != length(ylevs[[1]]))
 stop("supplied 'mult.levs' is of different length than that of multivariate response")
 for (nm in names(mult.levs))
 ref.levels[[nm]] = mult.levs[[nm]]
 multresp = names(mult.levs)
 MF = do.call("expand.grid", mult.levs)
 }
 ###grid = do.call("expand.grid", ref.levels)
 grid = merge(grid, MF)
 # add any matrices
 for (nm in names(matlevs))
 grid[[nm]] = matrix(rep(matlevs[[nm]], each=nrow(grid)), nrow=nrow(grid))
 }

# Here's a complication. If a numeric predictor was coerced to a factor, we had to
# include all its levels in the reference grid, even if altered in 'at'
# Moreover, whatever levels are in 'at' must be a subset of the unique values
# So we now need to subset the rows of the grid and linfct based on 'at'

 problems = if (!missing(at))
 intersect(c(multresp, coerced$factors), names(at))
 else character(0)
 if (length(problems) > 0) {
 incl.flags = rep(TRUE, nrow(grid))
 for (nm in problems) {
 if (is.numeric(ref.levels[[nm]])) {
 at[[nm]] = round(at[[nm]], 3)
 ref.levels[[nm]] = round(ref.levels[[nm]], 3)
 }
 # get only "legal" levels
 at[[nm]] = at[[nm]][at[[nm]] %in% ref.levels[[nm]]]
 # Now which of those are left out?
 excl = setdiff(ref.levels[[nm]], at[[nm]])
 for (x in excl)
 incl.flags[grid[[nm]] == x] = FALSE
 ref.levels[[nm]] = at[[nm]]
 }
 if (!any(incl.flags))
 stop("Reference grid is empty due to mismatched levels in 'at'")
 grid = grid[incl.flags, , drop=FALSE]
 basis$X = basis$X[incl.flags, , drop=FALSE]
 }

 # Any offsets??? (misc$offset.mult might specify removing or reversing the offset)
 if(!is.null(attr(trms,"offset"))) {
 om = 1
 if (!is.null(misc$offset.mult))
 om = misc$offset.mult
 if (any(om != 0))
 grid[[".offset."]] = om * .get.offset(trms, grid)
 }

 ###  Determine weights for each grid point  (added ver.2.11), updated ver.2.14 to include weights
 if (!hasName(data, "(weights)"))
 data[["(weights)"]] = 1
 nms = union(names(xlev), coerced$factors) # only factors, no covariates or mult.resp
 # originally, I used 'plyr::count', but there are probs when there is a 'freq' variable
 id = plyr::id(data[, nms, drop = FALSE], drop = TRUE)
 uid = !duplicated(id)
 key = do.call(paste, data[uid, nms, drop = FALSE])
 key = key[order(id[uid])]
 #frq = tabulate(id, attr(id, "n"))
 tgt = do.call(paste, grid[, nms, drop = FALSE])
 wgt = rep(0, nrow(grid))
 for (i in seq_along(key))
 wgt[tgt == key[i]] = sum(data[["(weights)"]][id==i])
 grid[[".wgt."]] = wgt

 model.info = list(call = attr(data,"call"), terms = trms, xlev = xlev)
 # Detect any nesting structures
 nst = .find_nests(grid, trms, ref.levels)
 if (length(nst) > 0)
 model.info$nesting = nst

 misc$ylevs = NULL # No longer needed
 misc$estName = "prediction"
 misc$estType = "prediction"
 misc$infer = c(FALSE,FALSE)
 misc$level = .95
 misc$adjust = "none"
 misc$famSize = nrow(grid)
 misc$avgd.over = character(0)

 post.beta = basis$post.beta
 if (is.null(post.beta))
 post.beta = matrix(NA)

 result = new("ref.grid",
 model.info = model.info,
 roles = list(predictors = attr(data, "predictors"),
 responses = attr(data, "responses"),
 multresp = multresp),
 grid = grid, levels = ref.levels, matlevs = matlevs,
 linfct = basis$X, bhat = basis$bhat, nbasis = basis$nbasis, V = basis$V,
 dffun = basis$dffun, dfargs = basis$dfargs,
 misc = misc, post.beta = post.beta)

 if (!missing(type)) {
 if (is.null(options)) options = list()
 options$predict.type = type
 }

 if (!missing(nesting))
 result@model.info$nesting = .parse_nest(nesting)

 if(!is.null(options)) {
 options$object = result
 result = do.call("update.ref.grid", options)
 }

 if(!is.null(hook < misc$postGridHook)) {
 if (is.character(hook))
 hook = get(hook)
 result@misc$postGridHook = NULL
 result = hook(result)
 }
 if(transform != "none")
 result = regrid(result, transform = transform)

 .save.ref.grid(result)
 result
}


#### End of ref.grid 

# local utility to identify ref.grid that is not an lsmobj
.is.true.ref.grid = function(object) {
 is(object, "ref.grid") && !is(object, "lsmobj")
}

# local utility to save each newly constructed ref.grid, if enabled
# Goes into global environment unless .Last.ref.grid is found further up
.save.ref.grid = function(object) {
 if(get.lsm.option("save.ref.grid") && .is.true.ref.grid(object))
 assign(".Last.ref.grid", object, inherits = TRUE)
}
+lsm.basis = function(object, ...)
+ emmeans::emm_basis(object, ...)
+## methods for lsm.list
# This function figures out which covariates in a model
# have been coerced to factors. And also which factors have been coerced
# to be covariates
.find.coerced = function(trms, data) {
 if (ncol(data) == 0)
 return(list(factors = integer(0), covariates = integer(0)))
 isfac = sapply(data, function(x) inherits(x, "factor"))

 # Character vectors of factors and covariates in the data...
 facs.d = names(data)[isfac]
 covs.d = names(data)[!isfac]

 lbls = attr(trms, "term.labels")
 M = model.frame(trms, utils::head(data, 2)) #### just need a couple rows
 isfac = sapply(M, function(x) inherits(x, "factor"))

 # Character vector of terms in the model frame that are factors ...
 facs.m = names(M)[as.logical(isfac)]
 covs.m = setdiff(names(M), facs.m)

 # Exclude the terms that are already factors
 # What's left will be things like "factor(dose)", "interact(dose,treat)", etc
 cfac = setdiff(facs.m, facs.d)
 if(length(cfac) != 0) {
 cvars = lapply(cfac, function(x) .all.vars(stats::reformulate(x))) # Strip off the function calls
 cfac = intersect(unique(unlist(cvars)), covs.d) # Exclude any variables that are already factors
 }

 # Do same with covariates
 ccov = setdiff(covs.m, covs.d)
 if(length(ccov) > 0) {
 cvars = lapply(ccov, function(x) .all.vars(stats::reformulate(x)))
 ccov = intersect(unique(unlist(cvars)), facs.d)
 }

 list(factors = cfac, covariates = ccov)
}

# calculate the offset for the given grid
.get.offset = function(terms, grid) {
 off.idx = attr(terms, "offset")
 offset = rep(0, nrow(grid))
 tvars = attr(terms, "variables")
 for (i in off.idx)
 offset = offset + eval(tvars[[i+1]], grid)
 offset
}



### =========== Methods for ref.grid class =============================
# (note: summaryrelated methods moved to a new file)

str.ref.grid < function(object, ...) {
 showlevs = function(x) { # internal convenience function
 if (is.null(x)) cat("(predicted by other variables)")
 else cat(paste(format(x, digits = 5, justify = "none"), collapse=", "))
 }
 showtran = function(tran, label) { # internal convenience fcn
 if (is.list(tran))
 tran = ifelse(is.null(tran$name), "custom", tran$name)
 if (!is.null(mul < object@misc$tran.mult))
 tran = paste0(mul, "*", tran)
 cat(paste(label, dQuote(tran), "\n"))

 }
 levs = object@levels
 cat(paste("'", class(object)[1], "' object with variables:\n", sep=""))
 for (nm in union(object@roles$predictors, union(object@roles$multresp, object@roles$responses))) {
 cat(paste(" ", nm, " = ", sep = ""))
 if (hasName(object@matlevs, nm)) {
 if (nm %in% object@roles$responses)
 cat("multivariate response with means: ")
 else
 cat("matrix with column means: ")
 cat("\n ")
 showlevs(object@matlevs[[nm]])
 }
 else if (nm %in% object@roles$multresp) {
 cat("multivariate response levels: ")
 showlevs(levs[[nm]])
 }
 else if (nm %in% object@roles$responses) {
 cat("response variable with mean ")
 showlevs(levs[[nm]])
 }
 else
 showlevs(levs[[nm]])
 cat("\n")
 }
 if(!is.null(object@model.info$nesting)) {
 cat("Nesting structure: ")
 cat(.fmt.nest(object@model.info$nesting))
 cat("\n")
 }
 if(!is.null(tran < object@misc$tran)) {
 showtran(tran, "Transformation:")
 if (!is.null(tran2 < object@misc$tran2))
 showtran(tran2, "Additional response transformation:")
 }
}



print.ref.grid = function(x,...)
 print(summary.ref.grid(x, ...))


# vcov method
vcov.ref.grid = function(object, ...) {
 tol = get.lsm.option("estble.tol")
 if (!is.null(hook < object@misc$vcovHook)) {
 if (is.character(hook))
 hook = get(hook)
 hook(object, tol = tol, ...)
 }
 else {
 X = object@linfct
 estble = estimability::is.estble(X, object@nbasis, tol) ###apply(X, 1, .is.estble, object@nbasis, tol)
 X[!estble, ] = NA
 X = X[, !is.na(object@bhat), drop = FALSE]
 X %*% tcrossprod(object@V, X)
 }
}


# Method to alter contents of misc slot
update.ref.grid = function(object, ..., silent = FALSE) {
 args = list(...)
 valid.misc = c("adjust","alpha","avgd.over","by.vars","delta","df",
 "initMesg","estName","estType","famSize","infer","inv.lbl",
 "level","methdesc","nesting","null","predict.type","pri.vars","side","tran","tran.mult","tran2")
 valid.slots = slotNames(object)
 valid.choices = union(valid.misc, valid.slots)
 misc = object@misc
 for (nm in names(args)) {
 fullname = try(match.arg(nm, valid.choices), silent=TRUE)
 if(inherits(fullname, "tryerror")) {
 if (!silent)
 message("Argument ", sQuote(nm), " was ignored. Valid choices are:\n",
 paste(valid.choices, collapse=", "))
 }
 else {
 if (fullname %in% valid.slots)
 slot(object, fullname) = args[[nm]]
 else {
 if (fullname == "by.vars") {
 allvars = union(misc$pri.vars, misc$by.vars)
 misc$pri.vars = setdiff(allvars, args[[nm]])
 }
 if (fullname == "pri.vars") {
 allvars = union(misc$pri.vars, misc$by.vars)
 misc$by.vars = setdiff(allvars, args[[nm]])
 }
 if (fullname == "nesting") # special case  I keep nesting in model.info
 object@model.info$nesting = args[[nm]]
 else
 misc[[fullname]] = args[[nm]]
 }
 }
 }
 object@misc = misc
+as.emm_list = function(object) {
+ class(object) = c("emm_list", "list")
object
}
### set or change lsmeans options
lsm.options = function(...) {
 opts = getOption("lsmeans", list())
# if (is.null(opts)) opts = list()
 newopts = list(...)
 for (nm in names(newopts))
 opts[[nm]] = newopts[[nm]]
 options(lsmeans = opts)
 if (length(newopts) > 0)
 invisible(opts)
 else
 opts
}
+as.glht.lsm.list = function(object, ...)
+ emmeans::as.glht(as.emm_list(object), ...)
# equivalent of getOption()
get.lsm.option = function(x, default = defaults.lsm[[x]]) {
 opts = getOption("lsmeans", list())
 if(is.null(default)  hasName(opts, x))
 opts[[x]]
 else
 default
}
+coef.lsm.list = function(object, ...)
+ stats::coef(as.emm_list(object), ...)
### Exported defaults for certain options
defaults.lsm = list(
 estble.tol = 1e8, # tolerance for estimability checks
 lmer.df = "satterth", # Use Satterthwaite method for df
 disable.pbkrtest = FALSE, # whether to bypass pbkrtest routines for lmerMod
 pbkrtest.limit = 3000, # limit on N for enabling adj V
 save.ref.grid = TRUE # save new ref.grid in .Last.ref.grid
)

# Utility that returns TRUE if getOption("lsmeans")[[opt]] is TRUE
.lsm.is.true = function(opt) {
 x = get.lsm.option(opt)
 if (is.logical(x)) x
 else FALSE
}
+confint.lsm.list = function(object, ...)
+ stats::confint(as.emm_list(object), ...)
+contrast.lsm.list = function(object, ...)
+ emmeans::contrast(as.emm_list(object), ...)
### Utility to change the internal structure of a ref.grid
### Returned ref.grid object has linfct = I and bhat = estimates
### Primary reason to do this is with transform = TRUE, then can
### work with linear functions of the transformed predictions
regrid = function(object, transform = c("response", "mu", "unlink", "log", "none"),
 inv.log.lbl = "response", predict.type)
{
 if (is.logical(transform)) # for backwardcompatibility
 transform = ifelse(transform, "response", "none")
 else
 transform = match.arg(transform)

 # if we have two transformations to undo, do the first one recursively
 if ((transform == "response") && (!is.null(object@misc$tran2)))
 object = regrid(object, transform = "mu")

 # Save post.beta stuff
 PB = object@post.beta
 NC = attr(PB, "n.chains")

 if (!is.na(PB[1])) # fix up post.beta BEFORE we overwrite parameters
 PB = PB %*% t(object@linfct)

 est = .est.se.df(object, do.se = TRUE) ###FALSE)
 estble = !(is.na(est[[1]]))
 object@V = vcov(object)[estble, estble, drop=FALSE]
 object@bhat = est[[1]]
 object@linfct = diag(1, length(estble))
 if(all(estble))
 object@nbasis = estimability::all.estble
 else
 object@nbasis = object@linfct[, !estble, drop = FALSE]

 # override the df function
 df = est$df
 test.df = diff(range(df))
 if (is.na(test.df)  test.df < .001) {
 object@dfargs = list(df = mean(df))
 object@dffun = function(k, dfargs) dfargs$df
 }
 else { # use containment df
 object@dfargs = list(df = df)
 object@dffun = function(k, dfargs) {
 idx = which(zapsmall(k) != 0)
 ifelse(length(idx) == 0, NA, min(dfargs$df[idx]))
 }
 }

 if(transform %in% c("response", "mu", "unlink", "log") && !is.null(object@misc$tran)) {
 link = attr(est, "link")
 D = .diag(link$mu.eta(object@bhat[estble]))
 object@bhat = link$linkinv(object@bhat)
 object@V = D %*% tcrossprod(object@V, D)
 if (!is.na(PB[1]))
 PB = matrix(link$linkinv(PB), ncol = ncol(PB))
 inm = object@misc$inv.lbl
 if (!is.null(inm))
 object@misc$estName = inm
 if((transform %in% c("mu", "unlink")) && !is.null(object@misc$tran2)) {
 object@misc$tran = object@misc$tran2
 object@misc$tran2 = object@misc$tran.mult = object@misc$inv.lbl = NULL
 }
 else
 object@misc$tran = object@misc$tran.mult = object@misc$inv.lbl = NULL
 }
 if (transform == "log") { # from prev block, we now have stuff on response scale
 incl = which(object@bhat > 0)
 if (length(incl) < length(object@bhat)) {
 message("Nonpositive response predictions are flagged as nonestimable")
 tmp = seq_along(object@bhat)
 excl = tmp[incl]
 object@bhat[excl] = NA
 object@nbasis = sapply(excl, function(ii) 0 + (tmp == ii))
 }
 D = .diag(1/object@bhat[incl])
 object@V = D %*% tcrossprod(object@V[incl, incl, drop = FALSE], D)
 object@bhat = log(object@bhat)
 if (!is.na(PB[1])) {
 PB[PB <= 0] = NA
 PB = log(PB)
 PB[1] = ifelse(is.na(PB[1]), 0, PB[1]) # make sure 1st elt isn't NA
 }
 object@misc$tran = "log"
 object@misc$inv.lbl = inv.log.lbl
 }

 if(!is.na(PB[1])) {
 attr(PB, "n.chains") = NC
 object@post.beta = PB
 }

 # Nix out things that are no longer needed or valid
 object@grid$.offset. = object@misc$offset.mult =
 object@misc$estHook = object@misc$vcovHook = NULL
 if(!missing(predict.type))
 object = update(object, predict.type = predict.type)
 object
}

+pairs.lsm.list = function(x, ...)
+ graphics::pairs(as.emm_list(x), ...)
### S4 methods
## use S3 for this setMethod("summary", "ref.grid", summary.ref.grid)
setMethod("show", "ref.grid", function(object) str.ref.grid(object))
+summary.lsm.list = function(object, ...)
+ summary(as.emm_list(object), ...)
+str.lsm.list = function(object, ...)
+ utils::str(as.emm_list(object), ...)
+test.lsm.list = function(object, ...)
+ emmeans::test(as.emm_list(object), ...)
diff pruN 2.27623/R/reformulate.R 2.3001/R/reformulate.R
 2.27623/R/reformulate.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/reformulate.R 19700101 00:00:00.000000000 +0000
@@ 1,28 +0,0 @@
######################################################################
### Contributed by Jonathon Love, https://github.com/jonathonlove ###
######################################################################

# reformulate for us internally in lsmeans
# same as stats::reformulate, except it surrounds term labels with backsticks

# RVL note: I renamed it .reformulate to avoid certain issues.
# For example I need reformulate() sometimes to strip off function calls
# and this .reformulate works quite differently.

.reformulate < function (termlabels, response = NULL, intercept = TRUE)
{
 if (!is.character(termlabels)  !length(termlabels))
 stop("'termlabels' must be a character vector of length at least one")
 has.resp < !is.null(response)
 termtext < paste(if (has.resp)
 "response", "~", paste0("`", termlabels, "`", collapse = "+"), collapse = "")
 if (!intercept)
 termtext < paste(termtext, " 1")
 rval < eval(parse(text = termtext, keep.source = FALSE)[[1L]])
 if (has.resp)
 rval[[2L]] < if (is.character(response))
 as.symbol(response)
 else response
 environment(rval) < parent.frame()
 rval
}
diff pruN 2.27623/R/rmssupport.R 2.3001/R/rmssupport.R
 2.27623/R/rmssupport.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/rmssupport.R 19700101 00:00:00.000000000 +0000
@@ 1,128 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# Support for objects in the *rms* package

recover.data.rms = function(object, ...) {
 fcall = object$call
 recover.data(fcall, delete.response(terms(object)), object$na.action$omit, ...)
}

# TODO:
# 1. If multivariate  like mlm method?
# 2. orm cases?

lsm.basis.rms = function(object, trms, xlev, grid,
 mode = c("middle", "latent", "linear.predictor", "cum.prob", "exc.prob", "prob", "mean.class"),
 vcov., ...) {
 mode = match.arg(mode)
 bhat = coef(object)
 if (missing(vcov.))
 V = vcov(object, intercepts = "all")
 else
 V = .my.vcov(object, vcov.)
 misc = list()

 X = predict(object, newdata = grid, type = "x")
 #xnames = dimnames(X)[[2]]
 #intcpts = setdiff(names(bhat), xnames)
 nint = length(bhat)  ncol(X)
 intcpts = names(bhat)[seq_len(nint)]
 xnames = setdiff(names(bhat), intcpts)

 if (length(intcpts) == 1)
 mode = "single" # stealth mode for ordinary singleintercept case
 if (mode %in% c("single", "middle", "latent")) {
 X = cbind(1, X)
 mididx = ifelse(mode != "middle", 1, as.integer((1 + length(intcpts)) / 2))
 dimnames(X)[[2]][1] = switch(mode,
 single = intcpts,
 middle = intcpts[mididx],
 latent = "avg.intercept")
 if (mode == "middle") {
 nms = c(intcpts[mididx], xnames)
 bhat = bhat[nms]
 V = V[nms, nms, drop = FALSE]
 }
 else if (mode == "latent") {
 bhat = c(mean(bhat[intcpts]), bhat[xnames])
 nx = length(xnames)
 J1 = rbind(rep(1/nint, nint),
 matrix(0, nrow = nx, ncol = nint))
 J2 = rbind(0, diag(1, nx))
 J = cbind(J1, J2)
 V = J %*% V %*% t(J)
 }
 ### else mode == "single" and all is OK as it is
 }
 else { # mode %in% c("linear.predictor", "cum.prob", "exc.prob", "prob", "mean.class")
 misc$ylevs = list(cut = intcpts)
 I = diag(1, nint)
 J = matrix(1, nrow = nrow(X))
 JJ = matrix(1, nrow=nint)
 X = cbind(kronecker(I, J), kronecker(JJ, X))
 # Note V is correct asis
 dimnames(X)[[2]] = c(intcpts, xnames)
 if (mode != "linear.predictor") {
 misc$mode = mode
 misc$postGridHook = .clm.postGrid
 misc$respName = as.character(object$terms)[2]
 }
 }

 # I think rms does not allow rank deficiency...
 nbasis = estimability::all.estble
 if (!is.null(object$family)) {
 if (!is.character(object$family))
 misc = .std.link.labels(object$family, misc)
 else {
 misc$tran = object$family
 if (misc$tran == "logistic") misc$tran = "logit"
 misc$inv.lbl = switch(class(object)[1],
 orm = "exc.prob",
 lrm = ifelse(nint == 1, "prob", "exc.prob"),
 "response")
 }
 dffun = function(k, dfargs) NA
 dfargs = list()
 }
 else {
 dfargs = list(df = object$df.residual)
 if (is.null(dfargs$df))
 dfargs$df = NA
 dffun = function(k, dfargs) dfargs$df
 }
 list(X=X, bhat=bhat, nbasis=nbasis, V=V,
 dffun=dffun, dfargs=dfargs, misc=misc)
}



## Courtesy method to prevent masking this generic in rms package
# Excluded because this just causes headaches with CRAN's
# dependency checking.
# contrast.rms = function(object, ...) {
# if (requireNamespace("rms"))
# rms::contrast(object, ...)
# else
# stop ("The 'rms' package is not installed.")
#
# }
diff pruN 2.27623/R/S4classes.R 2.3001/R/S4classes.R
 2.27623/R/S4classes.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/S4classes.R 20181026 19:02:21.000000000 +0000
@@ 1,5 +1,5 @@
##############################################################################
# Copyright (c) 20122017 Russell V. Lenth #
+# Copyright (c) 20122018 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
@@ 20,38 +20,12 @@
##############################################################################
### S4 class definitions for lsmeans package
+### Wwe now merely extend emmeans::emmGrid
### ref.grid object  for a reference grid
setClass("ref.grid", slots = c(
 model.info = "list",
 roles = "list",
 grid = "data.frame",
 levels = "list",
 matlevs = "list",
 linfct = "matrix",
 bhat = "numeric",
 nbasis = "matrix",
 V = "matrix",
 dffun = "function",
 dfargs = "list",
 misc = "list",
 post.beta = "matrix"
))
# Note: misc will hold various extra params,
# including at least the following req'd by the summary method
# estName: column name for the estimate in the summary ["prediction"]
# infer: booleans (CIs?, tests?) [(FALSE,FALSE)]
# level: default conf level [.95]
# adjust: default adjust method ["none"]
# famSize: number of means in family
+setClass("ref.grid", contains = "emmGrid")


### lsmobj class  almost trivial ext of ref.grid, structurally
# But origin can be very different from those of a reference grid
# In general its 'grid' will correspond to some set of
# linear functions of grid points
setClass("lsmobj", contains="ref.grid")
diff pruN 2.27623/R/summary.R 2.3001/R/summary.R
 2.27623/R/summary.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/summary.R 19700101 00:00:00.000000000 +0000
@@ 1,698 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### This file has summary.ref.grid S3 method and related functions

# Computes the quadratic form y'Xy after subsetting for the nonzero elements of y
.qf.non0 = function(X, y) {
 ii = (zapsmall(y) != 0)
 if (any(ii))
 sum(y[ii] * (X[ii, ii, drop = FALSE] %*% y[ii]))
 else 0
}

# utility fcn to get est's, std errors, and df
# new arg: do.se  if FALSE, just do the estimates and return 0 for se and df
# returns a data.frame with an add'l "link" attribute if misc$tran is nonnull
# .est.se.df = function(linfct, bhat, nbasis, V, dffun, dfargs, misc, do.se=TRUE,
# tol=getOption("lsmeans")$estble.tol) {
# 2.13: Revised to call w/ just object instead of all those args (except linfct)
# Also moved offset comps to here, and provided for misc$estHook
.est.se.df = function(object, do.se=TRUE, tol = get.lsm.option("estble.tol")) {
 if (nrow(object@grid) == 0) {
 result = data.frame(NA, NA, NA)
 names(result) = c(object@misc$estName, "SE", "df")
 return(result[1, ])
 }
 misc = object@misc
 use.elts = if (is.null(misc$display)) rep(TRUE, nrow(object@grid))
 else misc$display

 if (!is.null(hook < misc$estHook)) {
 if (is.character(hook)) hook = get(hook)
 result = hook(object, do.se=do.se, tol=tol)
 }
 else {
 active = which(!is.na(object@bhat))
 bhat = object@bhat[active]
 result = t(apply(object@linfct[use.elts, , drop = FALSE], 1, function(x) {
 if (!any(is.na(x)) && estimability::is.estble(x, object@nbasis, tol)) {
 x = x[active]
 est = sum(bhat * x)
 if(do.se) {
 se = sqrt(.qf.non0(object@V, x))
 df = object@dffun(x, object@dfargs)
 }
 else # if these unaskedfor results are used, we're bound to get an error!
 se = df = 0
 c(est, se, df)
 }
 else c(NA,NA,NA)
 }))

 if (!is.null(object@grid$.offset.))
 result[, 1] = result[, 1] + object@grid$.offset.[use.elts]
 }
 result[1] = as.numeric(result[1]) # silly bit of code to avoid getting a data.frame of logicals if all are NA
 result = as.data.frame(result)
 names(result) = c(misc$estName, "SE", "df")

 if (!is.null(misc$tran) && (misc$tran != "none")) {
 link = if(is.character(misc$tran))
 .make.link(misc$tran)
 else if (is.list(misc$tran))
 misc$tran
 else
 NULL

 if (is.list(link)) { # See if multiple of link is requested
 if (!is.null(misc$tran.mult))
 link$mult = misc$tran.mult
 if (!is.null(link$mult))
 link = with(link, list(
 linkinv = function(eta) linkinv(eta / mult),
 mu.eta = function(eta) mu.eta(eta / mult) / mult,
 name = paste0(round(mult, 3), "*", name)))
 }

 if (!is.null(link) && is.null(link$name))
 link$name = "linearpredictor"
 attr(result, "link") = link
 }
 result
}

# utility to compute an adjusted p value
# tail is 1, 0, 1 for left, twosided, or right
# Note fam.info is c(famsize, ncontr, estTypeIndex)
# 2.14: added corrmat arg, dunnettx & mvt adjustments
# NOTE: corrmat is NULL unless adjust == "mvt"
.adj.p.value = function(t, DF, adjust, fam.info, tail, corrmat, by.rows) {
 fam.size = fam.info[1]
 n.contr = fam.info[2]
 et = as.numeric(fam.info[3])

 ragged.by = (is.character(fam.size)) # flag that we need to do groups separately
 if (!ragged.by)
 by.rows = list(seq_along(t)) # not ragged, we can do all as one by group

 if (n.contr == 1) # Force no adjustment when just one test
 adjust = "none"

 # do a pmatch of the adjust method, case insensitive
 adj.meths = c("sidak", "tukey", "scheffe", "dunnettx", "mvt", p.adjust.methods)
 k = pmatch(tolower(adjust), adj.meths)
 if(is.na(k))
 stop("Adjust method '", adjust, "' is not recognized or not valid")
 adjust = adj.meths[k]
 if ((tail != 0) && (adjust %in% c("tukey", "scheffe", "dunnettx"))) # meth not approp for 1sided
 adjust = "sidak"
 if ((et != 3) && adjust == "tukey") # not pairwise
 adjust = "sidak"

 # asymptotic results when df is NA
 DF[is.na(DF)] = Inf

 # if estType is "prediction", use #contrasts + 1 as family size
 # (produces right Scheffe CV; Tukey ones are a bit strange)
 scheffe.adj = ifelse(et == 1, 0,  1)
 if (tail == 0)
 p.unadj = 2*pt(abs(t), DF, lower.tail=FALSE)
 else
 p.unadj = pt(t, DF, lower.tail = (tail<0))

 pvals = lapply(by.rows, function(rows) {
 unadj.p = p.unadj[rows]
 abst = abs(t[rows])
 df = DF[rows]
 if (ragged.by) {
 n.contr = length(rows)
 fam.size = (1 + sqrt(1 + 8*n.contr)) / 2 # tukey family size  e.g., 6 pairs > family of 4
 }
 if (adjust %in% p.adjust.methods) {
 if (n.contr == length(unadj.p))
 pval = p.adjust(unadj.p, adjust, n = n.contr)
 else # only will happen when by.rows is length 1
 pval = as.numeric(apply(matrix(unadj.p, nrow=n.contr), 2,
 function(pp) p.adjust(pp, adjust, n=sum(!is.na(pp)))))
 }
 else pval = switch(adjust,
 sidak = 1  (1  unadj.p)^n.contr,
 # NOTE: tukey, scheffe, dunnettx all assumed 2sided!
 tukey = ptukey(sqrt(2)*abst, fam.size, zapsmall(df), lower.tail=FALSE),
 scheffe = pf(t[rows]^2 / (n.contr + scheffe.adj), n.contr + scheffe.adj,
 df, lower.tail = FALSE),
 dunnettx = 1  .pdunnx(abst, n.contr, df),
 mvt = 1  .my.pmvt(t[rows], df, corrmat[rows,rows,drop=FALSE], tail) # tricky  reverse the tail because we're subtracting from 1
 )
 })
 pval = unlist(pvals)

 chk.adj = match(adjust, c("none", "tukey", "scheffe"), nomatch = 99)

 if (ragged.by) {
 nc = max(sapply(by.rows, length))
 fs = (1 + sqrt(1 + 8*nc)) / 2
 scheffe.dim = "(varies)"
 }
 else {
 nc = n.contr
 fs = fam.size
 scheffe.dim = nc + scheffe.adj
 }
 do.msg = (chk.adj > 1) && (nc > 1) && !((fs < 3) && (chk.adj < 10))
 if (do.msg) {
# xtra = if(chk.adj < 10) paste("a family of", fam.size, "tests")
# else paste(n.contr, "tests")
 xtra = switch(adjust,
 tukey = paste("for comparing a family of", fam.size, "estimates"),
 scheffe = paste("with dimensionality", scheffe.dim),
 paste("for", n.contr, "tests")
 )
 mesg = paste("P value adjustment:", adjust, "method", xtra)
 }
 else mesg = NULL
 list(pval=pval, mesg=mesg, adjust=adjust)
}

# Code needed for an adjusted critical value
# returns a list similar to .adj.p.value
# 2.14: Added tail & corrmat args, dunnettx & mvt adjustments
# NOTE: corrmat is NULL unless adjust == "mvt"
.adj.critval = function(level, DF, adjust, fam.info, tail, corrmat, by.rows) {
 mesg = NULL

 fam.size = fam.info[1]
 n.contr = fam.info[2]
 et = as.numeric(fam.info[3])

 ragged.by = (is.character(fam.size)) # flag that we need to do groups separately
 if (!ragged.by)
 by.rows = list(seq_along(t)) # not ragged, we can do all as one by group

 if (!ragged.by && n.contr == 1) # Force no adjustment when just one interval
 adjust = "none"

 adj.meths = c("sidak", "tukey", "scheffe", "dunnettx", "mvt", "bonferroni", "none")
 k = pmatch(tolower(adjust), adj.meths)
 if(is.na(k))
 k = which(adj.meths == "bonferroni")
 adjust = adj.meths[k]


 if ((et != 3) && adjust == "tukey") # not pairwise
 adjust = "sidak"
 if ((tail != 0) && (adjust %in% c("tukey", "scheffe", "dunnettx"))) # meth not approp for 1sided
 adjust = "sidak"
 if ((et != 3) && adjust == "tukey") # not pairwise
 adjust = "sidak"

 # asymptotic results when df is NA
 DF[is.na(DF)] = Inf
 scheffe.adj = ifelse(et == 1, 0,  1)

 chk.adj = match(adjust, c("none", "tukey", "scheffe"), nomatch = 99)
 if (ragged.by) {
 nc = max(sapply(by.rows, length))
 fs = (1 + sqrt(1 + 8*nc)) / 2
 scheffe.dim = "(varies)"
 }
 else {
 nc = n.contr
 fs = fam.size
 scheffe.dim = nc + scheffe.adj
 }
 do.msg = (chk.adj > 1) && (nc > 1) &&
 !((fs < 3) && (chk.adj < 10))

 if (do.msg) {
# xtra = if(chk.adj < 10) paste("a family of", fam.size, "estimates")
# else paste(n.contr, "estimates")
 xtra = switch(adjust,
 tukey = paste("for comparing a family of", fam.size, "estimates"),
 scheffe = paste("with dimensionality", scheffe.dim),
 paste("for", n.contr, "estimates")
 )
 mesg = paste("Conflevel adjustment:", adjust, "method", xtra)
 }

 adiv = ifelse(tail == 0, 2, 1) # divisor for alpha where needed

 cvs = lapply(by.rows, function(rows) {
 df = DF[rows]
 if (ragged.by) {
 n.contr = length(rows)
 fam.size = (1 + sqrt(1 + 8*n.contr)) / 2 # tukey family size  e.g., 6 pairs > family of 4
 }
 switch(adjust,
 none = qt((1level)/adiv, df),
 sidak = qt((1  level^(1/n.contr))/adiv, df),
 bonferroni = qt((1level)/n.contr/adiv, df),
 tukey = qtukey(level, fam.size, df) / sqrt(2),
 scheffe = sqrt(n.contr + scheffe.adj * qf(level, n.contr + scheffe.adj, df)),
 dunnettx = .qdunnx(level, n.contr, df),
 mvt = .my.qmvt(level, df, corrmat[rows,rows,drop=FALSE], tail)
 )
 })

 list(cv = unlist(cvs), mesg = mesg, adjust = adjust)
}


### My own functions to ease access to mvt functions
### These use one argument at a time and expands each (lower, upper) or p to a kvector
### Use tailnum = 1, 0, or 1
### NOTE: corrmat needs "by.rows" attribute to tell which rows
### belong to which submatrix.
.my.pmvt = function(x, df, corrmat, tailnum) {
 lower = switch(tailnum + 2, Inf, abs(x), x)
 upper = switch(tailnum + 2, x, abs(x), Inf)
 by.rows = attr(corrmat, "by.rows")
 if (is.null(by.rows))
 by.rows = list(seq_len(length(x)))
 by.sel = numeric(length(x))
 for (i in seq_along(by.rows))
 by.sel[by.rows[[i]]] = i
 df = .fix.df(df)
 apply(cbind(lower, upper, df, by.sel), 1, function(z) {
 idx = by.rows[[z[4]]]
 k = length(idx)
 pval = try(mvtnorm::pmvt(rep(z[1], k), rep(z[2], k),
 df = as.integer(z[3]), corr = corrmat[idx, idx]),
 silent = TRUE)
 if (inherits(pval, "tryerror")) NA
 else pval
 })
}

# Vectorized for df but needs p to be scalar
.my.qmvt = function(p, df, corrmat, tailnum) {
 tail = c("lower.tail", "both.tails", "lower.tail")[tailnum + 2]
 df = .fix.df(df)
 by.rows = attr(corrmat, "by.rows")
 if (is.null(by.rows))
 by.rows = list(seq_len(length(df)))
 by.sel = numeric(length(df))
 for (i in seq_along(by.rows))
 by.sel[by.rows[[i]]] = i
 # If df all equal, compute just once for each by group
 eq.df = (diff(range(df)) == 0)
 i1 = if (eq.df) sapply(by.rows, function(r) r[1])
 else seq_along(df)
 result = apply(cbind(p, df[i1], by.sel[i1]), 1, function(z) {
 idx = by.rows[[z[3]]]
 cv = try(mvtnorm::qmvt(z[1], tail = tail,
 df = as.integer(z[2]), corr = corrmat[idx, idx])$quantile,
 silent = TRUE)
 if (inherits(cv, "tryerror")) NA
 else cv
 })
 if (eq.df) {
 res = result
 result = numeric(length(df))
 for(i in seq_along(by.rows))
 result[by.rows[[i]]] = res[i]
 }
 result
}

# utility to get appropriate integer df
.fix.df = function(df) {
 sapply(df, function(d) {
 if (d > 0) d = max(1, d)
 if (is.infinite(d)  (d > 9999)) d = 0
 floor(d + .25) # tends to round down
 })
}

### My approximate dunnett distribution
###  a mix of the Tukey cdf and Sidakcorrected t
.pdunnx = function(x, k, df, twt = (k  1)/k) {
 tukey = ptukey(sqrt(2)*x, (1 + sqrt(1 + 8*k))/2, df)
 sidak = (pf(x^2, 1, df))^k
 twt*tukey + (1  twt)*sidak
}

# Uses linear interpolation to get quantile
.qdunnx = function(p, k, df, ...) {
 if (k < 1.005)
 return(qt(1  .5*(1  p), df))
 xtuk = qtukey(p, (1 + sqrt(1 + 8*k))/2, df) / sqrt(2)
 xsid = sqrt(qf(p^(1/k), 1, df))
 fcn = function(x, d)
 .pdunnx(x, k, d, ...)  p
 apply(cbind(xtuk, xsid, df), 1, function(r) {
 if (abs(diff(r[1:2])) < .0005)
 return (r[1])
 x = try(uniroot(fcn, r[1:2], tol = .0005, d = r[3]), silent = TRUE)
 if (inherits(x, "tryerror")) {
 warning("Rootfinding failed; using qtukey approximation for Dunnett quantile")
 return(xtuk)
 }
 else
 x$root
 })
}



### Support for different prediction types ###

# Valid values for type arg or predict.type option
# "link", "lp", "linear" are all legal but equivalent
# "mu" and "response" are usually equivalent  but in a GLM with a response transformation,
# "mu" (or "unlink") would backtransform the link only, "response" would do both
.valid.types = c("link","lp","linear", "response", "mu", "unlink")

# get "predict.type" option from misc, and make sure it's legal
.get.predict.type = function(misc) {
 type = misc$predict.type
 if (is.null(type))
 .valid.types[1]
 else
 .validate.type(type)
}

# check a "type" arg to make it legal
# NOTE: if not matched, returns "link", i.e., no backtransformation will be done
.validate.type = function (type) {
 type = .valid.types[pmatch(type, .valid.types, 1)]
 if (length(type) > 1) {
 type = type[1]
 warning("You specified more than one prediction type. Only type = \"", type, "\" was used")
 }
 type
}


# S3 predict method
predict.ref.grid < function(object, type, ...) {
 # update with any "summary" options
 opt = get.lsm.option("summary")
 if(!is.null(opt)) {
 opt$object = object
 object = do.call("update.ref.grid", opt)
 }

 if (missing(type))
 type = .get.predict.type(object@misc)
 else
 type = .validate.type(type)

 # if there are two transformations and we want response, then we need to undo both
 if ((type == "response") && (!is.null(object@misc$tran2)))
 object = regrid(object, transform = "mu")

 pred = .est.se.df(object, do.se=FALSE)
 result = pred[[1]]

 if (type %in% c("response", "mu", "unlink")) {
 link = attr(pred, "link")
 if (!is.null(link)) {
 result = link$linkinv(result)
 if (is.logical(link$unknown) && link$unknown)
 warning("Unknown transformation: \"", link$name, "\"  no transformation applied.")
 }
 }
 result
}

# S3 summary method
summary.ref.grid < function(object, infer, level, adjust, by, type, df,
 null, delta, side, ...) {
 misc = object@misc
 use.elts = if (is.null(misc$display)) rep(TRUE, nrow(object@grid))
 else misc$display
 grid = object@grid[use.elts, , drop = FALSE]

 ### For missing arguments, get from misc, else default
 if(missing(infer))
 infer = misc$infer
 if(missing(level))
 level = misc$level
 if(missing(adjust))
 adjust = misc$adjust
 if(missing(by))
 by = misc$by.vars

 if (missing(type))
 type = .get.predict.type(misc)
 else
 type = .validate.type(type)

 if (!is.na(object@post.beta[1]))
 message("This is a frequentist summary. See `?as.mcmc.ref.grid' for more on what you can do.")

 # if there are two transformations and we want response, then we need to undo both
 if ((type == "response") && (!is.null(misc$tran2)))
 object = regrid(object, transform = "mu")
 if ((type %in% c("mu", "unlink")) && (!is.null(t2 < misc$tran2))) {
 if (!is.character(t2))
 t2 = "tran"
 object = update(object, inv.lbl = paste0(t2, "(resp)"))
 }

 if(missing(df))
 df = misc$df
 if(!is.null(df))
 object@dffun = function(k, dfargs) df

 # for missing args that default to zero unless provided or in misc slot
 .nul.eq.zero = function(val) {
 if(is.null(val)) 0
 else val
 }
 if(missing(null))
 null = .nul.eq.zero(misc$null)
 if(missing(delta))
 delta = .nul.eq.zero(misc$delta)
 if(missing(side))
 side = .nul.eq.zero(misc$side)

 # update with any "summary" options
 opt = get.lsm.option("summary")
 if(!is.null(opt)) {
 opt$object = object
 object = do.call("update.ref.grid", opt)
 }


 # reconcile all the different ways we could specify the alternative
 # ... and map each to one of the first 3 subscripts
 side.opts = c("left","both","right","twosided","noninferiority","nonsuperiority","equivalence","superiority","inferiority","0","2","1","1","+1","<",">","!=","=")
 side.map = c( 1, 2, 3, 2, 3, 1, 2, 3, 1, 2, 2, 1, 3, 3, 1, 3, 2, 2)
 side = side.map[pmatch(side, side.opts, 2)[1]]  2
 delta = abs(delta)

 result = .est.se.df(object)

 lblnms = setdiff(names(grid),
 c(object@roles$responses, ".offset.", ".wgt."))
 lbls = grid[lblnms]

 zFlag = (all(is.na(result$df)))
 inv = (type %in% c("response", "mu", "unlink")) # flag to inversetransform
 link = attr(result, "link")
 if (inv && is.null(link))
 inv = FALSE

 if ((length(infer) == 0)  !is.logical(infer))
 infer = c(FALSE, FALSE)
 if(length(infer == 1))
 infer = c(infer,infer)

 if(inv && !is.null(misc$tran)) {
 if (!is.null(misc$inv.lbl))
 names(result)[1] = misc$inv.lbl
 else
 names(result)[1] = "response"
 }

 attr(result, "link") = NULL
 estName = names(result)[1]

 mesg = misc$initMesg

 ### Add an annotation when we show results on lp scale and
 ### there is a transformation
 if (!inv && !is.null(link)) {
 mesg = c(mesg, paste("Results are given on the", link$name, "(not the response) scale."))
 }
 if (inv && !is.null(link$unknown)) {
 mesg = c(mesg, paste0('Unknown transformation "', link$name, '": no transformation done'))
 inv = FALSE
 link = NULL
 }

 # et = 1 if a prediction, 2 if a contrast (or unmatched or NULL), 3 if pairs
 et = pmatch(c(misc$estType, "c"), c("prediction", "contrast", "pairs"), nomatch = 2)[1]

 by.size = nrow(grid)
 by.rows = .find.by.rows(grid, by)
 if (!is.null(by)) {
 if (length(unique(sapply(by.rows, length))) > 1) {
 by.size = misc$famSize = "(varies)"
 }
 else for (nm in by)
 by.size = by.size / length(unique(object@levels[[nm]]))
 }
 fam.info = c(misc$famSize, by.size, et)
 cnm = NULL

 # get vcov matrix only if needed (adjust == "mvt")
 corrmat = NULL
 if (!is.na(pmatch(adjust, "mvt"))) {
 corrmat = cov2cor(vcov(object))
 attr(corrmat, "by.rows") = by.rows
 }

 if(infer[1]) { # add CIs
 acv = .adj.critval(level, result$df, adjust, fam.info, side, corrmat, by.rows)
 ###adjust = acv$adjust # in older versions, I forced same adj method for tests
 cv = acv$cv
 cv = switch(side + 2, cbind(Inf, cv), cbind(cv, cv), cbind(cv, Inf))
 cnm = if (zFlag) c("asymp.LCL", "asymp.UCL") else c("lower.CL","upper.CL")
 result[[cnm[1]]] = result[[1]] + cv[, 1]*result$SE
 result[[cnm[2]]] = result[[1]] + cv[, 2]*result$SE
 mesg = c(mesg, paste("Confidence level used:", level), acv$mesg)
 if (inv) {
 clims = with(link, cbind(linkinv(result[[cnm[1]]]), linkinv(result[[cnm[2]]])))
 tmp = apply(clims, 1, function(x) {
 z = diff(x); ifelse(is.na(z), 0, z) })
 idx = if (all(tmp >= 0)) 1:2 else 2:1
 result[[cnm[1]]] = clims[, idx[1]]
 result[[cnm[2]]] = clims[, idx[2]]
 mesg = c(mesg, paste("Intervals are backtransformed from the", link$name, "scale"))
 }
 }
 if(infer[2]) { # add tests
 if (!all(null == 0)) {
 result[["null"]] = null
 if (!is.null(link))
 result[["null"]] = link$linkinv(result[["null"]])
 }
 tnm = ifelse (zFlag, "z.ratio", "t.ratio")
 tail = ifelse(side == 0, sign(abs(delta)), side)
 if (side == 0) {
 if (delta == 0) # twosided sig test
 t.ratio = result[[tnm]] = (result[[1]]  null) / result$SE
 else
 t.ratio = result[[tnm]] = (abs(result[[1]]  null)  delta) / result$SE
 }
 else {
 t.ratio = result[[tnm]] = (result[[1]]  null + side * delta) / result$SE
 }
 apv = .adj.p.value(t.ratio, result$df, adjust, fam.info, tail, corrmat, by.rows)
 adjust = apv$adjust # in case it was abbreviated
 result$p.value = apv$pval
 mesg = c(mesg, apv$mesg)
 if (delta > 0)
 mesg = c(mesg, paste("Statistics are tests of", c("nonsuperiority","equivalence","noninferiority")[side+2],
 "with a threshold of", delta))
 if(tail != 0)
 mesg = c(mesg, paste("P values are ", ifelse(tail<0,"left","right"),"tailed", sep=""))
 if (inv)
 mesg = c(mesg, paste("Tests are performed on the", link$name, "scale"))
 }
 if (inv) {
 result[["SE"]] = with(link, abs(mu.eta(result[[1]]) * result[["SE"]]))
 result[[1]] = with(link, linkinv(result[[1]]))
 }

 if (length(misc$avgd.over) > 0) {
 qual = attr(misc$avgd.over, "qualifier")
 if (is.null(qual)) qual = ""
 mesg = c(paste0("Results are averaged over", qual, " the levels of: ",
 paste(misc$avgd.over, collapse = ", ")), mesg)
 }
 summ = cbind(lbls, result)
 attr(summ, "estName") = estName
 attr(summ, "clNames") = cnm # will be NULL if infer[1] is FALSE
 attr(summ, "pri.vars") = setdiff(union(misc$pri.vars, misc$by.vars), by)
 attr(summ, "by.vars") = by
 attr(summ, "mesg") = unique(mesg)
 class(summ) = c("summary.ref.grid", "data.frame")
 summ
}


# leftor rightjustify column labels for m depending on "l" or "R" in just
.just.labs = function(m, just) {
 nm = dimnames(m)[[2]]
 for (j in seq_len(length(nm))) {
 if(just[nm[j]] == "L")
 nm[j] = format(nm[j], width = nchar(m[1,j]), just="left")
 }
 dimnames(m) = list(rep("", nrow(m)), nm)
 m
}

# Format a data.frame produced by summary.ref.grid
print.summary.ref.grid = function(x, ..., digits=NULL, quote=FALSE, right=TRUE) {
 x.save = x
 if (!is.null(x$df)) x$df = round(x$df, 2)
 if (!is.null(x$t.ratio)) x$t.ratio = round(x$t.ratio, 3)
 if (!is.null(x$z.ratio)) x$z.ratio = round(x$z.ratio, 3)
 if (!is.null(x$p.value)) {
 fp = x$p.value = format(round(x$p.value,4), nsmall=4, sci=FALSE)
 x$p.value[fp=="0.0000"] = "<.0001"
 }
 estn = attr(x, "estName")
 just = sapply(x.save, function(col) if(is.numeric(col)) "R" else "L")
 est = x[[estn]]
 if (any(is.na(est))) {
 x[[estn]] = format(est, digits=digits)
 x[[estn]][is.na(est)] = "nonEst"
 }
 xc = as.matrix(format.data.frame(x, digits=digits, na.encode=FALSE))
 m = apply(rbind(just, names(x), xc), 2, function(x) {
 w = max(sapply(x, nchar))
 if (x[1] == "R") format(x[seq_len(2)], width = w, justify="right")
 else format(x[seq_len(2)], width = w, justify="left")
 })
 if(!is.matrix(m)) m = t(as.matrix(m))
 by.vars = attr(x, "by.vars")
 if (is.null(by.vars)) {
 m = .just.labs(m, just)
 print(m, quote=FALSE, right=TRUE)
 cat("\n")
 }
 else { # separate listing for each by variable
 m = .just.labs(m[, setdiff(names(x), by.vars), drop = FALSE], just)
 pargs = as.list(x[,by.vars, drop=FALSE])
 pargs$sep = ", "
 lbls = do.call(paste, pargs)
 for (lb in unique(lbls)) {
 rows = which(lbls==lb)
 levs = paste(by.vars, "=", xc[rows[1], by.vars])
 cat(paste(paste(levs, collapse=", ")), ":\n", sep="")
 print(m[rows, , drop=FALSE], ..., quote=quote, right=right)
 cat("\n")
 }
 }

 msg = unique(attr(x, "mesg"))
 if (!is.null(msg))
 for (j in seq_len(length(msg))) cat(paste(msg[j], "\n"))

 invisible(x.save)
}

diff pruN 2.27623/R/transformations.R 2.3001/R/transformations.R
 2.27623/R/transformations.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/transformations.R 19700101 00:00:00.000000000 +0000
@@ 1,182 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

# Code to implement transformations my way

### My modification/expansion of stats:make.link()
### Also, if not found, returns make.link("identity") modified with
## unknown = TRUE, name = link
## In addition, I make all links truly monotone on (Inf, Inf) in
## lieu of valideta
##
## Extensions to make.link results:
## unknown: set to TRUE if link is unknown
## mult: scalar multiple of transformation
##
.make.link = function(link) {
 if (link %in% c("logit", "probit", "cauchit", "cloglog", "identity", "log"))
 result = stats::make.link(link)
 else result = switch(link,
 sqrt = {
 tmp = make.link("sqrt")
 tmp$linkinv = function(eta) pmax(0, eta)^2
 tmp$mu.eta = function(eta) 2*pmax(0, eta)
 tmp },
 `1/mu^2` = {
 tmp = make.link("1/mu^2")
 tmp$linkinv = function(eta) 1/sqrt(pmax(0, eta))
 tmp$mu.eta = function(eta) 1/(2*pmax(0, eta)^1.5)
 tmp },
 inverse = {
 tmp = make.link("inverse")
 tmp$linkinv = function(eta) 1/pmax(0, eta)
 tmp$mu.eta = function(eta) 1/pmax(0, eta)^2
 tmp },
 `/` = .make.link("inverse"),
 reciprocal = .make.link("inverse"),
 log10 = list(
 linkinv = function(eta) 10^eta,
 mu.eta = function(eta) 10^eta * log(10),
 name = "log10"
 ),
 log2 = list(
 linkinv = function(eta) 2^eta,
 mu.eta = function(eta) 2^eta * log(2),
 name = "log2"
 ),
 asin.sqrt = make.tran("asin.sqrt"),
 `asin.sqrt./` = make.tran("asin.sqrt", 100),
 asinh.sqrt = list(
 linkinv = function(eta) sinh(eta)^2,
 mu.eta = function(eta) sinh(2 * eta),
 name = "asinh(sqrt(mu))"
 ),
 exp = list(
 linkinv = function(eta) log(eta),
 mu.eta = function(eta) 1/eta,
 name = "exp"
 ),
 `+.sqrt` = {
 tmp = .make.link("sqrt")
 tmp$mult = 2
 tmp
 },
 log.o.r. = {
 tmp = make.link("log")
 tmp$name = "log odds ratio"
 tmp
 },

 { # default if not included, flags it as unknown
 tmp = stats::make.link("identity")
 tmp$unknown = TRUE
 tmp$name = link
 tmp
 }
 )
 result
}

# Implementation of additional transformations, typically ones with parameters
# Returns a list like stats::make.link, but often with an additional "param" member
# types:
# glog: log(mu + param)
make.tran = function(type = c("genlog", "power", "boxcox", "sympower", "asin.sqrt"), param = 1) {
 type = match.arg(type)
 origin = 0
 mu.lbl = "mu"
 if (length(param) > 1) {
 origin = param[2]
 param = param[1]
 mu.lbl = paste0("(mu  ", round(origin, 3), ")")
 }
 switch(type,
 genlog = {
 if((origin < 0)  (origin == 1))
 stop('"genlog" transformation must have a positive base != 1')
 logbase = ifelse(origin == 0, 1, log(origin))
 xlab = ifelse(origin == 0, "", paste0(" (base ", round(origin, 3), ")"))
 list(linkfun = function(mu) log(pmax(mu + param, 0)) / logbase,
 linkinv = function(eta) pmax(exp(logbase * eta), .Machine$double.eps)  param,
 mu.eta = function(eta) logbase * pmax(exp(logbase * eta), .Machine$double.eps),
 valideta = function(eta) TRUE,
 param = c(param, origin),
 name = paste0("log(mu + ", round(param,3), ")", xlab)
 )
 },
 power = {
 if (param == 0) {
 if(origin == 0) make.link("log")
 else make.tran("genlog", origin)
 }
 else list(
 linkfun = function(mu) pmax(mu  origin, 0)^param,
 linkinv = function(eta) origin + pmax(eta, 0)^(1/param),
 mu.eta = function(eta) pmax(eta, 0)^(1/param  1) / param,
 valideta = function(eta) all(eta > 0),
 param = c(param, origin),
 name = ifelse(param > 0,
 paste0(mu.lbl, "^", round(param,3)),
 paste0(mu.lbl, "^(", round(param,3), ")"))
 )
 },
 boxcox = {
 if (param == 0) {
 result = if(origin == 0) make.link("log")
 else make.tran("genlog", origin)
 return (result)
 }
 min.eta = ifelse(param > 0, 1 / param, Inf)
 xlab = ifelse(origin == 0, "", paste0(" with origin at ", round(origin, 3)))
 list(
 linkfun = function(mu) ((mu  origin)^param  1) / param,
 linkinv = function(eta) origin + (1 + param * pmax(eta, min.eta))^(1/param),
 mu.eta = function(eta) (1 + param * pmax(eta, min.eta))^(1/param  1),
 valideta = function(eta) all(eta > min.eta),
 param = c(param, origin),
 name = paste0("BoxCox (lambda = ", round(param, 3), ")", xlab)
 )
 },
 sympower = {
 if (param <= 0)
 stop('"sympower" transformation requires positive param')
 if (origin == 0)
 mu.lbl = paste0("(", mu.lbl, ")")
 absmu.lbl = gsub("\\(\\)", "", mu.lbl)
 list(linkfun = function(mu) sign(mu  origin) * abs(mu  origin)^param,
 linkinv = function(eta) origin + sign(eta) * abs(eta)^(1/param),
 mu.eta = function(eta) (abs(eta))^(1/param  1),
 valideta = function(eta) all(eta > min.eta),
 param = c(param, origin),
 name = paste0(absmu.lbl, "^", round(param,3), " * sign", mu.lbl)
 )
 },
 asin.sqrt = {
 mu.lbl = ifelse(param == 1, "mu", paste0("mu/", round(param,3)))
 list(linkfun = function(mu) asin(sqrt(mu/param)),
 linkinv = function(eta) param * sin(pmax(pmin(eta, pi/2), 0))^2,
 mu.eta = function(eta) param * sin(2*pmax(pmin(eta, pi/2), 0)),
 valideta = function(eta) all(eta <= pi/2) && all(eta >= 0),
 name = paste0("asin(sqrt(", mu.lbl, "))")
 )
 }
 )
}
diff pruN 2.27623/R/xtablemethod.R 2.3001/R/xtablemethod.R
 2.27623/R/xtablemethod.R 20170930 17:46:30.000000000 +0000
+++ 2.3001/R/xtablemethod.R 19700101 00:00:00.000000000 +0000
@@ 1,91 +0,0 @@
##############################################################################
# Copyright (c) 20122016 Russell V. Lenth #
# #
# This file is part of the lsmeans package for R (*lsmeans*) #
# #
# *lsmeans* is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 2 of the License, or #
# (at your option) any later version. #
# #
# *lsmeans* is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with R and *lsmeans*. If not, see #
# and/or #
# . #
##############################################################################

### xtable method
# Modified from xtableLSMeans function provided by David Scott

xtable.ref.grid = function(x, caption = NULL, label = NULL, align = NULL, digits = 4,
 display = NULL, auto = FALSE, ...)
{
 xtable.summary.ref.grid(summary(x, ...), caption = caption, label = label, align = align, digits = digits,
 display = display, auto = auto)
}

xtable.summary.ref.grid = function (x, caption = NULL, label = NULL,
 align = NULL, digits = 4,
 display = NULL, auto = FALSE, ...)
{
 if (!is.null(x$df)) x$df = round(x$df, 2)
 if (!is.null(x$t.ratio)) x$t.ratio = round(x$t.ratio, 3)
 if (!is.null(x$z.ratio)) x$z.ratio = round(x$z.ratio, 3)
 if (!is.null(x$p.value)) {
 fp = x$p.value = format(round(x$p.value,4), nsmall=4, sci=FALSE)
 x$p.value[fp=="0.0000"] = "<.0001"
 }
 if (!is.null(byv < attr(x, "by.vars"))) {
 byc = which(names(x) %in% byv)
 xList = split(as.data.frame(x), f = x[, byc])
 labs = rep("", length(xList))
 for (i in 1:length(xList)) {
 levs = sapply(xList[[i]][1, byc], as.character)
 labs[i] = paste(paste(byv, levs, sep = " = "), collapse = ", ")
 xList[[i]] = as.data.frame(xList[[i]][, byc, drop = FALSE])
 }
 attr(xList, "subheadings") = labs
 }
 else {
 xList = list(as.data.frame(x))
 }
 attr(xList, "message") = attr(x, "mesg")
 result = xtable::xtableList(xList, caption = caption, label = label,
 align = align, digits = digits, display = display,
 auto = auto, ...)
 digits = xtable::digits(result[[1]])

 # format df and t ratios
 digits = xtable::digits(result[[1]])
 i = which(names(x) == "df")
 if (length(i) > 0) {
 dfd = ifelse(all(zapsmall(x$df  round(x$df)) == 0), 0, 2)
 digits[i + 1  length(byv)] = ifelse(is.na(dfd), 0, dfd)
 }
 i = which(names(x) %in% c("t.ratio", "z.ratio"))
 if (length(i) > 0) digits[i + 1  length(byv)] = 3
 for (i in seq_along(result))
 xtable::digits(result[[i]]) = digits

 class(result) = c("xtable.lsm", "xtableList")
 result
}

# My own print method
print.xtable.lsm = function(x, type = getOption("xtable.type", "latex"),
 include.rownames = FALSE,
 sanitize.message.function = footnotesize,
 ...)
{
 footnotesize = switch(type,
 html = function(x) paste0("", x, ""),
 latex = function(x) paste0("{\\footnotesize ", x, "}"),
 function(x) x )
 invisible(xtable::print.xtableList(x, include.rownames = include.rownames,
 sanitize.message.function = sanitize.message.function, ...))
}
diff pruN 2.27623/R/zzz.R 2.3001/R/zzz.R
 2.27623/R/zzz.R 20171101 17:37:16.000000000 +0000
+++ 2.3001/R/zzz.R 20181101 00:38:44.000000000 +0000
@@ 20,15 +20,12 @@
##############################################################################
hasName = function(x, name)
 match(name, names(x), nomatch = 0L) > 0L

.onAttach = function(libname, pkgname) {
packageStartupMessage (
 "The 'lsmeans' package is being deprecated.\n",
 "Users are encouraged to switch to 'emmeans'.\n",
 "See help('transition') for more information, including how\n",
 "to convert 'lsmeans' objects and scripts to work with 'emmeans'."
+ "The 'lsmeans' package is now basically a front end for 'emmeans'.\n",
+ "Users are encouraged to switch the rest of the way.\n",
+ "See help('transition') for more information, including how to\n",
+ "convert old 'lsmeans' objects and scripts to work with 'emmeans'."
)
}
diff pruN 2.27623/tests/lsmbasistest.out 2.3001/tests/lsmbasistest.out
 2.27623/tests/lsmbasistest.out 19700101 00:00:00.000000000 +0000
+++ 2.3001/tests/lsmbasistest.out 20181101 16:40:40.000000000 +0000
@@ 0,0 +1,74 @@
+
+R version 3.5.1 (20180702)  "Feather Spray"
+Copyright (C) 2018 The R Foundation for Statistical Computing
+Platform: x86_64w64mingw32/x64 (64bit)
+
+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 online help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> # tests for recover.data and lsm.basis
+>
+> require("lsmeans")
+Loading required package: lsmeans
+Loading required package: emmeans
+The 'lsmeans' package is now basically a front end for 'emmeans'.
+Users are encouraged to switch the rest of the way.
+See help('transition') for more information, including how to
+convert old 'lsmeans' objects and scripts to work with 'emmeans'.
+>
+> fiber.lm < lm(strength ~ machine + diameter, data = fiber)
+>
+> rd < recover.data(fiber.lm)
+>
+> lsm.basis(fiber.lm, trms = attr(rd, "terms"),
++ xlev = levels(rd$machine), grid = head(rd))
+$X
+ (Intercept) machineB machineC diameter
+1 1 0 0 20
+2 1 0 0 25
+3 1 0 0 24
+4 1 0 0 25
+5 1 0 0 32
+6 1 1 0 22
+
+$bhat
+[1] 17.3595092 1.0368098 1.5840491 0.9539877
+
+$nbasis
+ [,1]
+[1,] NA
+
+$V
+ (Intercept) machineB machineC diameter
+(Intercept) 8.7688080 0.24661297 1.81994128 0.32777673
+machineB 0.2466130 1.02599320 0.46721191 0.01040561
+machineC 1.8199413 0.46721191 1.22578092 0.05202805
+diameter 0.3277767 0.01040561 0.05202805 0.01300701
+
+$dffun
+function (k, dfargs)
+dfargs$df
+
+
+
+$dfargs
+$dfargs$df
+[1] 11
+
+
+$misc
+list()
+
+>
+> proc.time()
+ user system elapsed
+ 0.93 0.34 1.26
diff pruN 2.27623/tests/lsmbasistest.R 2.3001/tests/lsmbasistest.R
 2.27623/tests/lsmbasistest.R 19700101 00:00:00.000000000 +0000
+++ 2.3001/tests/lsmbasistest.R 20181101 16:36:19.000000000 +0000
@@ 0,0 +1,10 @@
+# tests for recover.data and lsm.basis
+
+require("lsmeans")
+
+fiber.lm < lm(strength ~ machine + diameter, data = fiber)
+
+rd < recover.data(fiber.lm)
+
+lsm.basis(fiber.lm, trms = attr(rd, "terms"),
+ xlev = levels(rd$machine), grid = head(rd))
diff pruN 2.27623/vignettes/lsmeans.bib 2.3001/vignettes/lsmeans.bib
 2.27623/vignettes/lsmeans.bib 20170331 20:37:29.000000000 +0000
+++ 2.3001/vignettes/lsmeans.bib 19700101 00:00:00.000000000 +0000
@@ 1,208 +0,0 @@
;;; .bib file for lsmeans

@book{Box05,
 author = "Box, G. and Hunter, J. and Hunter, W.",
 year = 2005,
 title = "Statistics for Experimenters", edition = "2nd",
 publisher = "Wiley"
}

@article{Bra08,
 author = "Brader, T. and Valentino, N. and Suhay, E.",
 year = 2008,
 title = "What triggers public opposition to immigration? Anxiety, group cues, and immigration threat",
 journal = "American Journal of Political Science",
 volume = 52, number = 4, pages = "959978"
}

@inproceedings{Har76,
 author = "Harvey, W.", year = 1976,
 title = "Use of the {HARVEY} Procedure",
 booktitle = "{SUGI} Proceedings",
 url = "http://www.sascommunity.org/sugi/SUGI76/Sugi7620%20Harvey.pdf"
}

@techreport{Har60,
 author = "W. Harvey", year = 1960,
 title = "Leastsquares analysis of data with unequal subclass numbers",
 institution = "{USDA} National Agricultural Library",
 number = "ARS208"
}

@manual{Har77,
 author = "Harvey, W. R.", year = 1977,
 title = "User's guide for {LSML}~76. Mixed model leastsquares and maximum likelihood computer program",
 organization = "Ohio State University"
}

@techreport{Goo97,
 author = "J. H. Goodnight and W. R. Harvey", year = 1997,
 title = "Least squares means in the fixed effects general model",
 number = "{SAS} Technical Report R103",
 institution = "{SAS} Institute Inc."
}

@article{Sea80,
 author = "S. R. Searle and F. M. Speed and G. A. Milliken",
 year = "1980",
 title = "Population marginal means in the linear model: An alternative to least squares means",
 journal = "The American Statistician",
 volume = 34, number = 4, pages = "216221"
}


@article{Les04,
 author = "Lesnoff, M. and Laval, G. and Bonnet, P. and Abdicho, S. and Workalemahu, A. and Kifle, D. and Peyraud, A. and Lancelot, R. and Thiaucourt, F.",
 year = 2004,
 title = "WithinHerd Spread of Contagious Bovine Pleuropneumonia in {Ethiopian} Highlands",
 journal = "Preventive Veterinary Medicine",
 volume = 64, pages = "2740"
}

@book{Mil92,
 author = "Milliken, G. A. and Johnson, D. E.", year = 1992,
 title = "Analysis of Messy Data  Volume I: Designed Experiments",
 publisher = "Chapman \&{} Hall/CRC", isbn = "0412990814"
}


@book{Oeh00,
 author = "Oehlert, G.", year = 2000,
 title = "A First Course in Design and Analysis of Experiments",
 publisher = "{W.~H.~Freeman}"
}
;;This is outofprint, but now available under a Creative Commons license via \url{http://users.stat.umn.edu/~gary/Book.html} (accessed August 23, 2012).

@inproceedings{SAS12,
 author= "{SAS Institute Inc.}", year = 2012,
 title = "\code{LSMEANS} Statement",
 booktitle = "{\proglang{SAS/STAT}(R)} 9.3 User's Guide",
 url = "http://support.sas.com/documentation/cdl/en/statug/63962/HTML/default/viewer.htm#statug_introcom_a0000003362.htm"
}

@article{Sch87,
 author = "Schuirmann, Donald",
 year = 1987,
 title = "A Comparison of the Two OneSided Tests Procedure and the Power Approach for Assessing the Equivalence of Average Bioavailability",
 journal = "Journal of Pharmacokinetics and Biopharmaceutics",
 volume = 15, number = 6, pages = "657680"
}


;;\item[Tukey, J.~W.~(1977)] \emph{Exploratory Data Analysis}. AddisonWesley.


@article{urq82,
 author = "N. Scott Urquhart", year = 1982,
 title = "Adjustment in covariates when one factor affects the covariate",
 journal = "Biometrics", volume = 38, pages = "651660"
}

@article{Yat35,
 author = "Yates, F", year = 1935,
 title = "Complex Experiments",
 journal = "{Journal of the Royal Statistical Society} (Supplement)",
 volume = 2, pages = "181247"
}

;;; R packages...

@article{effects,
 author = "John Fox", year = 2003,
 title = "Effect Displays in \proglang{R} for Generalised Linear Models",
 journal = "{Journal of Statistical Software}",
 volume = 8, number = 15, pages = "127",
 url = "http://www.jstatsoft.org/v08/i15/"
}

@article{fox09,
 author = "John Fox and Jangman Hong", year = 2009,
 title = "Effect Displays in \proglang{R} for Multinomial and ProportionalOdds Logit Models: Extensions to the \pkg{effects} Package",
 journal = "{Journal of Statistical Software}",
 volume = 32, number = 1, pages = "124",
 url = "http://www.jstatsoft.org/v32/i01/"
}

 @Manual{doBy,
 title = {\pkg{doBy}: Groupwise summary statistics, LSmeans, general linear
contrasts, various utilities},
 author = {S{\o}ren H{\o}jsgaard and Ulrich Halekoh and Jim RobisonCox and Kevin Wright and Alessandro A. Leidi},
 year = {2013},
 note = {\R{} package version 4.510},
 url = {http://CRAN.Rproject.org/package=doBy},
 }

 @Manual{lsmea,
 title = {\pkg{lsmeans}: LeastSquares Means},
 author = {Russell V. Lenth},
 year = {2014},
 note = {\R{} package version 2.10}
 }

 @Manual{lme4,
 title = {\pkg{lme4}: Linear Mixedeffects Models Using \pkg{Eigen} and \proglang{S4}},
 author = {Douglas Bates and Martin Maechler and Ben Bolker and Steven Walker},
 year = {2013},
 note = {\R{} package version 1.10},
 url = {http://lme4.rforge.rproject.org/},
 }



 @Manual{pbkrt,
 title = {\pkg{pbkrtest}: Parametric Bootstrap and Kenward Roger Based Methods for Mixed
Model Comparison},
 author = {Ulrich Halekoh and S{\o}ren H{\o}jsgaard},
 year = {2013},
 note = {\R{} package version 0.38},
 url = {http://CRAN.Rproject.org/package=pbkrtest},
 }

 @Manual{multc,
 title = {\pkg{multcomp}: Simultaneous Inference in General Parametric Models},
 author = {Torsten Hothorn and Frank Bretz and Peter Westfall},
 year = {2013},
 note = {\R{} package version 1.31},
 url = {http://CRAN.Rproject.org/package=multcomp},
 }

 @Manual{mcview,
 title = {\pkg{multcompView}: Visualizations of Paired Comparisons},
 author = {Spencer Graves and HansPeter Piepho and Luciano Selzer and Sundar DoraiRaj},
 year = {2012},
 note = {\R{} package version 0.15},
 url = {http://CRAN.Rproject.org/package=multcompView},
 }

 @Manual{latti,
 title = {\pkg{lattice}: Lattice Graphics},
 author = {Deepayan Sarkar},
 year = {2013},
 note = {\R{} package version 0.2024},
 url = {http://CRAN.Rproject.org/package=lattice},
 }

@Manual{lmert,
title = {lmerTest: Tests in Linear Mixed Effects Models},
author = {Alexandra Kuznetsova and Per {Bruun Brockhoff} and Rune {Haubo Bojesen Christensen}},
year = {2016},
note = {R package version 2.032},
url = {https://CRAN.Rproject.org/package=lmerTest},
}

 @Manual{nlme,
 title = {\pkg{nlme}: Linear and Nonlinear Mixed Effects Models},
 author = {Jos? Pinheiro and Douglas Bates and {Rcore}},
 year = {2013},
 note = {\R{} package version 3.1113},
 url = {http://CRAN.Rproject.org/package=nlme},
 }

 @Manual{xtable,
 title = {\pkg{xtable}: Export Tables to LaTeX or HTML},
 author = {David B. Dahl},
 year = {2016},
 note = {R package version 1.82/r110},
 url = {https://RForge.Rproject.org/projects/xtable/},
 }

diff pruN 2.27623/vignettes/usinglsmeans.rnw 2.3001/vignettes/usinglsmeans.rnw
 2.27623/vignettes/usinglsmeans.rnw 20170910 19:24:54.000000000 +0000
+++ 2.3001/vignettes/usinglsmeans.rnw 19700101 00:00:00.000000000 +0000
@@ 1,1067 +0,0 @@
% Copyright (c) 20122016 Russell V. Lenth %
% %

\documentclass[11pt]{article}
\usepackage[margin=1in]{geometry}
\usepackage{mathpazo}
\usepackage{hyperref}
\usepackage{fancyvrb}
\usepackage{multicol}
\usepackage{natbib}
\usepackage{Sweave}

\usepackage{makeidx}
\makeindex

\hypersetup{colorlinks=true,allcolors=black,urlcolor=blue}


\let\dq="
\DefineShortVerb{\"}

\def\pkg{\textbf}
\def\proglang{\textsf}

\def\lsm{\pkg{lsmeans}}

% doublequoted text
\def\dqt#1{\code{\dq{}#1\dq{}}}

% The objects I want to talk about
\def\rg{\dqt{ref.grid}}
\def\lsmo{\dqt{lsmobj}}

% for use in place of \item in a description env where packages are listed
\def\pitem#1{\item[\pkg{#1}]}


\def\R{\proglang{R}}
\def\SAS{\proglang{SAS}}
\def\code{\texttt}


\def\Fig#1{Figure~\ref{#1}}
\def\bottomfraction{.5}


% For indexing...
% Naming: \[w]ix[fmt]{#1}  always use lowercase for alphabetization.
% fmt defines format, use w prefix for intext refs (word is included)
\def\ix#1{\index{#1@\MakeUppercase#1}}
\def\wix#1{#1\ix{#1}}
\def\ixcode#1{\index{#1@\texttt{#1}}}
\def\wixcode#1{\texttt{#1}\ixcode{#1}}
\def\ixpkg#1{\index{#1@\textbf{#1} package}}
\def\wixpkg#1{\textbf{#1}\ixpkg{#1}}
% Add subheadings...
\def\ixsub#1#2{\index{#1@\MakeUppercase#1!#2}}
\def\wixsub#1#2{#1\ixsub{#1}{#2}}
\def\ixcodesub#1#2{\index{#1@\texttt{#1}!#2}}
\def\wixcodesub#1#2{\texttt{#1}\ixcodesub{#1}{#2}}

%\VignetteIndexEntry{Using lsmeans}
%\VignetteDepends{lsmeans}
%\VignetteKeywords{leastsquares means}
%\VignettePackage{lsmeans}


% Initialization
<>=
options(show.signif.stars=FALSE, prompt="R> ", continue=" ",
 useFancyQuotes=FALSE, width=100, digits=6)
@

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% almost as usual
\author{Russell V.~Lenth\\The University of Iowa}
\title{Using \lsm{}} %% without formatting

\ifx %xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
%% for pretty printing and a nice hypersummary also set:
\Plainauthor{Russell V.~Lenth} %% commaseparated
\Plaintitle{Leastsquares Means: The R Package lsmeans} %% without formatting
\Shorttitle{The R Package lsmeans} %% a short title (if necessary)
\fi %xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


\ifx % IGNORE xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
%% The address of (at least) one author should be given
%% in the following format:
\Address{
 Russell V.~Lenth, Professor Emeritus\\
 Department of Statistics and Actuarial Science\\
% 241 Schaeffer Hall\\
 The University of Iowa\\
 Iowa City, IA 52242 ~ USA\\
 Email: \email{russelllenth@uiowa.edu} %\\
% URL: \url{http://www.stat.uiowa.edu/~rlenth/}
}
%% It is also possible to add a telephone and fax number
%% before the email in the following format:
%% Telephone: +43/1/313365053
%% Fax: +43/1/31336734
\fi %xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

%% for those who use Sweave please include the following line (with % symbols):
%% need no \usepackage{Sweave.sty}

%% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


\begin{document}
\SweaveOpts{concordance=TRUE}
\maketitle{}

\begin{abstract}
 Leastsquares means are predictions from a linear model, or averages thereof. They are useful in the
 analysis of experimental data for summarizing the effects of factors, and for testing linear contrasts among predictions. The \lsm{} package provides a simple way of obtaining leastsquares means and contrasts thereof. It supports many models fitted by \R{} core packages (as well as a few key contributed ones) that fit linear or mixed models, and provides a simple way of extending it to cover more model classes.
\end{abstract}




\section{Introduction}
\wix{leastsquares means} (\wix{LS~means} for short) for a linear model are simply predictionsor averages thereofover a regular grid of predictor settings which I call the \emph{\wix{reference grid}}. They date back at least to \cite{Har60} and his associated computer program \proglang{LSML} \citep{Har77} and the contributed \SAS{} procedure named \pkg{HARVEY}\index{SAS!PROC HARVEY} \citep{Har76}. Later, they were incorporated via \code{LSMEANS}\index{SAS!LSMEANS} statements for various linear model procedures such as \pkg{GLM} in the regular \SAS{} releases. See also \cite{Goo97} and \cite{SAS12} for more information about the \SAS{} implementation.

In simple \wix{analysisofcovariance models}, LS~means are the same as covariate\wix{adjusted means}. In unbalanced factorial experiments, LS~means for each factor mimic the maineffects means but are adjusted for imbalance. The latter interpretation is quite similar to the ``\wix{unweighted means}'' method for unbalanced data, as presented in old design books.

LS~means are not always well understood, in part because the term itself is confusing. \cite{Sea80} discusses exactly how they are defined for various factorial, nested, and covariance models. \citeauthor{Sea80} suggest the term ``\wix{predicted marginal means}'' (or \wix{PMMs}) as a better descriptor. However, the term ``leastsquares means'' was already well established in the \SAS{} software, and it has stuck.

The most important things to remember are:\ixsub{leastsquares means}{defined}
\begin{itemize}
\item LS~means are computed relative to a \emph{reference grid}.
\item Once the reference grid is established, LS~means are simply predictions on this grid, or marginal averages of a table of these predictions.
\end{itemize}
A user who understands these points will know what is being computed, and thus can judge whether or not LS~means are appropriate for the analysis.




\section{The reference grid}
Since the reference grid\ixsub{reference grid}{defined} is fundamental, it is our starting point. For each predictor in the model, we define a set of one or more \emph{reference levels}. The reference grid is then the set of all combinations of reference levels. If not specified explicitly, the default reference levels are obtained as follows:
\begin{itemize}
\item For each predictor that is a factor, its reference levels are the unique levels of that factor.
\item Each numeric predictor has just one reference levelits mean over the dataset.
\end{itemize}
So the reference grid depends on both the model and the dataset.

\subsection{Example: Orange sales}\index{Examples!orange sales}
To illustrate, consider the \wixcode{oranges} data provided with \lsm{}. This dataset has sales of two varieties of oranges (response variables "sales1" and "sales2") at 6 stores (factor "store"), over a period of 6 days (factor "day"). The prices of the oranges (covariates "price1" and "price2") fluctuate in the different stores and the different days. There is just one observation on each store on each day.

For starters, let's consider an additive covariance model for sales of the first variety, with the two factors and both "price1" and "price2" as covariates (since the price of the other variety could also affect sales).
<<>>=
library("lsmeans")
oranges.lm1 < lm(sales1 ~ price1 + price2 + day + store, data = oranges)
anova(oranges.lm1)
@
The \wixcode{ref.grid} function in \lsm{} may be used to establish the reference grid. Here is the default one:
<<>>=
( oranges.rg1 < ref.grid(oranges.lm1) )
@
As outlined above, the two covariates "price1" and "price2" have their means as their sole reference level; and the two factors have their levels as reference levels. The reference grid thus consists of the $1\times1\times6\times6=36$ combinations of these reference levels. LS~means are based on predictions on this reference grid, which we can obtain using "predict" or "summary":
<<>>=
summary(oranges.rg1)
@

\subsection{LS means as \wix{marginal averages} over the reference grid}
The ANOVA indicates there is a significant "day" effect after adjusting for the covariates, so we might want to do a followup analysis that involves comparing the days. The \wixcode{lsmeans} function provides a starting point:
<<>>=
lsmeans(oranges.rg1, "day") ## or lsmeans(oranges.lm1, "day")
@
These results, as indicated in the annotation in the output, are in fact the averages of the predictions shown earlier, for each day, over the 6 stores. The above LS~means (often called ``\wix{adjusted means}'') are not the same as the overall means for each day:
<<>>=
with(oranges, tapply(sales1, day, mean))
@
These \wix{unadjusted means} are not comparable with one another because they are affected by the differing "price1" and "price2" values on each day, whereas the LS~means are comparable because they use predictions at uniform "price1" and "price2" values.

Note that one may call "lsmeans" with either the reference grid or the model. If the model is given, then the first thing it does is create the reference grid; so if the reference grid is already available, as in this example, it's more efficient to make use of it.

For users who dislike the term ``LS~means,'' there is also a \wixcode{pmmeans} function (for \wix{predicted marginal means}) which is an alias for "lsmeans" but relabels the "lsmean" column in the summary.

\subsection{Altering the reference grid}\ixsub{reference grid}{altering}
The wixcode{at} argument may be used to override defaults in the reference grid.
The user may specify this argument either in a "ref.grid" call or an "lsmeans" call; and should specify a "list" with named sets of reference levels. Here is a silly example:
<<>>=
lsmeans(oranges.lm1, "day", at = list(price1 = 50,
 price2 = c(40,60), day = c("2","3","4")) )
@
Here, we restricted the results to three of the days, and used different prices.
One possible surprise is that the predictions are averaged over the two "price2"
values. That is because "price2" is no longer a single reference level, and we average over the levels of all factors not used to splitout the LS~means.
This is probably not what we want.\footnote{%
The \emph{default} reference grid produces LS~means exactly as described in \cite{Sea80}.
However, an altered reference grid containing more than one value of a covariate, such as in this example, departs from (or generalizes, if you please) their definition by averaging with equal weights over those \wix{covariate levels}. It is not a good idea here, but there is an example later in this vignette where it makes sense.}
To get separate sets of predictions for each "price2", one must specify it as another factor or as a \wixcode{by} factor in the "lsmeans" call (we will save the result for later discussion):
<<>>=
org.lsm < lsmeans(oranges.lm1, "day", by = "price2",
 at = list(price1 = 50, price2 = c(40,60), day = c("2","3","4")) )
org.lsm
@
Note: We could have obtained the same results using any of these:
<>=
lsmeans(oranges.lm1, ~ day  price, at = ... ) # Ex 1
lsmeans(oranges.lm1, c("day","price2"), at = ... ) # Ex 2
lsmeans(oranges.lm1, ~ day * price, at = ... ) # Ex 3
@
Ex~1 illustrates the formula method for \wix{specifying factors}\ixsub{factors}{specifying}, which is more compact. The "" character replaces the "by" specification. Ex~2 and Ex~3 produce the same results, but their results are displayed as one table (with columns for "day" and "price") rather than as two separate tables.\ixsub{formula specs}{onesided}




\section{Working with the results}\index{ref.grid@\dqt{ref.grid} class}
\subsection{Objects}
The "ref.grid" function produces an object of class \rg{}, and the "lsmeans" function produces an object of class \lsmo{},\index{lsmobj@\dqt{lsmobj} class} which is a subclass of \rg. There is really no practical difference between these two classes except for their "show" methodswhat is displayed by defaultand the fact that an \lsmo{} is not (necessarily) a true reference grid as defined earlier in this article. Let's use the \wixcode{str} function to examine the \lsmo{} object just produced:
<<>>=
str(org.lsm)
@
We no longer see the reference levels for all predictors in the modelonly the levels of "day" and "price2". These \emph{act} like reference levels, but they do not define the reference grid upon which the predictions are based.

\subsection{Summaries}
There are several methods for \rg{} (and hence also for \lsmo{}) objects. One already seen is \wixcode{summary}. It has a number of argumentssee its help page. In the following call, we summarize "days.lsm" differently than before. We will also save the object produced by "summary" for further discussion.
<<>>=
( org.sum < summary(org.lsm, infer = c(TRUE,TRUE),
 level = .90, adjust = "bon", by = "day") )
@
The \wixcode{infer} argument causes both \wix{confidence intervals} and \wix{tests} to be produced; the default confidence level of $.95$ was overridden; a Bonferroni adjustment\ixcode{adjust}\ixcode{level}\ix{multiplicity adjustment}\ixsub{multiplicity adjustment}{Bonferroni} was applied to both the intervals and the $P$~values; and the tables are organized the opposite way from what we saw before.

What kind of object was produced by "summary"? Let's see:
<<>>=
class(org.sum)
@
The \dqt{\wixcode{summary.ref.grid}} class is an extension of \dqt{data.frame}. It includes some attributes that, among other things, cause additional messages to appear when the object is displayed. But it can also be used as a \dqt{data.frame} if the user just wants to use the results computationally. For example, suppose we want to convert the LS~means from dollars to Russian rubles (at the July 13, 2014 exchange rate):
{\small
<<>>=
transform(org.sum, lsrubles = lsmean * 34.2)
@
}
Observe also that the summary is just one data frame with six rows, rather than a collection of three data frames; and it contains a column for all reference variables, including any "by" variables.

Besides "str" and "summary", there is also a \wixcode{confint} method, which is the same as "summary" with "infer=c(TRUE,FALSE)", and a \wixcode{test} method (same as "summary" with "infer=c(FALSE,TRUE)", by default). The "test" method may in addition be called with "joint=TRUE"\ixsub{tests}{joint} to obtain a joint test that all or some of the linear functions are equal to zero or some other value.

There is also an \wixcode{update} method which may be used for changing the object's display settings. For example:
<<>>=
org.lsm2 < update(org.lsm, by.vars = NULL, level = .99)
org.lsm2
@

\subsection{Plots}\ix{plots}\ix{graphical displays}
Confidence intervals for LS~means may be displayed graphically, using the \wixcode{plot} method. For example:
<>=
plot(org.lsm, by = "price2")
@
The resulting display is shown in \Fig{orgplot}. This function requires that the \wixpkg{lattice} package be installed.
\begin{figure}
\begin{center}
\includegraphics{usinglsmeansorgplot.pdf}
\end{center}
\caption{Confidence intervals for LS~means in the \code{oranges} example.}\label{orgplot}
\end{figure}
Additional graphical presentations are covered later in this vignette.



\section{Contrasts and comparisons}
\subsection{Contrasts in general}\ix{contrasts}
Often, people want to do pairwise comparisons of LS~means, or compute other contrasts among them. This is the purpose of the \wixcode{contrast} function, which uses a \dqt{ref.grid} or \dqt{lsmobj} object as input. There are several standard contrast families such as \dqt{pairwise}, \dqt{trt.vs.ctrl}, and \dqt{\wixcode{poly}}.\ixsub{contrasts}{polynomial}\ixsub{contrasts}{effects (offsets from mean)}
In the following command, we request \dqt{\wixcode{eff}} contrasts, which are differences between each mean and the overall mean:
<<>>=
contrast(org.lsm, method = "eff")
@
Note that this preserves the "by" specification from before, and obtains the effects for each group. In this example, since it is an \wix{additive model}, we obtain exactly the same results in each group. This isn't wrong, it's just redundant.\index{Redundant results}

Another popular method is Dunnettstyle \wixsub{contrasts}{Dunnett}, where a particular LS~mean is compared with each of the others. This is done using \dqt{\wixcode{trt.vs.ctrl}}. In the following, we obtain (again) the LS~means for days, and compare each with the average of the LS~means on day~5 and~6.
<<>>=
days.lsm < lsmeans(oranges.rg1, "day")
( days_contr.lsm < contrast(days.lsm, "trt.vs.ctrl", ref = c(5,6)) )
@
For convenience, \dqt{\wixcode{trt.vs.ctrl1}} and \dqt{\wixcode{trt.vs.ctrlk}} methods are provided for use in lieu of "ref" for comparing with the first and the last LS~means. The \dqt{\wixcode{dunnettx}} adjustment is a good approximation to the exact Dunnett $P$~value adjustment. If the exact adjustment is desired, use \wixcode{adjust}" = "\dqt{\wixcode{mvt}}; but this can take a lot of computing time when there are several tests.

Note that by default, "lsmeans" results are displayed with confidence intervals while "contrast" results are displayed with $t$ tests. One can easily override this; for example,
<>=
confint(contrast(days.lsm, "trt.vs.ctrlk"))
@
(Results not shown.)

In the above examples, a default \wixsub{multiplicity adjustment}{default} is determined from the contrast method. This may be overridden by adding an \wixcode{adjust} argument.

\subsection{Pairwise comparisons}\ixsub{contrasts}{pairwise comparisons}
Often, users want \wix{pairwise comparisons} among the LS~means. These may be obtained by specifying \dqt{\wixcode{pairwise}} or \dqt{\wixcode{revpairwise}} as the "method" argument in the call to \wixcodesub{contrast}{method@\code{method}}. For group labels $A,B,C$, \dqt{pairwise} generates the comparisons $AB, AC, BC$ while \dqt{revpairwise} generates $BA, CA, CB$. As a convenience, a \wixcode{pairs} method is provided that calls "contrast" with "method="\dqt{pairwise}:\ixsub{pairwise comparisons}{using \code{pairs}}
<<>>=
pairs(org.lsm)
@
There is also a \wixcode{cld} (\wix{compact letter display}) method that lists the LS~means along with grouping symbols for pairwise contrasts. It requires the \wixpkg{multcompView} package \citep{mcview} to be installed.
<<>>=
cld(days.lsm, alpha = .10)
@
Two LS~means that share one or more of the same grouping symbols are not significantly different at the stated value of "alpha", after applying the multiplicity adjustment (in this case Tukey's HSD).
By default, the LS~means are ordered in this display, but this may be overridden with the argument "sort=FALSE". "cld" returns a \dqt{summary.ref.grid} object, not an "lsmobj".

Another way to display pairwise comparisons is via the "comparisons" argument of \wixcode{plot}.
\ixcodesub{plot}{\code{comparisons}}\ixsub{pairwise comparisons}{graphical}
When this is set to "TRUE", arrows are added to the plot, with lengths set so that the amount by which they overlap (or don't overlap) matches as closely as possible to the amounts by which corresponding confidence intervals for differences cover (or don't cover) the value zero.
\ix{comparison arrows}
This does not always work, and if there are discrepancies, a message is printed. But it usually works as long as the standard errors of differences are not too discrepant.
<>=
plot(days.lsm, comparisons = TRUE, alpha = .10)
@
\Fig{dayscmp} shows the result. Note that the pairs of means having overlapping arrows are the same as those grouped together in the "cld" display. However, these comparison arrows show more about the degree of significance in the comparisons. The lowest and highest LS~mean have arrows pointing only inward, as the others are not needed. If the confidence intervals and arrows together look too cluttered, one can add the argument \code{intervals = FALSE}, then only the arrows will be displayed.\ixcodesub{plot}{intervals@\code{intervals}}
\begin{figure}
\begin{center}
\includegraphics{usinglsmeansdayscmp.pdf}
\end{center}
\caption{Graphical comparisons of the LS~means for \code{days}.}\label{dayscmp}
\end{figure}

\subsection{Multiplicity adjustmentschanging the family}\ixsub{multiplicity adjustment}{combining/subsetting families}
You may have noticed that in the preceding examples where $P$value adjustments were implemented, those adjustments were made \emph{separately} for each subtable when a "by" variable is active. Some users prefer that all the adjusted tests together as one familyor even combine more than one family of tests into one family for purposes of adjustment. This may be done using the \wixcode{rbind} method (similar to using "rbind" to combine matrices.

On the flip side, perhaps we want to exclude some tests. This may be used using the \ixcode{[]} operator: simply specify the row indexes of the tests to include.

To illustrate, consider the previously obtained "org.lsm" object. In "pairs(org.lsm)", we obtain the same results twice (as seen above) because the model is additive. For the same reason, if we change the "by" variable to \dqt{day}, we'll obtain three copies of the same comparison of the two "price2"s. If we want to consider the three "day" comparisons and the one "price2" comparison together as one family of four tests, we can do:
<<>>=
rbind(pairs(org.lsm)[1:3], pairs(org.lsm, by = "day")[1])
@
Note that by default, the \dqt{mvt} adjustment level is used; for complicated families like this, ordinary Tukey and Dunnett adjustments are usually not appropriate.

We arrived at this point by a circuitous path. In the additive model, the above conditional results are the same as the marginal ones:
<<>>=
rbind(pairs(lsmeans(org.lsm, "day")), pairs(lsmeans(org.lsm, "price2")))
@


\section{Multivariate models}
The "oranges" data has two response variables. Let's try a \wix{multivariate model} for predicting the sales of the two varieties of oranges, and see what we get if we call "ref.grid":
<<>>=
oranges.mlm < lm(cbind(sales1,sales2) ~ price1 + price2 + day + store,
 data = oranges)
ref.grid(oranges.mlm)
@
What happens is that the multivariate response is treated like an additional factor, by default named \wixcode{rep.meas}. In turn, it can be used to specify levels for LS~means. Here we rename the multivariate response to \dqt{variety} and obtain "day" means (and a compact letter display for comparisons thereof) for each "variety":\ixcode{mult.name}
<<>>=
org.mlsm < lsmeans(oranges.mlm, ~ day  variety, mult.name = "variety")
cld(org.mlsm, sort = FALSE)
@




\section{Contrasts of contrasts (interaction contrasts)}
With the preceding model, we might want to compare the two varieties on each day:
<<>>=
org.vardiff < update(pairs(org.mlsm, by = "day"), by = NULL)
@
The results (not yet shown) will comprise the six "sales1sales2" differences, one for each day. The two "by" specifications seems odd, but the one in "pairs" specifies doing a separate comparison for each day, and the one in "update" asks that we convert it to one table with six rows, rather than 6 tables with one row each. Now, let's compare these differences to see if they vary from day to day.
<<>>=
cld(org.vardiff)
@
There is little evidence of variety differences, nor that these differences vary from day to day.

A newer feature of the \wixcodesub{contrast}{\code{interaction}} function is the optional "interaction" argument, which may be used to specify \wix{interaction contrasts}\ixsub{contrasts}{interaction}\ixsub{contrasts}{of contrasts}
by naming which contrast to use for each variable (in the order of appearance in the grid). In a similar example to the above, suppose we want to compare each polynomial contrast in "day" between the two varieties:\ixsub{contrasts}{polynomial}
<<>>=
org.icon < contrast(org.mlsm, interaction = c("poly", "pairwise"))
org.icon
@

Exactly what contrasts are being generated can become somewhat confusing, especially where interaction contrasts are concerned. The \wixcode{coef} method\ixsub{contrasts}{retrieving coefficients} helps with this; it returns a "data.frame" with the grid of factor levels that were contrasted, along with the contrast coefficients that were used:
<<>>=
coef(org.icon)
@
We can see more clearly that each contrast is the difference of a polynomial contrast on the first six rows of "org.mlsm", minus that same contrast of the last six rows. (Note: "coef" is only useful for objects generated by "contrast" or "pairs"; if called on some other "ref.grid" object, it simply returns "NULL".)

\section[Interfacing with multcomp]{Interfacing with \pkg{multcomp}}
The \wixpkg{multcomp} package \citep{multc} supports more options for simultaneous inference than are available in \lsm{}. Its \wixcode{glht} (general linear hypothesis testing) function and associated \dqt{glht} class are similar in some ways to "lsmeans" and \dqt{lsmobj} objects, respectively. So \lsm{} provides an \wixcode{as.glht} function to do the conversion.

To illustrate, let us convert the "days_contr.lsm" object (produced earlier) to a "glht" object, and use it to obtain adjusted $P$~values under \wix{Westfall's adjustment procedure} (not available in \lsm{}):
<>=
# Ensure we see the same results each time
set.seed(123454321)
@
<<>>=
library("multcomp")
days.glht < as.glht(days_contr.lsm)
summary(days.glht, test = adjusted("Westfall"))
@
In addition, \lsm{} provides an \wixcode{lsm} function (or its alias, \wixcode{pmm}) that may be called from within a call to "glht". Thus, another way to obtain the same "glht" object is to use
<>=
days.glht1 < glht(oranges.lm1,
 lsm("day", contr = "trt.vs.ctrl", ref = c(5,6)))
@

By the way, the following two statements will produce the same results:
<>=
summary(days_contr.lsm, adjust = "mvt")
summary(days.glht)
@
That is, the \dqt{mvt} adjust method in \lsm{} is the same as the default singlestep $P$~value adjustment in \pkg{multcomp}.\ixsub{multiplicity adjustment}{singlestep (\code{mvt})}


One additional detail: If there is a "by" variable in effect, "glht" or "as.glht" returns a "list" of "glht" objectsone for each "by" level. There are courtesy "coef", "confint", "plot", "summary", and "vcov" methods for this \dqt{\wixcode{glht.list}} class to make things a bit more userfriendly. Recall the earlier example result "org.lsm", which contains information for LS~means for three "day"s at each of two values of "price2". Suppose we are interested in pairwise comparisons of these LS~means, by "price2". If we call
<>=
summary(as.glht(pairs(org.lsm)))
@
(results not displayed) we will obtain two "glht" objects with three contrasts each, so that the results shown will incorporate multiplicity adjustments for each family of three contrasts. If, on the other hand, we want to consider those six contrasts as one family, use
<>=
summary(as.glht(pairs(org.lsm), by = NULL))
@
\ldots{} and note (look carefully at the parentheses) that this is \emph{not} the same as
<>=
summary(as.glht(pairs(org.lsm, by = NULL)))
@
which removes the "by" grouping \emph{before} the pairwise comparisons are generated, thus yielding ${6 \choose 2}=15$ contrasts instead of just six.\ixsub{multiplicity adjustment}{effect of \code{by} on family}




\section{A new example: Oat yields}\index{Examples!oat yields}\index{Examples!splitplot experiment}
Orangesales illustrations are probably getting tiresome. To illustrate some new features, let's turn to a new example.
The \wixcode{Oats} dataset in the \wixpkg{nlme} package \citep{nlme} has the results of a splitplot experiment discussed in \citet{Yat35}. The experiment was conducted on six blocks (factor "Block"). Each block was divided into three plots, which were randomized to three varieties (factor "Variety") of oats. Each plot was divided into subplots and randomized to four levels of nitrogen (variable "nitro"). The response, "yield", was measured once on each subplot after a suitable growing period.

We will fit a model using the "lmer" function in the \wixpkg{lme4} package \citep{lme4}. This will be a mixed model with random intercepts for "Block" and "Block:Variety" (which identifies the plots). A logarithmic transformation is applied to the response variable (mostly for illustration purposes, though it does produce a good fit to the data). Note that "nitro" is stored as a numeric variable, but we want to consider it as a factor in this initial model.
<<>>=
data("Oats", package = "nlme")
library("lme4")
Oats.lmer < lmer(log(yield) ~ Variety*factor(nitro) + (1Block/Variety),
 data = Oats)
anova(Oats.lmer)
@
Apparently, the interaction is not needed. But perhaps we can further simplify the model by using only a linear or quadratic trend in "nitro". We can find out by looking at polynomial contrasts:\ixsub{contrasts}{polynomial}
<>=
contrast(lsmeans(Oats.lmer, "nitro"), "poly")
@
%%% Fake the warning message
<>=
cat("NOTE: Results may be misleading due to involvement in interactions")
@
<>=
<>
@
\ixsub{warnings}{when interaction is in model}
(A message is issued when we average over predictors that interact with those that delineate the LS~means. In this case, it is not a serious problem because the interaction is weak.) Both the linear and quadratic contrasts are pretty significant. All this suggests fitting an additive model where "nitro" is included as a numeric predictor with a quadratic trend.
<<>>=
Oats.lmer2 < lmer(log(yield) ~ Variety + poly(nitro,2)
 + (1Block/Variety), data = Oats)
@
Remember that "nitro" is now used as a quantitative predictor.\ixsub{factors}{with quantitative levels}
But for comparing with the previous model, we want to see predictions at the four unique "nitro" values rather than at the average of "nitro". This may be done using "at" as illustrated earlier, or a shortcut is to specify \wixcode{cov.reduce} as "FALSE", which tells "ref.grid" to use all the unique values of numeric predictors.
<<>>=
Oats.lsm2 < lsmeans(Oats.lmer2, ~ nitro  Variety, cov.reduce = FALSE)
@
The results are displayed as an export table (see Section~\ref{xtsect}) in Table~\ref{xtable:example}, page~\pageref{xtable:example}.
These LS~means follow the same quadratic trend for each variety, but with different intercepts.\footnote{%
This is the promised example where our generalization of \cite{Sea80}'s definition of LS~means makes sense. Suppose we want to compare the LS~means for \code{Variety} with those in the original model \code{Oats.lmer} where \code{nitro} was a factor, we want to average equally over the four \code{nitro} levels, even though \code{nitro} is a covariate in this second model.}\ixsub{reference grid}{altered for quantitative factor}

Fractional \wixsub{degrees of freedom}{fractional} are displayed in these results. These are obtained by default using the Satterthwaite method, using routines in the \wixpkg{lmerTest} package \citep{lmert}. Adding the argument \code{mode = \dqt{kenwardroger}} to the \code{lsmeans} call will cause the degrees of freedom to be computed using instead the KenwardRoger (KR) method from the \wixpkg{pbkrtest} package \citep{pbkrt}, which also implements, as a sideeffect, a bias adjustment in the estimated covariances (and hence standard errors). The KR method is probably preferable, but it requires a lot more computation, and hence is no longer the default. A third option is to specify \code{mode = \dqt{asymptotic}}, for which all the degrees of freedom are set to \code{NA}producing $z$~tests rather than $t$~tests. You may change the default via \code{lsm.options(lmer.df = \emph{\dqt{desired default}})}. These \code{mode} settings are partially matched, so \code{mode = \dqt{k}} is actually good enough.


\section{Additional display methods}
\subsection{Export tables}\ix{export tables}\label{xtsect}
The \pkg{lsmeans} package provides an \wixcode{xtable} method \citep{xtable} that works with "lsmobj", "ref.grid", and "summary.ref.grid" objects. (It actually uses the \wixcode{xtableList} interface; see the \ixpkg{xtable} documentation for details.) This is quite useful if you want a nicely formatted table, especially using \wixcode{Sweave} or \wixcode{knitr}. To illustrate, we display the "Oats.lsm2" object just created.
<>=
library("xtable")
xtbl < xtable(Oats.lsm2, caption = "Example using \\texttt{xtable}",
 label = "xtable:example")
print(xtbl, table.placement = "t")
cat("See Table~\\ref{xtable:example}.\n")
@


\subsection{Displaying LS means graphically}\ixsub{graphical displays}{interaction plot}
We have already seen the use of the "plot" function to display confidence intervals and/or comparison arrows.
The \lsm{} package also includes a function \wixcode{lsmip} that displays predictions in an interactionplotlike manner.\ix{interaction plot} It uses a formula of the form
\begin{Sinput}
curve.factors ~ x.factors  by.factors
\end{Sinput}
This function also requires the \wixpkg{lattice} package.
In the above formula, "curve.factors" specifies factor(s) used to delineate one displayed curve from another (i.e., groups in \pkg{lattice}'s parlance). "x.factors" are those whose levels are plotted on the horizontal axis. And "by.factors", if present, break the plots into panels.

To illustrate, consider the first model we fitted to the "Oats" data. Let's do a graphical comparison of the two models we have fitted to the "Oats" data.
<>=
lsmip(Oats.lmer, Variety ~ nitro, ylab = "Observed log(yield)")
@
\vspace{12pt}
<>=
lsmip(Oats.lsm2, Variety ~ nitro, ylab = "Predicted log(yield)")
@
The plots are shown in \Fig{intplots}.
Note that the first model fits the cell means perfectly, so its plot is truly an interaction plot of the data. The other displays the parabolic trends we fitted in the revised model.
\begin{figure}
\includegraphics[width=3in]{usinglsmeansoatslmer.pdf}
\hfill
\includegraphics[width=3in]{usinglsmeansoatslmer2.pdf}
\caption{Interaction plots for the cell means and the fitted model, \code{Oats} example.}\label{intplots}
\end{figure}




\section{Transformations}\ix{transformations}
\subsection{Automatic support for transformations}\ixsub{transformations}{automatically detected}
When a transformation or link function is used in fitting a model, "ref.grid" (also called by "lsmeans") stores that information in the returned object, as seen in this example:
<<>>=
str(Oats.lsm2)
@
This allows us to conveniently unravel the transformation, via the \wixcode{type} argument in "summary" or related functions such as "lsmip" and "predict".\ixcodesub{summary}{type@\code{type = }\dqt{response}} Here are the predicted yields for (as opposed to predicted log yields) for the polynomial model:
<<>>=
summary(Oats.lsm2, type = "response")
@
It is important to realize that the statistical inferences are all done \emph{before} reversing the transformation. Thus, $t$ ratios are based on the linear predictors and will differ from those computed using the printed estimates and standard errors. Likewise, \wixsub{confidence intervals}{backtransformed} are computed on the linearpredictor scale, then the endpoints are backtransformed.

This kind of automatic support is available for most popular response transformations such as "log", "log10", and even transformations like "asin(sqrt())" and "sqrt(y)+sqrt(y+1)". The Details section for \verbhelp("make.tran") provides a complete list. It is also possible to support custom transformations via the "tran" argument in the "update" methodsee its help page.
\ixsub{transformations}{custom}

\subsection{Using \code{make.tran}}\ixsub{transformations}{using \code{make.tran}}\ixsub{transformations}{requiring parameter(s)}\ixsub{transformations}{BoxCox}
The \wixcode{make.tran} function provides support for yet more popular types of transformations, particularly those that require specifying one or more parameters. Examples are general power transformations, \wix{BoxCox transformations}, and transformations with a shifted origin such as "log(y + a)". Details may of course be found via \verbhelp("make.tran"). The function returns a "list" of functions, compatible with what is returned by "make.link" in the \pkg{stats} package. The latter is intended primarily for use with generalized linear models, and "make.tran" extends such capabilities to other response transformations.

There are two basic ways to use "make.tran": retrospectively on an existing model, and prospectively in fitting a new model. Here is an example of retrospective use, where the $\log(y+5)$ transformation was used. This transformation is not autodetected.
<<>>=
Oats.log1 < lmer(log(yield + 5) ~ Variety + factor(nitro)
 + (1Block/Variety), data = Oats)
( Oats.rg1 < update(ref.grid(Oats.log1),
 tran = make.tran("genlog", 5)) )
@
Here, we created a reference grid for the model, then updated it with its "tran" component set to the result of "make.tran" for a generalized log transformation with parameter 5.
\ixcodesub{update}{tran@\code{tran}}
This updated reference grid has all the information needed to backtransform the results to the original "yield" scale:
<<>>=
round(predict(Oats.rg1, type = "response"), 1)
@

\ixcodesub{tran}{using \code{linkfun}}\ixcodesub{make.tran}{as enclosing environment}
Using "make.tran" prospectively makes use of the fact that the transformation itself is included in the returned list as a function named "linkfun" (somewhat oddly named due to the fact that "make.tran" mimics the functionality of "make.link"). When a model is fitted with "linkfun" as the transformation, its \wix{enclosing environment} is automatically used to obtain the transformation definitions. For illustration, consider a rather farfetched transformation:
<<>>=
my.tran < make.tran("boxcox", c(.567, 10))
my.tran$linkfun(10:15)
@
This specifies a BoxCox transformation with the origin shifted to $10$:%
\footnote{To obtain an ordinary BoxCox transformation, provide just one parameter: \code{make.tran(\dqt{boxcox}, .567)}.}
\[
 h(y) = \frac{(y10)^{.567}  1}{1  .567}
\]
If we use "my.tran" as an enclosing environment for fitting the model, the transformation is saved automatically:
<<>>=
Oats.bc < with(my.tran, lmer(linkfun(yield) ~ Variety + factor(nitro)
 + (1Block/Variety), data = Oats))
( rg.bc < ref.grid(Oats.bc) )
round(predict(rg.bc, type = "response"), 1)
@

\subsection{Using \code{regrid}}\ixsub{reference grid}{regridding to response scale}
The \wixcode{regrid} function may be used to, in essence, give a new beginning to an existing reference grid (or "lsmobj"), most redefined on the response scale (i.e., backtransformed). Consider the preceding BoxCox example, after applying "regrid":
<<>>=
rg.bc.regrid < regrid(rg.bc)
@
By default, the estimates are backtransformed to the response scale. In a "regrid" result, the "linfct" slot (linear functions) become the identity matrix, and the "bhat" slot (regression coefficients) become the predictions at each grid point:
<<>>=
round(rg.bc.regrid@bhat, 1)
@
which matches the predictions shown previously.

The interesting thing is what happens if we subsequently obtain LS~means. Compare these results:
<<>>=
summary(lsmeans(rg.bc, "Variety"), type = "response")
lsmeans(rg.bc.regrid, "Variety")
@
\ixcodesub{regrid}{effect on LS~means}
Why are the answers somewhat different? Recall that LS~means are obtained via equallyweighted averages of predictions. In the first "lsmeans" call, the predictions, on the BoxCox scale, are averaged together and then backtransformed to the response scale; whereas in the second "lsmeans" call, the predictions being averaged were already on the response scale. (Hence, the results are the usual arithmetic means of the predictions on the grid.) Since the BoxCox transformation is nonlinear, averaging then backtransforming is not the same as backtransforming then averaging.\ixsub{mean}{arithmetic}

Even the degrees of freedom (d.f.) differ in the two results, because degreesoffreedom calculations take place on the linearpredictor scale. Once results are backtransformed, "regrid" ``freezes'' the calculated \wixsub{degrees of freedom}{containment method} for each prediction. Subsequently, a containment method is used whereby the returned d.f.\ is the minimum d.f.\ of predictions involved in each LS~mean.

Some users prefer averaging the predictions on the response scale as they are then the arithmentic means; and now you see that the way to make that happen is through the "regrid" function.

\subsection{Reverseengineering a log transformation}\ixsub{reference grid}{regridding to log scale}
When a response has been logtransformed, then there are useful special properties of backtransformed summaries:
\begin{itemize}
\item LS~means, when backtransformed to the response scale, are actually the \emph{geometric} means of the responsescale predictions.\ixsub{mean}{geometric}
\item A difference of two LS~means on the log scale, after backtransforming, becomes an estimate of the \emph{ratio} of the two geometric means. Such comparisons via ratios can be quite useful for positive responses.\ixsub{pairwise comparisons}{by ratios instead of differences}
\end{itemize}

The \wixcodesub{regrid}{log@\dqt{log} option} function provides a \dqt{log} option that recomputes the reference grid \emph{as if} the response transformation had been the natural logarithm. We can then take advantage of the above special properties of logtransformed responses. The only proviso is that, on the response scale, all of the referencegrid predictions must be positive.

To illustrate, we revisit the above BoxCox model once again, and regrid it on the log scale:
<<>>=
rg.log < regrid(rg.bc, "log")
lsm.log < lsmeans(rg.log, "Variety")
summary(lsm.log, type = "response")
summary(pairs(lsm.log), type = "response")
@
The LS~means shown are the geometric means of the predictions, as opposed to the arithmetic means obtained above from "rg.bc.regrid". And the pairwise comparisons come out as ratios of these.

\subsection{The \code{transform} argument}\ixcodesub{transform}{in \code{ref.grid} or \code{lsmeans}}
For convenience, the user may use a "transform" argument to regrid as part of a "ref.grid" or "lsmeans" call. For example, \verblsmeans(Oats.bc, "Variety", transform = "response") is equivalent to \verblsmeans(rg.bc.regrid, "Variety") but without needing the two code steps previously used to produce "rg.bc" and "rg.bc.regrid".


\subsection{Duplex transformations}\ix{duplex transformations}\ix{two transformations}\ixsub{transformations}{duplex}\ixsub{transformations}{two in same model}
It is possible to have both a response transformation and a link function in a generalized linear model. For example,
<<>>=
warp.glm < glm(sqrt(breaks) ~ wool * tension, family = gaussian(link = "log"),
 data = warpbreaks)
@
In such a case, both the link function and response transformation are autodetected, as can be seen here:
<<>>=
warp.rg < ref.grid(warp.glm)
warp.rg
@
Using predictions, summaries, or tests of type \dqt{response} will undo both transformations, so that in the above example, the results would be on the original scale (number of warp breaks). Some users may want to backtransform only halfwayundoing the link function but not the response transformation. For that purpose, prediction type of \dqt{mu} (or equivalently, \dqt{unlink}) is supported. In this example, here are predictions on three different scales:
<<>>=
predict(warp.rg, type = "linear") ### log(sqrt) scale  no backtransformation
predict(warp.rg, type = "unlink") ### sqrt scale
predict(warp.rg, type = "response") ### response scale
@


\section{More on tests}
\def\tj{\theta^{(j)}}%%% Notation for this section only
The default settings for "test" yield traditional twotailed $t$ (or $z$) tests of significance against zero. So if $\tj$ is the $j$th parameter (e.g., LS~mean or contrast) being estimated, we are testing the null hypothesis $H_0: \tj=0$ versus the alternative $H_1:\tj\ne 0$. We can, however, specify different types of tests in the \wixcode{test} or \wixcode{summary} functions.

\subsection{Nonzero null values}\ixsub{tests}{nonzero null}
If we wish to use nonzero null values, i,e., test $H_0:\tj=\tj_0$, use "test" or "summary" with the \wixcode{null} argument set to the desired $\tj_0$ values. For example, in the Oatyield example, suppose we want to test each of the "Variety" yields against 100 (actually $\log 100$ since the response was transformed):
<<>>=
Oats.Vlsm = lsmeans(Oats.lmer2, "Variety")
test(Oats.Vlsm, null = log(100), type = "response")
@
Note that "null" should always be given on the linearpredictor scale (in this case $\log$ yield), even when specifying \verbtype="response". We could have specified different null values for each hypothesis by providing a vector of three numbers.

\subsection{Equivalence tests}\ixsub{tests}{equivalence}\ix{equivalence tests}\ix{TOST method}
The preceding results say that none of the variety means differs significantly from 100, after transforming. But this is not the same as saying that we have evidence that the means are close to 100 (that is, absence of proof is not proof of absence). To make a strong statement that an effect is small, we should use an equivalence test, which moreorless turns the hypotheses around:
\[ H_0: \tj  \tj_0 \ge \delta \qquad\mbox{versus}\qquad H_1: \tj  \tj_0 < \delta \]
where $\delta$ is a specified threshold of equivalence. A common test procedure is the two onesided test (TOST) method \citep{Sch87}, whereby we obtain equivalence only if we can establish both that $\tj\tj_0>\delta$ and that $\tj\tj_0<\delta$. In "lsmeans", we do this by preidentifying the less significant of these two tests:
\[ t = \frac{\hat\tj\tj_0  \delta}{SE(\hat\tj)} \]
and the $P$~value is the \emph{left}tail probability of this quantity from the central $t$ distribution.

In "test" or "summary", an equivalence test is requested by specifying a nonzero \wixcode{delta} argument, which in turn is used as the threshold $\delta$. In the Oatyield example, the following results are obtained using a threshold of $\delta=0.20$:\ixcodesub{test}{delta@\code{delta} argument}
<<>>=
test(Oats.Vlsm, null = log(100), delta = 0.20, type = "r")
@
So two of the three Variety means are established as being within $.20$ of $\log100$. The natural log scale has the special property that small increments on the log scale translate to approximate percentage differences of the same size. That is, a threshold of $.20$ corresponds to about a 20\% difference: $\log 80  \log100 = \log.8 \approx .223$, and $\log120  \log100 = \log1.2 \approx .182$.

\subsection{Onesided tests, noninferiority, nonsuperiority}
\ixsub{tests}{onesided}
The \wixcode{side} argument is also available to specify \wix{onesided tests}. A righttailed alternative may be requested using "side" partially matching one of \dqt{+}, \dqt{right}, \verb">", "+1", "1", \dqt{superiority}, or (see later) \dqt{noninferiority}. Similarly, a lefttailed alternative may be specified using "side" equal to \dqt{}, \dqt{left}, \verb"<", "1", \dqt{inferiority}, or \dqt{nonsuperiority}. (And for completeness, a twosided alternative is specified using "0", "2", \verb"!=", \dqt{both}, \dqt{twosided}, \dqt{equivalence}, or \dqt{=}.) In the following example, we test to see if either Golden Rain or Marvellous has better yield than Victory:
<<>>=
test(contrast(Oats.Vlsm, "trt.vs.ctrlk"), side = ">")
@
\ixsub{tests}{noninferity or nonsuperiority}
The onesided version of an equivalence test is called a noninferiority or nonsuperiority test. It is obtained by specifying both "side" and a nonzero "delta". For example, to test whether Victory is as good as the other two within a 25\% threshold, use
<<>>=
test(contrast(Oats.Vlsm, "trt.vs.ctrlk"), side = "nonsup", delta = .25)
@
We find strong evidence that, with the stated threshold of .25, Golden Rain is nonsuperior to Victory (so that Victory is noninferior to Golden Rain); but not strong evidence that Victory is noninferior to Marvellous.





\section{Trends}\ix{trends, estimating and comparing}\ix{slopes, estimating and comparing}
\index{Examples!chick weights}\index{Examples!comparing trends}
The \lsm{} package provides a function \wixcode{lstrends} for estimating and comparing the slopes of fitted lines (or curves). To illustrate, consider the builtin R dataset \wixcode{ChickWeight} which has data on the growths of newly hatched chicks under four different diets. The following code produces the display in \Fig{chickplot}.
<>=
require("lattice")
xyplot(weight ~ Time  Diet, groups = ~ Chick, data = ChickWeight,
 type = "o", layout=c(4, 1))
@
\begin{figure}
\centerline{\includegraphics[width=6in]{usinglsmeanschickplot}}
\caption{Growth curves of chicks, dataset \texttt{ChickWeight}.}\label{chickplot}
\end{figure}

Let us fit a model to these data using random slopes for each chick and allowing for a different average slope for each diet (a squareroot transformation straightensout the curves somewhat):
<<>>=
Chick.lmer < lmer(sqrt(weight) ~ Diet * Time + (0 + Time  Chick),
 data = ChickWeight)
@
We can then call \wixcode{lstrends} (or, its antiSAS alias, \wixcode{pmtrends}) to estimate and compare the average slopes for each diet.
<<>>=
Chick.lst < lstrends (Chick.lmer, ~ Diet, var = "Time")
@
Now, let's summarize the estimated trends and pairwise comparisons of these slopes using a compact letter display.
<<>>=
cld (Chick.lst)
@
According to the Tukey~HSD comparisons (with default significance level of $.05$), there are two groupings of slopes: Diet~1's mean slope is significantly less than $3$ or $4$'s, Diet~2's slope is not distinguished from any other.

Because of the response transformation, the slopes we just computed are for trends on the squarerootweight scale. If you want the trends on the actual weight scale after backtransforming, that is possible via the "transform" argument:\ixcodesub{lstrends}{with response transformation}\ixcodesub{transform}{in \code{lstrends}}
<<>>=
lstrends(Chick.lmer, ~ Diet  Time, var = "Time",
 transform = "response", at = list(Time = c(5, 15)))
@
We specified two different "Time" values to emphasize that after backtransforming, the slopes are different at each "Time", whereas (by the model specification) the slopes don't depend on "Time" when we leave it on the squareroot scale.

Note: "lstrends" computes a difference quotient based on two slightly different reference grids. Thus, if it it must be called with a model object, not a "ref.grid" object.
\ixsub{reference grid}{difference quotient of two}




\section{User preferences}\ix{user preferences}
\lsm{} sets certain defaults for displaying resultsfor example, using $.95$ for the confidence coefficient, and showing intervals for "lsmeans" output and test statistics for "contrast" results. As discussed before, one may use arguments in "summary" to change what is displayed, or "update" to change the defaults for a given object. But suppose you want different defaults to begin with. These can be set using the \wixcode{lsm.options} statement. For example:
<<>>=
lsm.options(ref.grid = list(level = .90),
 lsmeans = list(),
 contrast = list(infer = c(TRUE, TRUE)))
@
This requests that any object created by "ref.grid" be set to have confidence levels default to $90$\%, and that "contrast" results are displayed with both intervals and tests. No new options are set for "lsmeans" results, and the "lsmeans" part could have been omitted. These options are stored with objects created by "ref.grid", "lsmeans", and "contrast". For example, even though no new defaults are set for "lsmeans", future calls to "lsmeans" \emph{on a model object} will be displayed with 90\% confidence intervals, because "lsmeans" calls "ref.grid". However, calling "lsmeans" on an existing \dqt{ref.grid} object will inherit that object's setting.

Certain other options are available; for example, the \dqt{\wixcode{estble.tol}} option sets the tolerance for determining estimability of linear contrasts. To see its current value:
<<>>=
get.lsm.option("estble.tol")
@
Defaults for this and some other parameters are saved in \wixcode{defaults.lsm}.
\ixcode{get.lsm.option}


%%%%%%%%%%%%%%%%% INDEXING COMPLETED TO HERE 3516 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%



\section{Twosided formulas}\ixsub{factors}{specifying}\ixsub{formula specs}{twosided}
In its original design, the only way to obtain contrasts and comparisons in \lsm{} was to specify a twosided formula, e.g., "pairwise ~ treatment", in the "lsmeans" call. The result is then a list of "lsmobj" objects (class \dqt{lsm.list}).
\index{lsm.list@\dqt{lsm.list} class}
In its newer versions, \lsm{} offers a richer family of objects that can be reused, and dealing with a list of objects can be awkward or confusing, so its continued use is not encouraged. Nonetheless, it is still available for backward compatibility.

Here is an example where, with one command, we obtain both the LS~means and pairwise comparisons for "Variety" in the model "Oats.lmer2":
{\small
<<>>=
lsmeans(Oats.lmer2, pairwise ~ Variety)
@
}
This example also illustrates the effect of the preceding "lsm.options" settings. Let us now return to the default display for contrast results.
<<>>=
lsm.options(ref.grid = NULL, contrast = NULL)
@




\section{Messy data}\ix{messy data}\index{Examples!nutrition study}\index{Examples!messy data}
To illustrate some more \code{lsmeans} capabilities, consider the dataset named \wixcode{nutrition} that is provided with the \lsm{} package. These data come from \citet{Mil92}, and contain the results of an observational study on nutrition education. Lowincome mothers are classified by race, age category, and whether or not they received food stamps (the \code{group} factor); and the response variable is a gain score (post minus pre scores) after completing a nutrition training program.

Consider the model that includes all main effects and twoway interactions. A TypeII (hierarchical) analysisofvariance table is also shown.
<<>>=
nutr.lm < lm(gain ~ (age + group + race)^2, data = nutrition)
library("car")
Anova(nutr.lm)
@
One main effect ("group") is quite significant, and there is possibly an interaction with "race". Let us look at the \code{group} by \code{race} LS~means:
<>=
lsmip(nutr.lm, race ~ age  group)
lsmeans(nutr.lm, ~ group*race)
@
\begin{figure}
\centerline{\includegraphics[scale=.75]{usinglsmeansnutrintplot}}
\caption{Predictions for the nutrition data}\label{nutrintplot}
\end{figure}

\Fig{nutrintplot} shows the predictions from this model. One thing the output illustrates is that \code{lsmeans} incorporates an \wix{estimability} check, and returns a missing value when a prediction cannot be made uniquely. In this example, we have very few Hispanic mothers in the dataset, resulting in \wix{empty cells}. This creates a \wix{rank deficiency} in the fitted model, and some predictors are thrown out.

We can avoid nonestimable cases by using \code{at} to restrict the reference levels to a smaller set. A useful summary of the results might be obtained by narrowing the scope of the reference levels to two races and the two middle age groups, where most of the data lie. However, always keep in mind that whenever we change the reference grid, we also change the definition of the LS~means. Moreover, it may be more appropriate to average the two ages using weights proportional to their frequencies in the data set. The simplest way to do this is to add a \wixcode{weights} argument.\footnote{
It may also be done by specifying a custom function in the \wixcode{fac.reduce} argument, but for simple weighting, \code{weights} is simpler.}
With those ideas in mind, here are the LS~means and comparisons within rows and columns:
<<>>=
nutr.lsm < lsmeans(nutr.lm, ~ group * race, weights = "proportional",
 at = list(age = c("2","3"), race = c("Black","White")))
@
So here are the results
<<>>=
nutr.lsm
summary(pairs(nutr.lsm, by = "race"), by = NULL)
summary(pairs(nutr.lsm, by = "group"), by = NULL)
@
The general conclusion from these analyses is that for age groups 2 and~3, the expected gains from the training are higher among families receiving food stamps.
Note that this analysis is somewhat different than the results we would obtain by subsetting the data before analysis, as we are borrowing information from the other observations in estimating and testing these LS~means.

\subsection{More on weighting}\label{weights}
The \wixcodesub{weights}{equal, proportional, outer, cells} argument can be a vector of numerical weights (it has to be of the right length), or one of five text values: \dqt{equal} (weight the predictions equally when averaging them, the default), \dqt{proportional} (weight them proportionally to the observed frequencies of the factor combinations being averaged over), \dqt{outer} (weight according to the outer products of the onefactor marginal counts), \dqt{cells} (weight each mean differently, according to the frequencies of the predictions being averaged), or \dqt{flat} (like \dqt{cells}, but give all nonemprty cells equal weight). \Fig{wtcomp} shows the LS~means for "race" using the first four different weighting schemes. (Note: If the model itself has weights, then the total weights are used instead of counts.)
\begin{figure}
\hspace{.06\linewidth}
\begin{minipage}{1.12\linewidth}
\hrule
\columnseprule=.2pt
\begin{multicols}{2}\footnotesize
<<>>=
lsmeans(nutr.lm, "race", weights = "equal")
lsmeans(nutr.lm, "race", weights = "prop")
lsmeans(nutr.lm, "race", weights = "outer")
lsmeans(nutr.lm, "race", weights = "cells")
@
\end{multicols}
\hrule
\end{minipage}
\caption{Comparison of four different weighting methods}\label{wtcomp}
\end{figure}

Note there are four different sets of answers. The \dqt{equal} weighting is selfexplanatory. But what's the distinction between \dqt{proportional} and \dqt{outer}? To clarify, consider:
<<>>=
temp = lsmeans(nutr.lm, c("group","race"), weights = "prop")
lsmeans(temp, "race", weights = "prop")
@
The previous results using \dqt{outer} weights are the same as those using \dqt{proportional} weights on one factor at a time. Thus, if only one factor is being averaged over, \dqt{outer} and \dqt{proportional} are the same. Another way to look at it is that outer weights are like the expected counts in a chisquare test; each factor is weighted independently of the others.

The results for \dqt{cells} weights stand out because everything is estimablethat's because the empty cells in the data were given weight zero. These results are the same as the unadjusted means:
<<>>=
with(nutrition, tapply(gain, race, mean))
@


\subsection{Nested fixed effects}\ix{nested models}
A factor $A$ is nested in another factor $B$ if the levels of $A$ have a different meaning in one level of $B$ than in another. Often, nested factors are random effectsfor example, subjects in an experiment may be randomly assigned to treatments, in which case subjects are nested in treatmentsand if we model them as random effects, these random nested effects are not among the fixed effects and are not an issue to "lsmeans". But sometimes we have fixed nested factors. For example, we may have data on different cities of particular interest, in three states of particular interest. Then cities are nested in states. We might want to compare the states because they have different social services policies or something; and we might want to compare the cities in each state. This nesting becomes particularly important when we have cities with the same name in different states: we need to be able to distinguish Springfield, Illinois and Springfield, Missouri.

In contrast to older versions of the package, "lsmeans" now tries to discover and accommodate nested structures in the fixed effects. It does this in two ways: first, by identifying factors whose levels appear in combination with only one level of another factor; and second, by examining the "terms" attribute of the fixed effects.

\index{Examples!cow treatments}\index{Examples!messy data}
Here is an example of a fictional study of five fictional treatments for some disease in cows. Two of the treatments are administered by injection, and the other three are administered orally. There are varying numbers of observations for each drug. The data and model follow:
<<>>=
cows = data.frame (
 route = factor(rep(c("injection", "oral"), c(5, 9))),
 drug = factor(rep(c("Bovineumab", "Charloisazepam",
 "Angustatin", "Herefordmycin", "Mollycoddle"), c(3,2, 4,2,3))),
 resp = c(34, 35, 34, 44, 43, 36, 33, 36, 32, 26, 25, 25, 24, 24)
)
cows.lm < lm(resp ~ route + drug, data = cows)
@
The "ref.grid" function finds a nested structure in this model:
<<>>=
( cows.rg < ref.grid(cows.lm) )
@

When there is nesting, "lsmeans" computes averages separately in each group\ldots
<<>>=
( route.lsm < lsmeans(cows.rg, "route") )
@
\ldots\ and insists on carrying along any grouping factors that a factor is nested in:
<<>>=
( drug.lsm < lsmeans(cows.rg, "drug") )
@
Here are the associated pairwise comparisons:
<<>>=
pairs(route.lsm, reverse = TRUE)
pairs(drug.lsm, by = "route", reverse = TRUE)
@
In the latter result, the contrast itself becomes a nested factor in the returned reference grid. That would not be the case if there had been no "by" variable.

It is possible for "lsmeans" or "ref.grid" to misdetect or overlook the nesting structure. If that happens, you may see a lot of "NA"s in the "lsmeans" results. The user can alter the nesting structure via the "update" function or the "nesting" argument to "ref.grid". The nesting is specified using a named "list" where each member's name is a factor name, and each member is a character vector of the names of other factors that it is nested in; for example,
<>=
lsmeans(city.model, "county",
 nesting = list(county = "state", city = c("county", "state")))
@


\subsection{Alternative covariate adjustments}\ix{covariate adjustments}
\index{Example!framing experiment}
The \wixcode{framing} data in the \pkg{mediation} package has the results of an experiment conducted by \cite{Bra08} where subjects were given the opportunity to send a message to Congress regarding immigration. However, before being offered this, some subjects ("treat=1") were first shown a news story that portrays Latinos in a negative way. Besides the binary response (whether or not they elected to send a message), we also measured "emo", the subjects' emotional state after the treatment was applied. There are various demographic variables as well.

Before fitting a logistic regression model, I will change the labels for "educ" to shorter strings.
<<>>=
library("mediation")
levels(framing$educ) = c("NA","Ref","< HS", "HS", "> HS","Coll +")
framing.glm = glm(cong_mesg ~ age + income + educ + emo + gender * factor(treat),
 family = binomial, data = framing)
@
The lefthand plot in \Fig{framing} displays the conventional \wix{adjusted means}, where predictions are made with the covariates "age", "income", and "emo" set to their mean values:
<>=
lsmip(framing.glm, treat ~ educ  gender, type = "response")
@
This plot is rather implausible because the displayed treatment effects are the opposite for females as for males, and the effect of education isn't monotone as one might expect.

\begin{figure}
\begin{center}
\begin{tabular}{c@{\qquad}c}
(a) & (b) \\
\includegraphics[width=3in]{usinglsmeansframinga.pdf} &
\includegraphics[width=3in]{usinglsmeansframingb.pdf}
\end{tabular}
\end{center}
\caption{Estimated responses for the \code{framing} data. (a)~Holding \code{emo} constant at its mean; (b)~Using predictions of \code{emo} for each \code{treat}.}\label{framing}
\end{figure}

\ix{covariate affected by treatments}\ix{mediating covariate}
However, "emo" is a posttreatment measurement. This means that the treatment could have affected it (it is a \emph{mediating} covariate). If it is indeed affected by "treat", then \Fig{framing}(a) would be misleading because "emo" is held constant.
Instead, consider making the predictions where "emo" is set to its predicted value at each combination of "treat" and the demographic variables. This is easily done by setting \wixcodesub{cov.reduce}{as a formula} to a formula for how to predict "emo":
<>=
lsmip(framing.glm, treat ~ educ  gender, type = "response",
 cov.reduce = emo ~ treat*gender + age + educ + income)
@
This plot is shown in \Fig{framing}(b). It is quite different, suggesting that "emo" does indeed play a strong mediating role. (The \pkg{mediation} package has functions for estimating the strength of these effects.) The predictions suggest that, taking emotional response into account, male subjects exposed to the negative news story are more likely to send the message than are females or those not seeing the negative news story. Also, the effect of "educ" is (almost) monotone.
You can see what values of "emo" are used in these predictions by looking at the "grid" slot in the reference grid:
<<>>=
ref.grid(framing.glm,
 cov.reduce = emo ~ treat*gender + age + educ + income)@grid
@
whereas the overall mean of \Sexpr{round(mean(framing$emo), 3)} is used as the value of "emo" in \Fig{framing}(a).



\ifx %%% Old covariate example is commentedout %%%%%%%%%%%%%%%%%%

\cite{urq82} reports data on slaughter weights of animals that entered a feedlot as yearling calves. The animals came from 11 different herds, and each animal was randomized to one of three diets. In addition, the weight of each yearling at entry was recorded. The "feedlot" dataset provided in \lsm{} contains these results. From the feedlot operator's perspective, both diets and herds are fixed effects. Let us fit a factorial model with slaughter weight "swt" as the response and entry weight "ewt" as a covariate.
%<<>>=
feedlot.lm < lm(swt ~ ewt + herd * diet, data = feedlot)
Anova(feedlot.lm)
@
The interaction tesrm doesn't make much of a contribution here, so we will work with an additive model instead (which also ameliorates some nonestimability issues due to missing cells).
%<<>>=
feedlot.add < update(feedlot.lm, . ~ .  herd:diet)
@
Here are the "LS~means" for the herds, and a compact letter display for comparisons thereof:
%<<>>=
cld(lsmeans(feedlot.add, "herd"))
@
No herds are found to be differentnot a surprise given that the $P$~value for "herd" is about the same as for the original model.
However, these predictions are made at the same entry weight for every herd. This is \emph{not} the right thing to do here, because the herds differ in genetic makeup, the way they were fed and managed, and so forthwhich affect the yearlings' entry weights. This is an example where a treatment affects a covariate. Each herd should have its own reference value for entry weight. This is done in "lsmeans" by providing a formula in the "cov.reduce" argument. The formula "ewt ~ herd" indicates that the reference grid should be constructed using the predicted value of "ewt", based on a linear model with "herd" as the predictor. Here are the results:
%<<>>=
cld(lsmeans(feedlot.add, "herd", cov.reduce = ewt ~ herd))
@
What a world of difference! We now see many significant differences in the comparisons. By the way, another approach would be to simply omit "ewt" from the model, to prevent making inappropriate adjustments in the traditional analysis. With such a model (not shown), the predictions are similar to those above; however, their standard errors are substantially higher, becauseas seen in the ANOVA tablethe covariate explains a lot of the variation.

\fi %%%%%%%%%%%%% end of commentedout section %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Another use of formulas in \wixcodesub{cov.reduce}{to reflect dependence} is to create representative values of some covariates when others are specified in \wixcode{at}. For example, suppose there are three covariates $x_1,x_2,x_3$ in a model, and we want to see predictions at a few different values of $x_1$. We might use
<>=
rg < ref.grid(my.model, at = list(x1 = c(5,10,15)),
 cov.reduce = list(x2 ~ x1, x3 ~ x1 + x2))
@
(When more than one formula is given, they are processed in the order given.)
The values used for $x_2$ and $x_3$ will depend on $x_1$ and should in some sense be more realistic values of those covariates as $x_1$ varies than would be the overall means of $x_2$ and $x_3$. Of course, it would be important to display the values usedavailable as "rg@grid"when reporting the analysis.





\section{Other types of models}\ix{models supported}
\subsection[Models supported by lsmeans]{Models supported by \lsm{}}
The \lsm{} package comes with builtin support for quite a number of packages and model classes,
including \dqt{lm}, \dqt{mlm}, \dqt{aov}, \dqt{aovlist}, and \dqt{glm} in the \wixpkg{stats} package, mixed models such as \dqt{lme}, \dqt{lmerMod}, and \dqt{glmerMod}, several survival models, GEEtype models, models having responses that are ordinal, multinomial, counts, and interval(0,1), and Bayesian models. For a complete list, use \code{help(\dqt{models})}.

\ifx % COMPLETEish LIST IS NOW COMMENTEDOUT 
\begin{quote}
\begin{description}
\pitem{stats}: \dqt{lm}, \dqt{mlm}, \dqt{aov}, \dqt{aovlist}, \dqt{glm}
\pitem{nlme}: \dqt{lme}, \dqt{gls}, \dqt{nlme}
\pitem{lme4}: \dqt{lmerMod}, \dqt{glmerMod}
\pitem{survival}: \dqt{survreg}, \dqt{coxph}
%%%\pitem{coxme}: \dqt{coxme}
\pitem{MASS}: \dqt{polr}
\pitem{gee, geepack}: \dqt{gee}, \dqt{geeglm}, \dqt{geese}
\pitem{ordinal}: \dqt{clm}, \dqt{clmm}
\pitem{rms}: \dqt{rms} and descendents such as \dqt{ols}, \dqt{lrm}, \dqt{orm}, etc.
\end{description}
\end{quote}
\fi % 

\lsm{} support for all these models works similarly to the examples we have presented. Note that generalized linear or mixed models, and several others such as survival models, typically employ link functions such as "log" or "logit". In most cases, the LS~means displayed are on the scale of the linear predictor, and any averaging over the reference grid is performed on the linearpredictor scale; but there are exceptions. Some objects have optional arguments that can be specified in the "ref.grid" or "lsmeans" call: see "?models" for details.

\subsection{Ordinaldata example}
The "clm" and "clmm" functions in \wixpkg{ordinal}, as well as the "polr" function in \wixpkg{MASS}, fit polytomous regression models to \wix{Likertscale data}. They do this by modeling the ordinal response as a categorization of a continuous latent variable $S$, then estimating thresholds for this categorization and fitting a generalized linear model to the cumulative probabilities for each threshold.
By default, "lsmeans" produces predictions of the \wix{latent variable}.

\index{Example!ordinal response}\index{Examples!housing data}
The example shown here is based on the \wixcode{housing} data in the \pkg{MASS} package, where the response variable is satisfaction ("Sat") on a threepoint scale of low, medium, high; and predictors include "Type" (type of rental unit, four levels), "Infl" (influence on management of the unit, three levels), and "Cont" (contact with other residents, two levels). We will assume that the latent variable is normally distributed (by specifying a probit link).
<>=
library("ordinal")
data(housing, package = "MASS")
housing.clm < clm(Sat ~ (Infl + Type + Cont)^2,
 data = housing, weights = Freq, link = "probit")
lsmip(housing.clm, Cont ~ Infl  Type, layout = c(4,1))
@
\begin{figure}
\begin{center}
\includegraphics[width=6in]{usinglsmeanshousingplot.pdf}
\end{center}
\caption{Interaction plot for the latent variable in the \code{housing} example.}\label{housingplot}
\end{figure}
The plot is shown in \Fig{housingplot}. Generally, the higher the influence, the higher the satisfaction. Overall $F$ tests of the "Infl" effect suggest that it is strong for all four housing types:
<<>>=
test(pairs(lsmeans(housing.clm, ~ Infl  Type)), joint = TRUE)
@
The tests are asymptotic (signaled by "df2 = NA"), so they are actually chisquare tests for the statistics $X^2 = df_1\cdot F$ with $df_1$ degrees of freedom. Higher contact also seems to be associated with higher satisfaction, but terrace apartments may be an exception. Let's see:
<<>>=
test(pairs(lsmeans(housing.clm, ~ Cont  Type)), joint = TRUE)
@
So the effect is inconclusive for both atria and terraces.

The \wixcode{mode} argument may be used to choose what to examine. Modes \dqt{linear.predictor} and \dqt{cum.prob} create an additional pseudofactor named "cut" for the thresholds at which the predictions are made.
<<>>=
ref.grid(housing.clm, mode = "cum.prob")
@
So here are our estimated marginal probabilities for "Infl" of being less than highly satisfied:
<<>>=
lsmeans(housing.clm, ~ Infl, at = list(cut = "MediumHigh"),
 mode = "cum.prob")
@
Compare these results with those for the backtransformed linear predictor:
<<>>=
summary(lsmeans(housing.clm, ~ Infl, at = list(cut = "MediumHigh"),
 mode = "linear.predictor"), type = "response")
@
The results are similar, but somewhat different because of the backtransformation\ix{transformations} coming before (first case) or after (second case) averaging or computing confidence limits.

\subsection{Chick weights, revisited}\index{Examples!chick weights}\index{Examples!nonlinear curves}
Previously, we used the \wixcode{ChickWeight} data to illustrate the use of "lstrends". That example made the simplifying assumption that the growth trends are linear, which is clearly questionable. To do a better job of fitting the data, consider instead the idea of fitting a \wix{logistic curve} to each chick's data. The \pkg{stats} package provides the "SSlogis" function for this purpose: it is an Sshaped curve (scaled from the cdf of a logistic distribution) having three parameters "asym" (the asymptotic value at which it levels off), "xmid" (the $x$ coordinate of its inflection point), and "scal" (roughly the difference between the median and the .73rd quantile). Also, the \wixpkg{nlme} package's \wixcode{nlme} function can fit a set of \wix{nonlinear curves} such that the parameters of those curves may be modeled using a mixedeffects linear model.

Accordingly, let us fit a model where each chick has a logistic curve for which the "asym" parameter varies randomly for each chick, and for which both "asym" and "xmid" depend on the chick's diet. We chose starting values by examining the curves and making a rough judgment of the typical asymptotic value, midpoint, and scale for each diet. We need to keep firmly in mind how factors are coded; so we explicitly show that we intend to use \dqt{contr.treatment} coding, by which the first mean is estimated directly, and the remaining estimates are offsets from that. We need a set of four starting values for "asym" and "xmid", and one for "scal".
<<>>=
require("nlme")
options(contrasts = c("contr.treatment", "contr.poly"))
Chick.nlme = nlme(weight ~ SSlogis(Time, asym, xmid, scal),
 data = ChickWeight,
 fixed = list(asym + xmid ~ Diet, scal ~ 1),
 random = asym ~ 1  Chick,
 start = c(200, 100, 200, 100, 10, 0, 0, 0, 7))
Chick.nlme
@
Now we can use "lsmeans" to compare the parameters based on "Diet":
<<>>=
cld(lsmeans(Chick.nlme, ~ Diet, param = "asym"))
cld(lsmeans(Chick.nlme, ~ Diet, param = "xmid"))
@
The result is that diet~3 has both a higher mean "asym" an a higher mean "xmid" than the other diets. This is compatible with the results of the earlier "lstrends" analysis, but grounded in terms of the parameters of the logistic curve.


\subsection{Extending to more models}\ix{extending the \pkg{lsmeans} package}
The functions "ref.grid" and "lsmeans" work by first reconstructing the dataset (so that the reference grid can be identified) and extracting needed information about the model, such as the regression coefficients, covariance matrix, and the linear functions associated with each point in the reference grid. For a fitted model of class, say, \dqt{modelobj}, these tasks are accomplished by defining S3 methods \wixcode{recover.data}".modelobj" and \wixcode{lsm.basis}".modelobj". The help page \dqt{extendinglsmeans} and the vignette by the same name provide details and examples.

Developers of packages that fit models are encouraged to include support for \lsm{} by incorporating (and exporting) "recover.data" and "lsm.basis" methods for their model classes.

\subsection{Bayesian models}\index{Examples!Bayesian Poisson regression}
Certain \wix{Bayesian models} are now supported by \lsm{}. For illustration, consider a twofactor Poisson regression example given in the \wixpkg{MCMCpack} package:
<<>>=
library("MCMCpack")
counts < c(18, 17, 15, 20, 10, 20, 25, 13, 12)
outcome < gl(3, 1, 9)
treatment < gl(3, 3)
posterior < MCMCpoisson(counts ~ outcome + treatment, mcmc = 1000)
@
The result is an "mcmc" object\index{mcmc@\code{mcmc} object} (defined in the \wixpkg{coda} package), but it has an added \dqt{call} attribute that enables "lsmeans" to do its work. Here are results for treatments, averaged over outcomes:
<<>>=
( post.lsm < lsmeans(posterior, "treatment") )
@
This is a frequentist summary, based on the mean and covariance of the regression parameters in the "posterior" sample. But \lsm{} provides an \wixcode{as.mcmc} method to obtain a sample from the posterior distribution of the LS~means\ix{posterior LS~means} (that is, the original posterior sample of regression coefficients, transformed by the appropriate linear functions.)
<<>>=
library("coda")
summary(as.mcmc(post.lsm))
@
Since "as.mcmc" produces an "mcmc" object, any of the other available methods may be used with it.



\section{Discussion}
The design goal of \lsm{} is primarily to provide the functionality of the "LSMEANS"\index{SAS!LSMEANS} statement in various \SAS{} procedures. Thus its emphasis is on tabular results which, of course, may also be used as data for further analysis or graphics. By design, it can be extended with relative ease to additional model classes.
A unique capability of \lsm{} is its explicit reliance on the concept of a reference grid, which I feel is a useful approach for understanding what is being computed.

Some \lsm{} capabilities exceed those of \SAS, including the "lstrends" capability, more flexibility in organizing the output, and more builtin contrast families. In addition, \SAS{} does not allow LS~means for factor combinations when the model does not include the interaction of those factors; or creating a grid of covariate values using "at".

There are a few other \R{} packages that provide capabilities that overlap with those of \lsm{}. The \wixpkg{effects} package \citep{effects,fox09} can compute LS~means. However, for an unbalanced dataset, it does not use equal \wix{weights}, but rather it appears to use ``outer'' weights, as described in Section~\ref{weights}. Also, it does not check \wix{estimability}, so some results could be questionable.
The emphasis of \pkg{effects} is on graphical rather than tabular displays.
It has special strengths for curvefitting models such as splines. In contrast, \lsm{}'s strengths are more in the area of factorial models where one wants traditional summaries in the form of estimates, contrasts, and interaction plots.

The \wixpkg{doBy} package \citep{doBy} provides an "LSmeans" function that has some of the capabilities of "lsmeans", but it produces a data frame rather than a reusable object. In earlier versions of the package, this function was named "popMeans". The package also has an "LSmatrix" function to obtain the linear functions needed to obtain LS~means. Also, the \wixpkg{lmerTest} package also offers an "lsmeans" function, as well as "difflsmeans" for differences of LS~means. These are designed particularly for "lmerMod" objects.


\bibliography{lsmeans}\bibliographystyle{jss}

\printindex

\end{document}