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](https://creativecommons.org/licenses/by/2.0), via Wikimedia Commons 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:

  1. 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.

  2. 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==