Yavno and Fox (2013) collected introduced pumpkinseed sunfish from four sites in Canada, two flowing water sites and two still water sites, and returned them to a holding facility. Progeny from mating between individuals within each population were then allocated to artificial channels and subjected to either still or flowing water for 80 days. Various morphological features for each fish were measured at the end of the experiment. Each morphological measurement was analyzed in a two-factor linear model, including the value of the centroid of nine points on the body as a measure of body size. Each morphological variable and the value of the centroid was log transformed before analysis.

Pumpkinseed sunfish, Lepomis gibbosus. © Smithsonian Environmental Research Center, CC BY 4.0

The paper is here and the data are in the supplementary material S2

Yavno, S. & Fox, M. G. (2013). Morphological change and phenotypic plasticity in native and non-native pumpkinseed sunfish in response to sustained water velocities. Journal of Evolutionary Biology, 26, 2383-95.

Preliminaries

First, load the required packages (car, interactions)

Import yavno data file (yavno.csv)

yavno <- read.csv("../data/yavno.csv")
head(yavno,10)

Check that the covariate is not affected by factors

boxplot(log10(centroid)~pops*watervel, data=yavno)

cov.aov <- aov(log10(centroid)~pops*watervel, data=yavno)
summary(cov.aov)
               Df Sum Sq Mean Sq F value   Pr(>F)    
pops            3 0.4780 0.15932  34.481  < 2e-16 ***
watervel        1 0.0730 0.07301  15.801 9.23e-05 ***
pops:watervel   3 0.0461 0.01538   3.329   0.0202 *  
Residuals     248 1.1459 0.00462                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Covariate affected by both factors and interaction using the anova result, but we’re dealing with quite a sensitive test, give the residual df. Looking at the boxplots, however, the covariate ranges are broadly overlapping, and one group is a bit higher than the rest. It’s not a clear-cut decision, but we’ll do ancova anyway to match original paper.

First bodydep

boxplot(log10(bodydep)~pops*watervel, data=yavno)

scatterplot(log10(bodydep)~log10(centroid)|pops, data=yavno)

scatterplot(log10(bodydep)~log10(centroid)|watervel, data=yavno)

all looks OK

Fit model using lm to get Type III SS

bodydep.lm1 <- lm(log10(bodydep)~pops*watervel*log10(centroid), contrasts=list(pops=contr.sum,watervel=contr.sum), data=yavno)
plot(bodydep.lm1)

Anova(bodydep.lm1, type='III')
Anova Table (Type III tests)

Response: log10(bodydep)
                               Sum Sq  Df   F value    Pr(>F)    
(Intercept)                   0.05549   1  519.7533 < 2.2e-16 ***
pops                          0.00019   3    0.5874 0.6238187    
watervel                      0.00143   1   13.3754 0.0003133 ***
log10(centroid)               0.34148   1 3198.3933 < 2.2e-16 ***
pops:watervel                 0.00023   3    0.7295 0.5353057    
pops:log10(centroid)          0.00017   3    0.5310 0.6614451    
watervel:log10(centroid)      0.00142   1   13.2907 0.0003270 ***
pops:watervel:log10(centroid) 0.00025   3    0.7924 0.4991730    
Residuals                     0.02562 240                        
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Combine covariate by factor terms into a single term

bodydep.lm2 <- lm(log10(bodydep)~pops*watervel+log10(centroid), contrasts=list(pops=contr.sum,watervel=contr.sum), data=yavno)
anova(bodydep.lm1, bodydep.lm2)
Analysis of Variance Table

Model 1: log10(bodydep) ~ pops * watervel * log10(centroid)
Model 2: log10(bodydep) ~ pops * watervel + log10(centroid)
  Res.Df      RSS Df Sum of Sq      F  Pr(>F)  
1    240 0.025624                              
2    247 0.027431 -7 -0.001807 2.4178 0.02074 *
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Anova(bodydep.lm2, type='III')
Anova Table (Type III tests)

Response: log10(bodydep)
                 Sum Sq  Df   F value    Pr(>F)    
(Intercept)     0.06383   1  574.7058 < 2.2e-16 ***
pops            0.00420   3   12.6181 1.058e-07 ***
watervel        0.00008   1    0.7637    0.3830    
log10(centroid) 0.38831   1 3496.4440 < 2.2e-16 ***
pops:watervel   0.00050   3    1.5072    0.2132    
Residuals       0.02743 247                        
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Plot of slopes

We’ll create log10(centroid) as a new variable, rather than transforming it repeatedly in models.

yavno$lcentroid <- log10(yavno$centroid)
bodydep.lm3 <- lm(log10(bodydep)~pops*watervel*lcentroid, data=yavno)
interact_plot(bodydep.lm3, pred=lcentroid, modx=pops, plot.points=TRUE, data=yavno)

interact_plot(bodydep.lm3, pred=lcentroid, modx=watervel, plot.points=TRUE, data=yavno)

Unequal slopes apparent for water velocity groups, but the sample size is large and the difference in slopes isn’t great, so fit homogeneous slopes ancova model anyway

bodydep.lm4 <- lm(log10(bodydep)~pops+watervel+pops*watervel+log10(centroid), contrasts=list(pops=contr.sum,watervel=contr.sum), data=yavno)
Anova(bodydep.lm4, type='III')
Anova Table (Type III tests)

Response: log10(bodydep)
                 Sum Sq  Df   F value    Pr(>F)    
(Intercept)     0.06383   1  574.7058 < 2.2e-16 ***
pops            0.00420   3   12.6181 1.058e-07 ***
watervel        0.00008   1    0.7637    0.3830    
log10(centroid) 0.38831   1 3496.4440 < 2.2e-16 ***
pops:watervel   0.00050   3    1.5072    0.2132    
Residuals       0.02743 247                        
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Get adjusted means

adjmeans <- effect("pops*watervel", bodydep.lm4, se=TRUE)
summary(adjmeans)

 pops*watervel effect
          watervel
pops           Flow    Still
  Otonabee 1.195001 1.191510
  Rice     1.203540 1.205033
  Susqueda 1.198707 1.201057
  Ter      1.200549 1.204955

 Lower 95 Percent Confidence Limits
          watervel
pops           Flow    Still
  Otonabee 1.191188 1.187786
  Rice     1.199925 1.201094
  Susqueda 1.194843 1.197484
  Ter      1.196344 1.201321

 Upper 95 Percent Confidence Limits
          watervel
pops           Flow    Still
  Otonabee 1.198813 1.195233
  Rice     1.207155 1.208971
  Susqueda 1.202571 1.204631
  Ter      1.204754 1.208590
LS0tCnRpdGxlOiAiUUsgQm94IDguMTYiCgpvdXRwdXQ6IAogIGh0bWxfbm90ZWJvb2s6CiAgICB0aGVtZTogZmxhdGx5Ci0tLQoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkKYGBgCgpZYXZubyBhbmQgRm94ICgyMDEzKSBjb2xsZWN0ZWQgaW50cm9kdWNlZCBwdW1wa2luc2VlZCBzdW5maXNoIGZyb20gZm91ciBzaXRlcyBpbiBDYW5hZGEsIHR3byBmbG93aW5nIHdhdGVyIHNpdGVzIGFuZCB0d28gc3RpbGwgd2F0ZXIgc2l0ZXMsIGFuZCByZXR1cm5lZCB0aGVtIHRvIGEgaG9sZGluZyBmYWNpbGl0eS4gUHJvZ2VueSBmcm9tIG1hdGluZyBiZXR3ZWVuIGluZGl2aWR1YWxzIHdpdGhpbiBlYWNoIHBvcHVsYXRpb24gd2VyZSB0aGVuIGFsbG9jYXRlZCB0byBhcnRpZmljaWFsIGNoYW5uZWxzIGFuZCBzdWJqZWN0ZWQgdG8gZWl0aGVyIHN0aWxsIG9yIGZsb3dpbmcgd2F0ZXIgZm9yIDgwIGRheXMuIFZhcmlvdXMgbW9ycGhvbG9naWNhbCBmZWF0dXJlcyBmb3IgZWFjaCBmaXNoIHdlcmUgbWVhc3VyZWQgYXQgdGhlIGVuZCBvZiB0aGUgZXhwZXJpbWVudC4gRWFjaCBtb3JwaG9sb2dpY2FsIG1lYXN1cmVtZW50IHdhcyBhbmFseXplZCBpbiBhIHR3by1mYWN0b3IgbGluZWFyIG1vZGVsLCBpbmNsdWRpbmcgdGhlIHZhbHVlIG9mIHRoZSBjZW50cm9pZCBvZiBuaW5lIHBvaW50cyBvbiB0aGUgYm9keSBhcyBhIG1lYXN1cmUgb2YgYm9keSBzaXplLiBFYWNoIG1vcnBob2xvZ2ljYWwgdmFyaWFibGUgYW5kIHRoZSB2YWx1ZSBvZiB0aGUgY2VudHJvaWQgd2FzIGxvZyB0cmFuc2Zvcm1lZCBiZWZvcmUgYW5hbHlzaXMuCgpbIVtdKC4uL21lZGlhL2xlcG9taXMuanBlZyl7d2lkdGg9IjgwMCJ9XShodHRwczovL3d3dy5mbGlja3IuY29tL3Bob3Rvcy9zZXJjX2Jpb2RpdmVyc2l0eS81MDU5OTM5NjMxNy8pCgpQdW1wa2luc2VlZCBzdW5maXNoLCAqTGVwb21pcyBnaWJib3N1cyouIMKpIFNtaXRoc29uaWFuIEVudmlyb25tZW50YWwgUmVzZWFyY2ggQ2VudGVyLCBbQ0MgQlkgNC4wXShodHRwczovL2NyZWF0aXZlY29tbW9ucy5vcmcvbGljZW5zZXMvYnkvNC4wKQoKVGhlIHBhcGVyIGlzIFtoZXJlXShodHRwczovL2RvaS5vcmcvMTAuMTExMS9qLjEzNjUtMjY5OS4yMDEyLjAyNzU4LngpIGFuZCB0aGUgZGF0YSBhcmUgaW4gdGhlIHN1cHBsZW1lbnRhcnkgbWF0ZXJpYWwgUzIKCllhdm5vLCBTLiAmIEZveCwgTS4gRy4gKDIwMTMpLiBNb3JwaG9sb2dpY2FsIGNoYW5nZSBhbmQgcGhlbm90eXBpYyBwbGFzdGljaXR5IGluIG5hdGl2ZSBhbmQgbm9uLW5hdGl2ZSBwdW1wa2luc2VlZCBzdW5maXNoIGluIHJlc3BvbnNlIHRvIHN1c3RhaW5lZCB3YXRlciB2ZWxvY2l0aWVzLiAqSm91cm5hbCBvZiBFdm9sdXRpb25hcnkgQmlvbG9neSosIDI2LCAyMzgzLTk1LgoKIyMjIFByZWxpbWluYXJpZXMKCkZpcnN0LCBsb2FkIHRoZSByZXF1aXJlZCBwYWNrYWdlcyAoY2FyLCBpbnRlcmFjdGlvbnMpCgpgYGB7ciBpbmNsdWRlPUZBTFNFLCByZXN1bHRzPSdoaWRlJywgZXJyb3I9VFJVRX0Kc291cmNlKCIuLi9SL2xpYnJhcmllcy5SIikgICAjVGhpcyBpcyB0aGUgY29tbW9uIGxpYnJhcnkKbGlicmFyeShpbnRlcmFjdGlvbnMpCmxpYnJhcnkoZWZmZWN0cykKYGBgCgpJbXBvcnQgeWF2bm8gZGF0YSBmaWxlICh5YXZuby5jc3YpCgpgYGB7cn0KeWF2bm8gPC0gcmVhZC5jc3YoIi4uL2RhdGEveWF2bm8uY3N2IikKaGVhZCh5YXZubywxMCkKYGBgCgpDaGVjayB0aGF0IHRoZSBjb3ZhcmlhdGUgaXMgbm90IGFmZmVjdGVkIGJ5IGZhY3RvcnMKCmBgYHtyIH0KYm94cGxvdChsb2cxMChjZW50cm9pZCl+cG9wcyp3YXRlcnZlbCwgZGF0YT15YXZubykKY292LmFvdiA8LSBhb3YobG9nMTAoY2VudHJvaWQpfnBvcHMqd2F0ZXJ2ZWwsIGRhdGE9eWF2bm8pCnN1bW1hcnkoY292LmFvdikKYGBgCgpDb3ZhcmlhdGUgYWZmZWN0ZWQgYnkgYm90aCBmYWN0b3JzIGFuZCBpbnRlcmFjdGlvbiB1c2luZyB0aGUgYW5vdmEgcmVzdWx0LCBidXQgd2UncmUgZGVhbGluZyB3aXRoIHF1aXRlIGEgc2Vuc2l0aXZlIHRlc3QsIGdpdmUgdGhlIHJlc2lkdWFsIGRmLiBMb29raW5nIGF0IHRoZSBib3hwbG90cywgaG93ZXZlciwgdGhlIGNvdmFyaWF0ZSByYW5nZXMgYXJlIGJyb2FkbHkgb3ZlcmxhcHBpbmcsIGFuZCBvbmUgZ3JvdXAgaXMgYSBiaXQgaGlnaGVyIHRoYW4gdGhlIHJlc3QuIEl0J3Mgbm90IGEgY2xlYXItY3V0IGRlY2lzaW9uLCBidXQgd2UnbGwgZG8gYW5jb3ZhIGFueXdheSB0byBtYXRjaCBvcmlnaW5hbCBwYXBlci4KCiMjIEZpcnN0IGJvZHlkZXAKCmBgYHtyIH0KYm94cGxvdChsb2cxMChib2R5ZGVwKX5wb3BzKndhdGVydmVsLCBkYXRhPXlhdm5vKQpzY2F0dGVycGxvdChsb2cxMChib2R5ZGVwKX5sb2cxMChjZW50cm9pZCl8cG9wcywgZGF0YT15YXZubykKc2NhdHRlcnBsb3QobG9nMTAoYm9keWRlcCl+bG9nMTAoY2VudHJvaWQpfHdhdGVydmVsLCBkYXRhPXlhdm5vKQpgYGAKCmFsbCBsb29rcyBPSwoKIyMjIEZpdCBtb2RlbCB1c2luZyBsbSB0byBnZXQgVHlwZSBJSUkgU1MKCmBgYHtyIH0KYm9keWRlcC5sbTEgPC0gbG0obG9nMTAoYm9keWRlcCl+cG9wcyp3YXRlcnZlbCpsb2cxMChjZW50cm9pZCksIGNvbnRyYXN0cz1saXN0KHBvcHM9Y29udHIuc3VtLHdhdGVydmVsPWNvbnRyLnN1bSksIGRhdGE9eWF2bm8pCnBsb3QoYm9keWRlcC5sbTEpCkFub3ZhKGJvZHlkZXAubG0xLCB0eXBlPSdJSUknKQpgYGAKCkNvbWJpbmUgY292YXJpYXRlIGJ5IGZhY3RvciB0ZXJtcyBpbnRvIGEgc2luZ2xlIHRlcm0KCmBgYHtyIH0KYm9keWRlcC5sbTIgPC0gbG0obG9nMTAoYm9keWRlcCl+cG9wcyp3YXRlcnZlbCtsb2cxMChjZW50cm9pZCksIGNvbnRyYXN0cz1saXN0KHBvcHM9Y29udHIuc3VtLHdhdGVydmVsPWNvbnRyLnN1bSksIGRhdGE9eWF2bm8pCmFub3ZhKGJvZHlkZXAubG0xLCBib2R5ZGVwLmxtMikKCkFub3ZhKGJvZHlkZXAubG0yLCB0eXBlPSdJSUknKQpgYGAKCiMjIyBQbG90IG9mIHNsb3BlcwoKV2UnbGwgY3JlYXRlIGxvZzEwKGNlbnRyb2lkKSBhcyBhIG5ldyB2YXJpYWJsZSwgcmF0aGVyIHRoYW4gdHJhbnNmb3JtaW5nIGl0IHJlcGVhdGVkbHkgaW4gbW9kZWxzLgoKYGBge3IgfQp5YXZubyRsY2VudHJvaWQgPC0gbG9nMTAoeWF2bm8kY2VudHJvaWQpCmJvZHlkZXAubG0zIDwtIGxtKGxvZzEwKGJvZHlkZXApfnBvcHMqd2F0ZXJ2ZWwqbGNlbnRyb2lkLCBkYXRhPXlhdm5vKQppbnRlcmFjdF9wbG90KGJvZHlkZXAubG0zLCBwcmVkPWxjZW50cm9pZCwgbW9keD1wb3BzLCBwbG90LnBvaW50cz1UUlVFLCBkYXRhPXlhdm5vKQppbnRlcmFjdF9wbG90KGJvZHlkZXAubG0zLCBwcmVkPWxjZW50cm9pZCwgbW9keD13YXRlcnZlbCwgcGxvdC5wb2ludHM9VFJVRSwgZGF0YT15YXZubykKYGBgCgpVbmVxdWFsIHNsb3BlcyBhcHBhcmVudCBmb3Igd2F0ZXIgdmVsb2NpdHkgZ3JvdXBzLCBidXQgdGhlIHNhbXBsZSBzaXplIGlzIGxhcmdlIGFuZCB0aGUgZGlmZmVyZW5jZSBpbiBzbG9wZXMgaXNuJ3QgZ3JlYXQsIHNvIGZpdCBob21vZ2VuZW91cyBzbG9wZXMgYW5jb3ZhIG1vZGVsIGFueXdheQoKYGBge3IgfQpib2R5ZGVwLmxtNCA8LSBsbShsb2cxMChib2R5ZGVwKX5wb3BzK3dhdGVydmVsK3BvcHMqd2F0ZXJ2ZWwrbG9nMTAoY2VudHJvaWQpLCBjb250cmFzdHM9bGlzdChwb3BzPWNvbnRyLnN1bSx3YXRlcnZlbD1jb250ci5zdW0pLCBkYXRhPXlhdm5vKQpBbm92YShib2R5ZGVwLmxtNCwgdHlwZT0nSUlJJykKYGBgCgojIyMgR2V0IGFkanVzdGVkIG1lYW5zCgpgYGB7ciB9CmFkam1lYW5zIDwtIGVmZmVjdCgicG9wcyp3YXRlcnZlbCIsIGJvZHlkZXAubG00LCBzZT1UUlVFKQpzdW1tYXJ5KGFkam1lYW5zKQpgYGAK