Ercit et al. (2014) focused on whether egg number influenced jump
distance of female crickets, taking into account differences in body
size (pronotum length) and leg strength (leg mass). They initially
fitted a model that included all three predictors plus interaction
terms. However, the sample size (n=29) is relatively small for a model
to include 7 parameters plus the intercept so we will focus just on the
main effects of the three predictors.
Black-horned_Tree_Cricket (Oecanthus nigricornis). Andrew C, CC BY 2.0, via
Wikimedia Commons
The paper is here
Ercit, K., Martinez-Novoa, A. & Gwynne, D. T. (2014). Egg load
decreases mobility and increases predation risk in female black-horned
tree crickets (Oecanthus nigricornis). PLoS One, 9,
e110298.
Preliminaries
First, load the required packages (car, lm.beta)
Import ercit data file (ercit.csv)
ercit <- read.csv("../data/ercit.csv")
head(ercit,10)
Run diagnostics
Do scatterplotMatrix for all variables
scatterplotMatrix(~distance+eggs+pronotum+legmass, data=ercit, regLine=FALSE, diagonal=list(method='boxplot'))
All variables look symmetrically distributed, no obvious outliers,
relationships between distance and each predictor show no signs of
non-linearity.
Now check for collinearity among predictors - correlations and
scatterplots and VIFs
cor(ercit[,c('eggs','pronotum','legmass')])
eggs pronotum legmass
eggs 1.000 0.185 0.153
pronotum 0.185 1.000 0.575
legmass 0.153 0.575 1.000
vif(lm(distance~ eggs+pronotum+legmass, data=ercit))
eggs pronotum legmass
1.04 1.52 1.50
Some collinearity between pronotum length and egg mass but r < 0.7
and no VIFs >5 so proceed (will do re-analysis later)
Fit model with 3 predictors
ercit.lm <- lm(distance~ eggs+pronotum+legmass, data=ercit)
This command fits this model:
\[
\operatorname{distance} = \alpha + \beta_{1}(\operatorname{eggs}) +
\beta_{2}(\operatorname{pronotum}) + \beta_{3}(\operatorname{legmass}) +
\epsilon
\]
Examine regression diagnostics (residual plot and Cooks D)
plot(ercit.lm)
augment(ercit.lm)
Residual plot OK, no unusually large Cook D values
Display results of model fitting
We’re comfortable with the diagnostics, so we can now assess the
parameters:
\[
\operatorname{\widehat{distance}} = -19.06 - 0.11(\operatorname{eggs}) +
18.12(\operatorname{pronotum}) + 0.38(\operatorname{legmass})
\]
options(digits = 3)
tidy(ercit.lm, conf.int = TRUE)
glance(ercit.lm)
Get standarised regression coefficients
Use lm.beta function from lm.beta package
lm.beta.ercit <- lm.beta(ercit.lm)
tidy(lm.beta.ercit, conf.int = TRUE)
glance(lm.beta.ercit)
Show the partial regression (added-variable) plots
avPlots(ercit.lm, ask=F)
Illustrate model comparison approach
There is also an issue with collinearity between pronotum and leg
mass. While the collinearity measure does not exceed our threshold, we
might also be interested in models with only one of this pair. We’ll
drop leg mass and then omit pronotum.
# Omit legg mass from model
ercit1.lm <- lm(distance~ eggs+pronotum, data=ercit)
tidy(ercit1.lm, conf.int = TRUE)
lm.beta.ercit1 <- lm.beta(ercit1.lm)
tidy(lm.beta.ercit1, conf.int = TRUE)
# Omit pronotum from model
ercit2.lm <- lm(distance~ eggs+legmass, data=ercit)
tidy(ercit2.lm, conf.int = TRUE)
lm.beta.ercit2 <- lm.beta(ercit2.lm)
tidy(lm.beta.ercit2, conf.int = TRUE)
Illustration of partial regression coefficient for egg number (Box
8.5)
We need two steps:
Variation in egg number that is independent of pronotum and
legmass. To get this, we fit a linear model where egg number is the
response and pronotum and legmass the predictors. We want the residuals
from this regression.
Fit a regression model linking jump distance to the residuals
from step 1. The slope of this regression is the partial regression
coefficient
ercit_egg<-lm(eggs~pronotum+legmass,data=ercit)
model1<-lm(ercit$distance~ercit_egg$residuals)
tidy(model1)
Illustration of model comparison approach (Box 8.6)
First test overall H0 that all regression coefficients
equal zero, then test H0s about individual regression
coefficients (egg number for example)
#Overall test
ercit.lm <- lm(distance~ eggs+pronotum+legmass, data=ercit)
ercit1.lm <- lm(distance~1, data= ercit)
anova(ercit.lm, ercit1.lm)
Analysis of Variance Table
Model 1: distance ~ eggs + pronotum + legmass
Model 2: distance ~ 1
Res.Df RSS Df Sum of Sq F Pr(>F)
1 25 324
2 28 736 -3 -413 10.6 0.00011 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#Now drop egg number from model
ercit2.lm <- lm(distance~pronotum+legmass, data= ercit)
#Compare the two models
anova(ercit.lm, ercit2.lm)
Analysis of Variance Table
Model 1: distance ~ eggs + pronotum + legmass
Model 2: distance ~ pronotum + legmass
Res.Df RSS Df Sum of Sq F Pr(>F)
1 25 324
2 26 666 -1 -342 26.4 2.6e-05 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
LS0tCnRpdGxlOiAiUUsgQm94IDguMSIKCm91dHB1dDogCiAgaHRtbF9ub3RlYm9vazoKICAgIHRoZW1lOiBmbGF0bHkKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFKQpgYGAKCkVyY2l0IGV0IGFsLiAoMjAxNCkgZm9jdXNlZCBvbiB3aGV0aGVyIGVnZyBudW1iZXIgaW5mbHVlbmNlZCBqdW1wIGRpc3RhbmNlIG9mIGZlbWFsZSBjcmlja2V0cywgdGFraW5nIGludG8gYWNjb3VudCBkaWZmZXJlbmNlcyBpbiBib2R5IHNpemUgKHByb25vdHVtIGxlbmd0aCkgYW5kIGxlZyBzdHJlbmd0aCAobGVnIG1hc3MpLiBUaGV5IGluaXRpYWxseSBmaXR0ZWQgYSBtb2RlbCB0aGF0IGluY2x1ZGVkIGFsbCB0aHJlZSBwcmVkaWN0b3JzIHBsdXMgaW50ZXJhY3Rpb24gdGVybXMuIEhvd2V2ZXIsIHRoZSBzYW1wbGUgc2l6ZSAobj0yOSkgaXMgcmVsYXRpdmVseSBzbWFsbCBmb3IgYSBtb2RlbCB0byBpbmNsdWRlIDcgcGFyYW1ldGVycyBwbHVzIHRoZSBpbnRlcmNlcHQgc28gd2Ugd2lsbCBmb2N1cyBqdXN0IG9uIHRoZSBtYWluIGVmZmVjdHMgb2YgdGhlIHRocmVlIHByZWRpY3RvcnMuCgpbIVtCbGFjay1ob3JuZWRfVHJlZV9Dcmlja2V0XF8oT2VjYW50aHVzX25pZ3JpY29ybmlzKS4gQW5kcmV3IEMsIFtDQyBCWSAyLjBdKGh0dHBzOi8vY3JlYXRpdmVjb21tb25zLm9yZy9saWNlbnNlcy9ieS8yLjApLCB2aWEgV2lraW1lZGlhIENvbW1vbnNdKC4uL21lZGlhL0JsYWNrLWhvcm5lZF9UcmVlX0NyaWNrZXRfKE9lY2FudGh1c19uaWdyaWNvcm5pcylfKDE1MTcwODg3MzYyKS5qcGcpXShodHRwczovL3VwbG9hZC53aWtpbWVkaWEub3JnL3dpa2lwZWRpYS9jb21tb25zLzMvMzIvQmxhY2staG9ybmVkX1RyZWVfQ3JpY2tldF8lMjhPZWNhbnRodXNfbmlncmljb3JuaXMlMjlfJTI4MTUxNzA4ODczNjIlMjkuanBnKSBCbGFjay1ob3JuZWRfVHJlZV9Dcmlja2V0ICgqT2VjYW50aHVzIG5pZ3JpY29ybmlzKikuIEFuZHJldyBDLCBbQ0MgQlkgMi4wXShodHRwczovL2NyZWF0aXZlY29tbW9ucy5vcmcvbGljZW5zZXMvYnkvMi4wKSwgdmlhIFdpa2ltZWRpYSBDb21tb25zCgpUaGUgcGFwZXIgaXMgW2hlcmVdKGh0dHBzOi8vZG9pLm9yZy8xMC4xMzcxL2pvdXJuYWwucG9uZS4wMTEwMjk4KQoKRXJjaXQsIEsuLCBNYXJ0aW5lei1Ob3ZvYSwgQS4gJiBHd3lubmUsIEQuIFQuICgyMDE0KS4gRWdnIGxvYWQgZGVjcmVhc2VzIG1vYmlsaXR5IGFuZCBpbmNyZWFzZXMgcHJlZGF0aW9uIHJpc2sgaW4gZmVtYWxlIGJsYWNrLWhvcm5lZCB0cmVlIGNyaWNrZXRzICgqT2VjYW50aHVzIG5pZ3JpY29ybmlzKikuICpQTG9TIE9uZSosIDksIGUxMTAyOTguCgojIyMgUHJlbGltaW5hcmllcwoKRmlyc3QsIGxvYWQgdGhlIHJlcXVpcmVkIHBhY2thZ2VzIChjYXIsIGxtLmJldGEpCgpgYGB7ciBpbmNsdWRlPUZBTFNFLCByZXN1bHRzPSdoaWRlJ30Kc291cmNlKCIuLi9SL2xpYnJhcmllcy5SIikgICAjVGhpcyBpcyB0aGUgY29tbW9uIGxpYnJhcnkKbGlicmFyeShsbS5iZXRhKQpgYGAKCkltcG9ydCBlcmNpdCBkYXRhIGZpbGUgKGVyY2l0LmNzdikKCmBgYHtyfQplcmNpdCA8LSByZWFkLmNzdigiLi4vZGF0YS9lcmNpdC5jc3YiKQpoZWFkKGVyY2l0LDEwKQpgYGAKCiMjIFJ1biBkaWFnbm9zdGljcwoKRG8gc2NhdHRlcnBsb3RNYXRyaXggZm9yIGFsbCB2YXJpYWJsZXMKCmBgYHtyIH0Kc2NhdHRlcnBsb3RNYXRyaXgofmRpc3RhbmNlK2VnZ3MrcHJvbm90dW0rbGVnbWFzcywgZGF0YT1lcmNpdCwgcmVnTGluZT1GQUxTRSwgZGlhZ29uYWw9bGlzdChtZXRob2Q9J2JveHBsb3QnKSkKYGBgCgpBbGwgdmFyaWFibGVzIGxvb2sgc3ltbWV0cmljYWxseSBkaXN0cmlidXRlZCwgbm8gb2J2aW91cyBvdXRsaWVycywgcmVsYXRpb25zaGlwcyBiZXR3ZWVuIGRpc3RhbmNlIGFuZCBlYWNoIHByZWRpY3RvciBzaG93IG5vIHNpZ25zIG9mIG5vbi1saW5lYXJpdHkuCgpOb3cgY2hlY2sgZm9yIGNvbGxpbmVhcml0eSBhbW9uZyBwcmVkaWN0b3JzIC0gY29ycmVsYXRpb25zIGFuZCBzY2F0dGVycGxvdHMgYW5kIFZJRnMKCmBgYHtyIH0KY29yKGVyY2l0WyxjKCdlZ2dzJywncHJvbm90dW0nLCdsZWdtYXNzJyldKQp2aWYobG0oZGlzdGFuY2V+IGVnZ3MrcHJvbm90dW0rbGVnbWFzcywgZGF0YT1lcmNpdCkpCmBgYAoKU29tZSBjb2xsaW5lYXJpdHkgYmV0d2VlbiBwcm9ub3R1bSBsZW5ndGggYW5kIGVnZyBtYXNzIGJ1dCByIFw8IDAuNyBhbmQgbm8gVklGcyBcPjUgc28gcHJvY2VlZCAod2lsbCBkbyByZS1hbmFseXNpcyBsYXRlcikKCiMjIyBGaXQgbW9kZWwgd2l0aCAzIHByZWRpY3RvcnMKCmBgYHtyIH0KZXJjaXQubG0gPC0gbG0oZGlzdGFuY2V+IGVnZ3MrcHJvbm90dW0rbGVnbWFzcywgZGF0YT1lcmNpdCkKYGBgCgpUaGlzIGNvbW1hbmQgZml0cyB0aGlzIG1vZGVsOgoKYGBge3IgZWNobz1GQUxTRSwgcmVzdWx0cz0nYXNpcyd9CmVxdWF0aW9tYXRpYzo6ZXh0cmFjdF9lcShlcmNpdC5sbSkKYGBgCgpFeGFtaW5lIHJlZ3Jlc3Npb24gZGlhZ25vc3RpY3MgKHJlc2lkdWFsIHBsb3QgYW5kIENvb2tzIEQpCgpgYGB7ciB9CnBsb3QoZXJjaXQubG0pCmF1Z21lbnQoZXJjaXQubG0pCmBgYAoKUmVzaWR1YWwgcGxvdCBPSywgbm8gdW51c3VhbGx5IGxhcmdlIENvb2sgRCB2YWx1ZXMKCiMjIERpc3BsYXkgcmVzdWx0cyBvZiBtb2RlbCBmaXR0aW5nCgpXZSdyZSBjb21mb3J0YWJsZSB3aXRoIHRoZSBkaWFnbm9zdGljcywgc28gd2UgY2FuIG5vdyBhc3Nlc3MgdGhlIHBhcmFtZXRlcnM6CgpgYGB7ciBlY2hvPUZBTFNFLCByZXN1bHRzPSdhc2lzJ30KZXF1YXRpb21hdGljOjpleHRyYWN0X2VxKGVyY2l0LmxtLCB1c2VfY29lZnMgPSBUUlVFKQpgYGAKCmBgYHtyIH0Kb3B0aW9ucyhkaWdpdHMgPSAzKQp0aWR5KGVyY2l0LmxtLCBjb25mLmludCA9IFRSVUUpCmdsYW5jZShlcmNpdC5sbSkKYGBgCgojIyMgR2V0IHN0YW5kYXJpc2VkIHJlZ3Jlc3Npb24gY29lZmZpY2llbnRzCgpVc2UgbG0uYmV0YSBmdW5jdGlvbiBmcm9tIGxtLmJldGEgcGFja2FnZQoKYGBge3IgfQpsbS5iZXRhLmVyY2l0IDwtIGxtLmJldGEoZXJjaXQubG0pCnRpZHkobG0uYmV0YS5lcmNpdCwgY29uZi5pbnQgPSBUUlVFKQpnbGFuY2UobG0uYmV0YS5lcmNpdCkKYGBgCgojIyMgU2hvdyB0aGUgcGFydGlhbCByZWdyZXNzaW9uIChhZGRlZC12YXJpYWJsZSkgcGxvdHMKCmBgYHtyIH0KYXZQbG90cyhlcmNpdC5sbSwgYXNrPUYpCmBgYAoKIyMgSWxsdXN0cmF0ZSBtb2RlbCBjb21wYXJpc29uIGFwcHJvYWNoCgpUaGVyZSBpcyBhbHNvIGFuIGlzc3VlIHdpdGggY29sbGluZWFyaXR5IGJldHdlZW4gcHJvbm90dW0gYW5kIGxlZyBtYXNzLiBXaGlsZSB0aGUgY29sbGluZWFyaXR5IG1lYXN1cmUgZG9lcyBub3QgZXhjZWVkIG91ciB0aHJlc2hvbGQsIHdlIG1pZ2h0IGFsc28gYmUgaW50ZXJlc3RlZCBpbiBtb2RlbHMgd2l0aCBvbmx5IG9uZSBvZiB0aGlzIHBhaXIuIFdlJ2xsIGRyb3AgbGVnIG1hc3MgYW5kIHRoZW4gb21pdCBwcm9ub3R1bS4KCmBgYHtyIH0KIyBPbWl0IGxlZ2cgbWFzcyBmcm9tIG1vZGVsCmVyY2l0MS5sbSA8LSBsbShkaXN0YW5jZX4gZWdncytwcm9ub3R1bSwgZGF0YT1lcmNpdCkKdGlkeShlcmNpdDEubG0sIGNvbmYuaW50ID0gVFJVRSkKbG0uYmV0YS5lcmNpdDEgPC0gbG0uYmV0YShlcmNpdDEubG0pCnRpZHkobG0uYmV0YS5lcmNpdDEsIGNvbmYuaW50ID0gVFJVRSkKIyBPbWl0IHByb25vdHVtIGZyb20gbW9kZWwKZXJjaXQyLmxtIDwtIGxtKGRpc3RhbmNlfiBlZ2dzK2xlZ21hc3MsIGRhdGE9ZXJjaXQpCnRpZHkoZXJjaXQyLmxtLCBjb25mLmludCA9IFRSVUUpCmxtLmJldGEuZXJjaXQyIDwtIGxtLmJldGEoZXJjaXQyLmxtKQp0aWR5KGxtLmJldGEuZXJjaXQyLCBjb25mLmludCA9IFRSVUUpCmBgYAoKIyMjIElsbHVzdHJhdGlvbiBvZiBwYXJ0aWFsIHJlZ3Jlc3Npb24gY29lZmZpY2llbnQgZm9yIGVnZyBudW1iZXIgKEJveCA4LjUpCgpXZSBuZWVkIHR3byBzdGVwczoKCjEuICBWYXJpYXRpb24gaW4gZWdnIG51bWJlciB0aGF0IGlzIGluZGVwZW5kZW50IG9mIHByb25vdHVtIGFuZCBsZWdtYXNzLiBUbyBnZXQgdGhpcywgd2UgZml0IGEgbGluZWFyIG1vZGVsIHdoZXJlIGVnZyBudW1iZXIgaXMgdGhlIHJlc3BvbnNlIGFuZCBwcm9ub3R1bSBhbmQgbGVnbWFzcyB0aGUgcHJlZGljdG9ycy4gV2Ugd2FudCB0aGUgcmVzaWR1YWxzIGZyb20gdGhpcyByZWdyZXNzaW9uLgoKMi4gIEZpdCBhIHJlZ3Jlc3Npb24gbW9kZWwgbGlua2luZyBqdW1wIGRpc3RhbmNlIHRvIHRoZSByZXNpZHVhbHMgZnJvbSBzdGVwIDEuIFRoZSBzbG9wZSBvZiB0aGlzIHJlZ3Jlc3Npb24gaXMgdGhlIHBhcnRpYWwgcmVncmVzc2lvbiBjb2VmZmljaWVudAoKYGBge3J9CmVyY2l0X2VnZzwtbG0oZWdnc35wcm9ub3R1bStsZWdtYXNzLGRhdGE9ZXJjaXQpCm1vZGVsMTwtbG0oZXJjaXQkZGlzdGFuY2V+ZXJjaXRfZWdnJHJlc2lkdWFscykKdGlkeShtb2RlbDEpCmBgYAoKIyMjIElsbHVzdHJhdGlvbiBvZiBtb2RlbCBjb21wYXJpc29uIGFwcHJvYWNoIChCb3ggOC42KQoKRmlyc3QgdGVzdCBvdmVyYWxsIEh+MH4gdGhhdCBhbGwgcmVncmVzc2lvbiBjb2VmZmljaWVudHMgZXF1YWwgemVybywgdGhlbiB0ZXN0IEh+MH5zIGFib3V0IGluZGl2aWR1YWwgcmVncmVzc2lvbiBjb2VmZmljaWVudHMgKGVnZyBudW1iZXIgZm9yIGV4YW1wbGUpCgpgYGB7ciB9CiNPdmVyYWxsIHRlc3QKZXJjaXQubG0gPC0gbG0oZGlzdGFuY2V+IGVnZ3MrcHJvbm90dW0rbGVnbWFzcywgZGF0YT1lcmNpdCkKZXJjaXQxLmxtIDwtIGxtKGRpc3RhbmNlfjEsIGRhdGE9IGVyY2l0KQphbm92YShlcmNpdC5sbSwgZXJjaXQxLmxtKQojTm93IGRyb3AgZWdnIG51bWJlciBmcm9tIG1vZGVsCmVyY2l0Mi5sbSA8LSBsbShkaXN0YW5jZX5wcm9ub3R1bStsZWdtYXNzLCBkYXRhPSBlcmNpdCkKI0NvbXBhcmUgdGhlIHR3byBtb2RlbHMKYW5vdmEoZXJjaXQubG0sIGVyY2l0Mi5sbSkKYGBgCg==