Lab computer users: Log in using the user name and password on the board to your left.
Laptop users:
Everyone:
Rstatistics.R
script in the Rstatistics folder on your desktopIt is often helpful to start your R session by setting your working directory so you don’t have to type the full path names to your data and other files
# set the working directory
# setwd("~/Desktop/Rstatistics")
# setwd("C:/Users/dataclass/Desktop/Rstatistics")
You might also start by listing the files in your working directory
getwd() # where am I?
list.files("dataSets") # files in the dataSets folder
[1] "/home/izahn/Documents/Work/Classes/IQSS_Stats_Workshops/R/Rstatistics"
[1] "Exam.rds" "NatHealth2008MI" "NatHealth2011.rds"
[4] "states.dta" "states.rds"
The states.dta data comes from http://anawida.de/teach/SS14/anawida/4.linReg/data/states.dta.txt and appears to have originally appeared in Statistics with Stata by Lawrence C. Hamilton.
# read the states data
states.data <- readRDS("dataSets/states.rds")
#get labels
states.info <- data.frame(attributes(states.data)[c("names", "var.labels")])
#look at last few labels
tail(states.info, 8)
names var.labels
14 csat Mean composite SAT score
15 vsat Mean verbal SAT score
16 msat Mean math SAT score
17 percent % HS graduates taking SAT
18 expense Per pupil expenditures prim&sec
19 income Median household income, $1,000
20 high % adults HS diploma
21 college % adults college degree
Start by examining the data to check for problems.
# summary of expense and csat columns, all rows
sts.ex.sat <- subset(states.data, select = c("expense", "csat"))
summary(sts.ex.sat)
# correlation between expense and csat
cor(sts.ex.sat)
expense csat
Min. :2960 Min. : 832.0
1st Qu.:4352 1st Qu.: 888.0
Median :5000 Median : 926.0
Mean :5236 Mean : 944.1
3rd Qu.:5794 3rd Qu.: 997.0
Max. :9259 Max. :1093.0
expense csat
expense 1.0000000 -0.4662978
csat -0.4662978 1.0000000
Plot the data to look for multivariate outliers, non-linear relationships etc.
# scatter plot of expense vs csat
plot(sts.ex.sat)
img
lm()
functionlm
to predict SAT scores based on per-pupal expenditures:# Fit our regression model
sat.mod <- lm(csat ~ expense, # regression formula
data=states.data) # data set
# Summarize and print the results
summary(sat.mod) # show regression coefficients table
Call:
lm(formula = csat ~ expense, data = states.data)
Residuals:
Min 1Q Median 3Q Max
-131.811 -38.085 5.607 37.852 136.495
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.061e+03 3.270e+01 32.44 < 2e-16 ***
expense -2.228e-02 6.037e-03 -3.69 0.000563 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 59.81 on 49 degrees of freedom
Multiple R-squared: 0.2174, Adjusted R-squared: 0.2015
F-statistic: 13.61 on 1 and 49 DF, p-value: 0.0005631
Many people find it surprising that the per-capita expenditure on students is negatively related to SAT scores. The beauty of multiple regression is that we can try to pull these apart. What would the association between expense and SAT scores be if there were no difference among the states in the percentage of students taking the SAT?
summary(lm(csat ~ expense + percent, data = states.data))
Call:
lm(formula = csat ~ expense + percent, data = states.data)
Residuals:
Min 1Q Median 3Q Max
-62.921 -24.318 1.741 15.502 75.623
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 989.807403 18.395770 53.806 < 2e-16 ***
expense 0.008604 0.004204 2.046 0.0462 *
percent -2.537700 0.224912 -11.283 4.21e-15 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 31.62 on 48 degrees of freedom
Multiple R-squared: 0.7857, Adjusted R-squared: 0.7768
F-statistic: 88.01 on 2 and 48 DF, p-value: < 2.2e-16
OK, we fit our model. Now what?
class(sat.mod)
names(sat.mod)
methods(class = class(sat.mod))[1:9]
[1] "lm"
[1] "coefficients" "residuals" "effects" "rank"
[5] "fitted.values" "assign" "qr" "df.residual"
[9] "xlevels" "call" "terms" "model"
[1] "add1.lm" "alias.lm"
[3] "anova.lm" "case.names.lm"
[5] "coerce,oldClass,S3-method" "confint.lm"
[7] "cooks.distance.lm" "deviance.lm"
[9] "dfbeta.lm"
confint(sat.mod)
# hist(residuals(sat.mod))
2.5 % 97.5 %
(Intercept) 995.01753164 1126.44735626
expense -0.03440768 -0.01014361
par(mar = c(4, 4, 2, 2), mfrow = c(1, 2)) #optional
plot(sat.mod, which = c(1, 2)) # "which" argument optional
img
Do congressional voting patterns predict SAT scores over and above expense? Fit two models and compare them:
# fit another model, adding house and senate as predictors
sat.voting.mod <- lm(csat ~ expense + house + senate,
data = na.omit(states.data))
sat.mod <- update(sat.mod, data=na.omit(states.data))
# compare using the anova() function
anova(sat.mod, sat.voting.mod)
coef(summary(sat.voting.mod))
Analysis of Variance Table
Model 1: csat ~ expense
Model 2: csat ~ expense + house + senate
Res.Df RSS Df Sum of Sq F Pr(>F)
1 46 169050
2 44 149284 2 19766 2.9128 0.06486 .
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1082.93438041 38.633812740 28.0307405 1.067795e-29
expense -0.01870832 0.009691494 -1.9303852 6.001998e-02
house -1.44243754 0.600478382 -2.4021473 2.058666e-02
senate 0.49817861 0.513561356 0.9700469 3.373256e-01
Use the states.rds data set. Fit a model predicting energy consumed per capita (energy) from the percentage of residents living in metropolitan areas (metro). Be sure to
summary
plot
the model to look for deviations from modeling assumptionsSelect one or more additional predictors to add to your model and repeat steps 1-3. Is this model significantly better than the model with metro as the only predictor?
Interactions allow us assess the extent to which the association between one predictor and the outcome depends on a second predictor. For example: Does the association between expense and SAT scores depend on the median income in the state?
#Add the interaction to the model
sat.expense.by.percent <- lm(csat ~ expense*income,
data=states.data)
#Show the results
coef(summary(sat.expense.by.percent)) # show regression coefficients table
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.380364e+03 1.720863e+02 8.021351 2.367069e-10
expense -6.384067e-02 3.270087e-02 -1.952262 5.687837e-02
income -1.049785e+01 4.991463e+00 -2.103161 4.083253e-02
expense:income 1.384647e-03 8.635529e-04 1.603431 1.155395e-01
Let’s try to predict SAT scores from region, a categorical variable. Note that you must make sure R does not think your categorical variable is numeric.
# make sure R knows region is categorical
str(states.data$region)
states.data$region <- factor(states.data$region)
#Add region to the model
sat.region <- lm(csat ~ region,
data=states.data)
#Show the results
coef(summary(sat.region)) # show regression coefficients table
anova(sat.region) # show ANOVA table
Factor w/ 4 levels "West","N. East",..: 3 1 1 3 1 1 2 3 NA 3 ...
Estimate Std. Error t value Pr(>|t|)
(Intercept) 946.30769 14.79582 63.9577807 1.352577e-46
regionN. East -56.75214 23.13285 -2.4533141 1.800383e-02
regionSouth -16.30769 19.91948 -0.8186806 4.171898e-01
regionMidwest 63.77564 21.35592 2.9863209 4.514152e-03
Analysis of Variance Table
Response: csat
Df Sum Sq Mean Sq F value Pr(>F)
region 3 82049 27349.8 9.6102 4.859e-05 ***
Residuals 46 130912 2845.9
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Again, make sure to tell R which variables are categorical by converting them to factors!
In the previous example we use the default contrasts for region. The default in R is treatment contrasts, with the first level as the reference. We can change the reference group or use another coding scheme using the C
function.
# print default contrasts
contrasts(states.data$region)
# change the reference group
coef(summary(lm(csat ~ C(region, base=4),
data=states.data)))
# change the coding scheme
coef(summary(lm(csat ~ C(region, contr.helmert),
data=states.data)))
N. East South Midwest
West 0 0 0
N. East 1 0 0
South 0 1 0
Midwest 0 0 1
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1010.08333 15.39998 65.589930 4.296307e-47
C(region, base = 4)1 -63.77564 21.35592 -2.986321 4.514152e-03
C(region, base = 4)2 -120.52778 23.52385 -5.123641 5.798399e-06
C(region, base = 4)3 -80.08333 20.37225 -3.931000 2.826007e-04
Estimate Std. Error t value Pr(>|t|)
(Intercept) 943.986645 7.706155 122.4977451 1.689670e-59
C(region, contr.helmert)1 -28.376068 11.566423 -2.4533141 1.800383e-02
C(region, contr.helmert)2 4.022792 5.884552 0.6836191 4.976450e-01
C(region, contr.helmert)3 22.032229 4.446777 4.9546509 1.023364e-05
See also ?contrasts
, ?contr.treatment
, and ?relevel
.
Use the states data set.
Add on to the regression equation that you created in exercise 1 by generating an interaction term and testing the interaction.
Try adding region to the model. Are there significant differences across the four regions?
This far we have used the lm
function to fit our regression models. lm
is great, but limited–in particular it only fits models for continuous dependent variables. For categorical dependent variables we can use the glm()
function.
For these models we will use a different dataset, drawn from the National Health Interview Survey. From the CDC website:
The National Health Interview Survey (NHIS) has monitored the health of the nation since 1957. NHIS data on a broad range of health topics are collected through personal household interviews. For over 50 years, the U.S. Census Bureau has been the data collection agent for the National Health Interview Survey. Survey results have been instrumental in providing data to track health status, health care access, and progress toward achieving national health objectives.
Load the National Health Interview Survey data:
NH11 <- readRDS("dataSets/NatHealth2011.rds")
labs <- attributes(NH11)$labels
Let’s predict the probability of being diagnosed with hypertension based on age, sex, sleep, and bmi
str(NH11$hypev) # check stucture of hypev
levels(NH11$hypev) # check levels of hypev
# collapse all missing values to NA
NH11$hypev <- factor(NH11$hypev, levels=c("2 No", "1 Yes"))
# run our regression model
hyp.out <- glm(hypev~age_p+sex+sleep+bmi,
data=NH11, family="binomial")
coef(summary(hyp.out))
Factor w/ 5 levels "1 Yes","2 No",..: 2 2 1 2 2 1 2 2 1 2 ...
[1] "1 Yes" "2 No" "7 Refused"
[4] "8 Not ascertained" "9 Don't know"
Estimate Std. Error z value Pr(>|z|)
(Intercept) -4.269466028 0.0564947294 -75.572820 0.000000e+00
age_p 0.060699303 0.0008227207 73.778743 0.000000e+00
sex2 Female -0.144025092 0.0267976605 -5.374540 7.677854e-08
sleep -0.007035776 0.0016397197 -4.290841 1.779981e-05
bmi 0.018571704 0.0009510828 19.526906 6.485172e-85
Generalized linear models use link functions, so raw coefficients are difficult to interpret. For example, the age coefficient of .06 in the previous model tells us that for every one unit increase in age, the log odds of hypertension diagnosis increases by 0.06. Since most of us are not used to thinking in log odds this is not too helpful!
One solution is to transform the coefficients to make them easier to interpret
hyp.out.tab <- coef(summary(hyp.out))
hyp.out.tab[, "Estimate"] <- exp(coef(hyp.out))
hyp.out.tab
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.01398925 0.0564947294 -75.572820 0.000000e+00
age_p 1.06257935 0.0008227207 73.778743 0.000000e+00
sex2 Female 0.86586602 0.0267976605 -5.374540 7.677854e-08
sleep 0.99298892 0.0016397197 -4.290841 1.779981e-05
bmi 1.01874523 0.0009510828 19.526906 6.485172e-85
In addition to transforming the log-odds produced by glm
to odds, we can use the predict()
function to make direct statements about the predictors in our model. For example, we can ask “How much more likely is a 63 year old female to have hypertension compared to a 33 year old female?”.
# Create a dataset with predictors set at desired levels
predDat <- with(NH11,
expand.grid(age_p = c(33, 63),
sex = "2 Female",
bmi = mean(bmi, na.rm = TRUE),
sleep = mean(sleep, na.rm = TRUE)))
# predict hypertension at those levels
cbind(predDat, predict(hyp.out, type = "response",
se.fit = TRUE, interval="confidence",
newdata = predDat))
age_p sex bmi sleep fit se.fit residual.scale
1 33 2 Female 29.89565 7.86221 0.1289227 0.002849622 1
2 63 2 Female 29.89565 7.86221 0.4776303 0.004816059 1
This tells us that a 33 year old female has a 13% probability of having been diagnosed with hypertension, while and 63 year old female has a 48% probability of having been diagnosed.
Instead of doing all this ourselves, we can use the effects package to compute quantities of interest for us (cf. the Zelig package).
library(effects)
plot(allEffects(hyp.out))
img
Use the NH11 data set that we loaded earlier.
Note that the data is not perfectly clean and ready to be modeled. You will need to clean up at least some of the variables before fitting the model.
lmer
function for liner mixed models, glmer
for generalized mixed modelslibrary(lme4)
Loading required package: Matrix
The Exam data set contans exam scores of 4,059 students from 65 schools in Inner London. The variable names are as follows:
variable | Description |
---|---|
school | School ID - a factor. |
normexam | Normalized exam score. |
schgend | School gender - a factor. Levels are ‘mixed’, ‘boys’, and ‘girls’. |
schavg | School average of intake score. |
vr | Student level Verbal Reasoning (VR) score band at intake - ‘bottom 25%’, ‘mid 50%’, and ‘top 25%’. |
intake | Band of student’s intake score - a factor. Levels are ‘bottom 25%’, ‘mid 50%’ and ‘top 25%’./ |
standLRT | Standardised LR test score. |
sex | Sex of the student - levels are ‘F’ and ‘M’. |
type | School type - levels are ‘Mxd’ and ‘Sngl’. |
student | Student id (within school) - a factor |
Exam <- readRDS("dataSets/Exam.rds")
As a preliminary step it is often useful to partition the variance in the dependent variable into the various levels. This can be accomplished by running a null model (i.e., a model with a random effects grouping structure, but no fixed-effects predictors).
# null model, grouping by school but not fixed effects.
Norm1 <-lmer(normexam ~ 1 + (1|school),
data=Exam, REML = FALSE)
summary(Norm1)
Linear mixed model fit by maximum likelihood ['lmerMod']
Formula: normexam ~ 1 + (1 | school)
Data: Exam
AIC BIC logLik deviance df.resid
10825.5 10844.4 -5409.8 10819.5 3984
Scaled residuals:
Min 1Q Median 3Q Max
-3.9022 -0.6463 0.0028 0.6981 3.6364
Random effects:
Groups Name Variance Std.Dev.
school (Intercept) 0.1695 0.4117
Residual 0.8482 0.9210
Number of obs: 3987, groups: school, 65
Fixed effects:
Estimate Std. Error t value
(Intercept) -0.01415 0.05378 -0.263
The is .169/(.169 + .848) = .17: 17% of the variance is at the school level.
Predict exam scores from student’s standardized tests scores
Norm2 <-lmer(normexam~standLRT + (1|school),
data=Exam,
REML = FALSE)
summary(Norm2)
Linear mixed model fit by maximum likelihood ['lmerMod']
Formula: normexam ~ standLRT + (1 | school)
Data: Exam
AIC BIC logLik deviance df.resid
9143.4 9168.5 -4567.7 9135.4 3954
Scaled residuals:
Min 1Q Median 3Q Max
-3.7002 -0.6252 0.0238 0.6776 3.2617
Random effects:
Groups Name Variance Std.Dev.
school (Intercept) 0.09193 0.3032
Residual 0.56701 0.7530
Number of obs: 3958, groups: school, 65
Fixed effects:
Estimate Std. Error t value
(Intercept) 0.001211 0.040038 0.03
standLRT 0.565588 0.012647 44.72
Correlation of Fixed Effects:
(Intr)
standLRT 0.007
As with lm
and glm
models, you can compare the two lmer
models using the anova
function.
anova(Norm1, Norm2)
Error in anova.merMod(Norm1, Norm2) :
models were not all fitted to the same size of dataset
Add a random effect of students’ standardized test scores as well. Now in addition to estimating the distribution of intercepts across schools, we also estimate the distribution of the slope of exam on standardized test.
Norm3 <- lmer(normexam~standLRT + (standLRT|school), data=Exam,
REML = FALSE)
summary(Norm3)
Linear mixed model fit by maximum likelihood ['lmerMod']
Formula: normexam ~ standLRT + (standLRT | school)
Data: Exam
AIC BIC logLik deviance df.resid
9108.4 9146.1 -4548.2 9096.4 3952
Scaled residuals:
Min 1Q Median 3Q Max
-3.8129 -0.6336 0.0331 0.6734 3.4521
Random effects:
Groups Name Variance Std.Dev. Corr
school (Intercept) 0.08985 0.2998
standLRT 0.01415 0.1189 0.51
Residual 0.55516 0.7451
Number of obs: 3958, groups: school, 65
Fixed effects:
Estimate Std. Error t value
(Intercept) -0.01224 0.03972 -0.308
standLRT 0.55863 0.01989 28.080
Correlation of Fixed Effects:
(Intr)
standLRT 0.371
To test the significance of a random slope just compare models with and without the random slope term
anova(Norm2, Norm3)
Data: Exam
Models:
Norm2: normexam ~ standLRT + (1 | school)
Norm3: normexam ~ standLRT + (standLRT | school)
Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
Norm2 4 9143.4 9168.5 -4567.7 9135.4
Norm3 6 9108.4 9146.1 -4548.2 9096.4 38.954 2 3.477e-09 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Use the dataset, bh1996: data(bh1996, package="multilevel")
From the data documentation:
Variables are Cohesion (COHES), Leadership Climate (LEAD), Well-Being (WBEING) and Work Hours (HRS). Each of these variables has two variants - a group mean version that replicates each group mean for every individual, and a within-group version where the group mean is subtracted from each individual response. The group mean version is designated with a G. (e.g., G.HRS), and the within-group version is designated with a W. (e.g., W.HRS).
Use the states.rds data set.
states <- readRDS("dataSets/states.rds")
Fit a model predicting energy consumed per capita (energy) from the percentage of residents living in metropolitan areas (metro). Be sure to
states.en.met <- subset(states, select = c("metro", "energy"))
summary(states.en.met)
plot(states.en.met)
cor(states.en.met, use="pairwise")
summary
mod.en.met <- lm(energy ~ metro, data = states)
summary(mod.en.met)
plot
the model to look for deviations from modeling assumptionsplot(mod.en.met)
Select one or more additional predictors to add to your model and repeat steps 1-3. Is this model significantly better than the model with metro as the only predictor?
states.en.met.pop.wst <- subset(states, select = c("energy", "metro", "pop", "waste"))
summary(states.en.met.pop.wst)
plot(states.en.met.pop.wst)
cor(states.en.met.pop.wst, use = "pairwise")
mod.en.met.pop.waste <- lm(energy ~ metro + pop + waste, data = states)
summary(mod.en.met.pop.waste)
anova(mod.en.met, mod.en.met.pop.waste)
Use the states data set.
mod.en.metro.by.waste <- lm(energy ~ metro * waste, data = states)
mod.en.region <- lm(energy ~ metro * waste + region, data = states)
anova(mod.en.region)
Use the NH11 data set that we loaded earlier. Note that the data is not perfectly clean and ready to be modeled. You will need to clean up at least some of the variables before fitting the model.
nh11.wrk.age.mar <- subset(NH11, select = c("everwrk", "age_p", "r_maritl"))
summary(nh11.wrk.age.mar)
NH11 <- transform(NH11,
everwrk = factor(everwrk,
levels = c("1 Yes", "2 No")),
r_maritl = droplevels(r_maritl))
mod.wk.age.mar <- glm(everwrk ~ age_p + r_maritl, data = NH11,
family = "binomial")
summary(mod.wk.age.mar)
library(effects)
data.frame(Effect("r_maritl", mod.wk.age.mar))
Use the dataset, bh1996:
data(bh1996, package="multilevel")
From the data documentation:
Variables are Cohesion (COHES), Leadership Climate (LEAD), Well-Being (WBEING) and Work Hours (HRS). Each of these variables has two variants - a group mean version that replicates each group mean for every individual, and a within-group version where the group mean is subtracted from each individual response. The group mean version is designated with a G. (e.g., G.HRS), and the within-group version is designated with a W. (e.g., W.HRS).
Note that the group identifier is named “GRP”.
library(lme4)
mod.grp0 <- lmer(WBEING ~ 1 + (1 | GRP), data = bh1996)
summary(mod.grp0)
=> library(lme4) > mod.grp0 <- lmer(WBEING ~ 1 + (1 | GRP), data = bh1996) > summary(mod.grp0) Linear mixed model fit by REML [‘lmerMod’] Formula: WBEING ~ 1 + (1 | GRP) Data: bh1996
REML criterion at convergence: 19347
Scaled residuals: Min 1Q Median 3Q Max -3.322 -0.648 0.031 0.718 2.667
Random effects: Groups Name Variance Std.Dev. GRP (Intercept) 0.0358 0.189 Residual 0.7895 0.889 Number of obs: 7382, groups: GRP, 99
Fixed effects: Estimate Std. Error t value (Intercept) 2.7743 0.0222 125 > =2. [@2] Calculate the ICC for your null model ICC = .0358/(.0358 + .7895) = .04
mod.grp1 <- lmer(WBEING ~ HRS + LEAD + (1 | GRP), data = bh1996)
summary(mod.grp1)
mod.grp2 <- lmer(WBEING ~ HRS + LEAD + (1 + HRS | GRP), data = bh1996)
anova(mod.grp1, mod.grp2)
feedback form