5.2.3: Nested Model in R
- Page ID
- 33641
\( \newcommand{\vecs}[1]{\overset { \scriptstyle \rightharpoonup} {\mathbf{#1}} } \)
\( \newcommand{\vecd}[1]{\overset{-\!-\!\rightharpoonup}{\vphantom{a}\smash {#1}}} \)
\( \newcommand{\id}{\mathrm{id}}\) \( \newcommand{\Span}{\mathrm{span}}\)
( \newcommand{\kernel}{\mathrm{null}\,}\) \( \newcommand{\range}{\mathrm{range}\,}\)
\( \newcommand{\RealPart}{\mathrm{Re}}\) \( \newcommand{\ImaginaryPart}{\mathrm{Im}}\)
\( \newcommand{\Argument}{\mathrm{Arg}}\) \( \newcommand{\norm}[1]{\| #1 \|}\)
\( \newcommand{\inner}[2]{\langle #1, #2 \rangle}\)
\( \newcommand{\Span}{\mathrm{span}}\)
\( \newcommand{\id}{\mathrm{id}}\)
\( \newcommand{\Span}{\mathrm{span}}\)
\( \newcommand{\kernel}{\mathrm{null}\,}\)
\( \newcommand{\range}{\mathrm{range}\,}\)
\( \newcommand{\RealPart}{\mathrm{Re}}\)
\( \newcommand{\ImaginaryPart}{\mathrm{Im}}\)
\( \newcommand{\Argument}{\mathrm{Arg}}\)
\( \newcommand{\norm}[1]{\| #1 \|}\)
\( \newcommand{\inner}[2]{\langle #1, #2 \rangle}\)
\( \newcommand{\Span}{\mathrm{span}}\) \( \newcommand{\AA}{\unicode[.8,0]{x212B}}\)
\( \newcommand{\vectorA}[1]{\vec{#1}} % arrow\)
\( \newcommand{\vectorAt}[1]{\vec{\text{#1}}} % arrow\)
\( \newcommand{\vectorB}[1]{\overset { \scriptstyle \rightharpoonup} {\mathbf{#1}} } \)
\( \newcommand{\vectorC}[1]{\textbf{#1}} \)
\( \newcommand{\vectorD}[1]{\overrightarrow{#1}} \)
\( \newcommand{\vectorDt}[1]{\overrightarrow{\text{#1}}} \)
\( \newcommand{\vectE}[1]{\overset{-\!-\!\rightharpoonup}{\vphantom{a}\smash{\mathbf {#1}}}} \)
\( \newcommand{\vecs}[1]{\overset { \scriptstyle \rightharpoonup} {\mathbf{#1}} } \)
\( \newcommand{\vecd}[1]{\overset{-\!-\!\rightharpoonup}{\vphantom{a}\smash {#1}}} \)
\(\newcommand{\avec}{\mathbf a}\) \(\newcommand{\bvec}{\mathbf b}\) \(\newcommand{\cvec}{\mathbf c}\) \(\newcommand{\dvec}{\mathbf d}\) \(\newcommand{\dtil}{\widetilde{\mathbf d}}\) \(\newcommand{\evec}{\mathbf e}\) \(\newcommand{\fvec}{\mathbf f}\) \(\newcommand{\nvec}{\mathbf n}\) \(\newcommand{\pvec}{\mathbf p}\) \(\newcommand{\qvec}{\mathbf q}\) \(\newcommand{\svec}{\mathbf s}\) \(\newcommand{\tvec}{\mathbf t}\) \(\newcommand{\uvec}{\mathbf u}\) \(\newcommand{\vvec}{\mathbf v}\) \(\newcommand{\wvec}{\mathbf w}\) \(\newcommand{\xvec}{\mathbf x}\) \(\newcommand{\yvec}{\mathbf y}\) \(\newcommand{\zvec}{\mathbf z}\) \(\newcommand{\rvec}{\mathbf r}\) \(\newcommand{\mvec}{\mathbf m}\) \(\newcommand{\zerovec}{\mathbf 0}\) \(\newcommand{\onevec}{\mathbf 1}\) \(\newcommand{\real}{\mathbb R}\) \(\newcommand{\twovec}[2]{\left[\begin{array}{r}#1 \\ #2 \end{array}\right]}\) \(\newcommand{\ctwovec}[2]{\left[\begin{array}{c}#1 \\ #2 \end{array}\right]}\) \(\newcommand{\threevec}[3]{\left[\begin{array}{r}#1 \\ #2 \\ #3 \end{array}\right]}\) \(\newcommand{\cthreevec}[3]{\left[\begin{array}{c}#1 \\ #2 \\ #3 \end{array}\right]}\) \(\newcommand{\fourvec}[4]{\left[\begin{array}{r}#1 \\ #2 \\ #3 \\ #4 \end{array}\right]}\) \(\newcommand{\cfourvec}[4]{\left[\begin{array}{c}#1 \\ #2 \\ #3 \\ #4 \end{array}\right]}\) \(\newcommand{\fivevec}[5]{\left[\begin{array}{r}#1 \\ #2 \\ #3 \\ #4 \\ #5 \\ \end{array}\right]}\) \(\newcommand{\cfivevec}[5]{\left[\begin{array}{c}#1 \\ #2 \\ #3 \\ #4 \\ #5 \\ \end{array}\right]}\) \(\newcommand{\mattwo}[4]{\left[\begin{array}{rr}#1 \amp #2 \\ #3 \amp #4 \\ \end{array}\right]}\) \(\newcommand{\laspan}[1]{\text{Span}\{#1\}}\) \(\newcommand{\bcal}{\cal B}\) \(\newcommand{\ccal}{\cal C}\) \(\newcommand{\scal}{\cal S}\) \(\newcommand{\wcal}{\cal W}\) \(\newcommand{\ecal}{\cal E}\) \(\newcommand{\coords}[2]{\left\{#1\right\}_{#2}}\) \(\newcommand{\gray}[1]{\color{gray}{#1}}\) \(\newcommand{\lgray}[1]{\color{lightgray}{#1}}\) \(\newcommand{\rank}{\operatorname{rank}}\) \(\newcommand{\row}{\text{Row}}\) \(\newcommand{\col}{\text{Col}}\) \(\renewcommand{\row}{\text{Row}}\) \(\newcommand{\nul}{\text{Nul}}\) \(\newcommand{\var}{\text{Var}}\) \(\newcommand{\corr}{\text{corr}}\) \(\newcommand{\len}[1]{\left|#1\right|}\) \(\newcommand{\bbar}{\overline{\bvec}}\) \(\newcommand{\bhat}{\widehat{\bvec}}\) \(\newcommand{\bperp}{\bvec^\perp}\) \(\newcommand{\xhat}{\widehat{\xvec}}\) \(\newcommand{\vhat}{\widehat{\vvec}}\) \(\newcommand{\uhat}{\widehat{\uvec}}\) \(\newcommand{\what}{\widehat{\wvec}}\) \(\newcommand{\Sighat}{\widehat{\Sigma}}\) \(\newcommand{\lt}{<}\) \(\newcommand{\gt}{>}\) \(\newcommand{\amp}{&}\) \(\definecolor{fillinmathshade}{gray}{0.9}\)- Load the Exercise Hours data.
- Obtain the ANOVA table for the nested treatment design.
- Obtain estimators and CIs for means for each region and city.
- Obtain means plot for region and city within the region.
- Obtain Tukey’s multiple comparisons CIs.
1. Load the Exercise Hours data by using the following commands:
setwd("~/path-to-folder/")
ex_hours_data <- read.table("ex_hours_data.txt",header=T)
attach(ex_hours_data)
2. Obtain the ANOVA table for the nested treatment design by using the following commands:
nested<-aov(Ex_hours ~ Region+Region/City,data=ex_hours_data)
summary(nested)
# Df Sum Sq Mean Sq F value Pr(>F)
# Region 2 424.7 212.33 65.33 8.46e-05 ***
# Region:City 3 496.8 165.58 50.95 0.000116 ***
# Residuals 6 19.5 3.25
# ---
# Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
3. Obtain estimators and CIs for means for each region and city by using the following commands:
library(lsmeans) lsmeans(nested,"Region") # Region lsmean SE df lower.CL upper.CL # MW 15.2 0.901 6 13.04 17.5 # NE 25.8 0.901 6 23.54 28.0 # W 11.8 0.901 6 9.54 14.0 #Results are averaged over the levels of: City #Confidence level used: 0.95 lsmeans(nested,"City") #City Region lsmean SE df lower.CL upper.CL # Chicago MW 9.5 1.27 6 6.38 12.62 # Detroit MW 21.0 1.27 6 17.88 24.12 # NY NE 32.5 1.27 6 29.38 35.62 # Pittsburgh NE 19.0 1.27 6 15.88 22.12 # LA W 18.5 1.27 6 15.38 21.62 # Seattle W 5.0 1.27 6 1.88 8.12 #Confidence level used: 0.95
4. Obtain means plot for region and city within region by using the following commands:
library(plotrix) region_means<-as.data.frame(lsmeans(nested,"Region")) plotCI(x = region_means$lsmean,y = NULL ,li = region_means$lower.CL, ui = region_means$upper.CL, xaxt = "n", xlab="Region",ylab="ExHours") axis(1, at=1:3, labels=region_means$Region)
city_means<-as.data.frame(lsmeans(nested,"City")) City_Region<-paste(city_means$City,city_means$Region) plotCI(x = city_means$lsmean,y = NULL ,li = city_means$lower.CL, ui = city_means$upper.CL, xaxt = "n", xlab="City(Region)",ylab="ExHours") axis(1, at=1:6, labels=City_Region)
5. Obtain Tukey’s multiple comparisons CIs by using the following commands:
library(multcomp)
library(multcompView)
tukey_multiple_comparisons_region<-TukeyHSD(nested,"Region",conf.level=0.95,ordered=TRUE)
tukey_multiple_comparisons_region
Tukey multiple comparisons of means
95% family-wise confidence level
factor levels have been ordered
Fit: aov(formula = Ex_hours ~ Region + Region/City, data = ex_hours_data)
# $Region
# diff lwr upr p adj
#MW-W 3.5 -0.4112978 7.411298 0.0747598
#NE-W 14.0 10.0887022 17.911298 0.0000836
plot(tukey_multiple_comparisons_region)
tukey_multiple_comparisons_city<-TukeyHSD(nested,"Region:City",conf.level=0.95,ordered=TRUE)
cities<-as.data.frame(na.omit(tukey_multiple_comparisons_city$"Region:City"))
cities
# diff lwr upr p adj
# MW:Chicago-W:Seattle 4.5 -4.96579743 13.965797 0.5867601138
# W:LA-W:Seattle 13.5 4.03420257 22.965797 0.0087623039
# NE:Pittsburgh-W:Seattle 14.0 4.53420257 23.465797 0.0072411812
# MW:Detroit-W:Seattle 16.0 6.53420257 25.465797 0.0035459602
# NE:NY-W:Seattle 27.5 18.03420257 36.965797 0.0001761692
# W:LA-MW:Chicago 9.0 -0.46579743 18.465797 0.0626471065
# NE:Pittsburgh-MW:Chicago 9.5 0.03420257 18.965797 0.0491884424
# MW:Detroit-MW:Chicago 11.5 2.03420257 20.965797 0.0198221594
# NE:NY-MW:Chicago 23.0 13.53420257 32.465797 0.0004610102
# NE:Pittsburgh-W:LA 0.5 -8.96579743 9.965797 1.0000000000
# MW:Detroit-W:LA 2.5 -6.96579743 11.965797 0.9752059356
# NE:NY-W:LA 14.0 4.53420257 23.465797 0.0072411812
# MW:Detroit-NE:Pittsburgh 2.0 -7.46579743 11.465797 0.9960158169
# NE:NY-NE:Pittsburgh 13.5 4.03420257 22.965797 0.0087623039
# NE:NY-MW:Detroit 11.5 2.03420257 20.965797 0.0198221594
library(plotrix)
city_diff<-as.character(c("
MW:Chicago-W:Seattle","W:LA-W:Seattle", "NE:Pittsburgh-W:Seattle","MW:Detroit-W:Seattle","NE:NY-W:Seattle ","W:LA-MW:Chicago ","NE:Pittsburgh-MW:Chicago","MW:Detroit-MW:Chicago","NE:NY-MW:Chicago ","NE:Pittsburgh-W:LA ","MW:Detroit-W:LA","NE:NY-W:LA ", "MW:Detroit-NE:Pittsburgh", "NE:NY-NE:Pittsburgh","NE:NY-MW:Detroit"))
par(mar=c(8, 4, 2, 2) + 0.1)
plotCI(x = cities$diff,y = NULL ,li = cities$lwr, ui = cities$upr, xaxt = "
n",ylab="Differences of Means",xlab="")
abline(h=0)
axis(1, at=1:15, labels=city_diff,las = 2, cex.axis = 0.8)
