Stokes et al. (2014) studied the neurotoxin tetrodotoxin (TTX) in flatworms. The between-plots factor was flatworm species (fixed with two groups: Bipalium adventitium and Bipalium kewense) with individual flatworms (plots) nested within species. The within-plots factor was body segment (fixed with three groups: head, anterior body, posterior body) and each segment represented a “sub-plot”. The response variable was the TTX concentration of tissue adjusted for weight. The main research questions were about the fixed effects of species, body segment and their interaction on TTX concentration, but the analyses also provide information about the variances associated with the random effects of individual within species and the random interaction between individuals within species and body segment.

Bipalium advenitium. Yale Peabody Museum, , via Wikimedia Commons

Bipalium kewense. Don Loarie , via Wikimedia Commons

The data are here

Stokes, A. N., Ducey, P. K., Neuman-Lee, L., Hanifin, C. T., French, S. S., Pfrender, M. E., Brodie, E. D., 3rd & Brodie, E. D., Jr. (2014). Confirmation and distribution of tetrodotoxin for the first time in terrestrial invertebrates: two terrestrial flatworm species (Bipalium adventitium and Bipalium kewense). PLoS One, 9, e100718.

Preliminaries

First, load the required packages (afex, car, lattice, lme4, lmerTest, nlme, VCA, ez, emmeans) and, for convenience, apaTables

Import stokes data file (stokes.csv)

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

Set contrasts from afex make individual a factor, make sure species a factor too put segments into sensible order

set_sum_contrasts()
stokes$indiv <- factor(stokes$indiv)
stokes$species<-factor(stokes$species)
stokes$segment <- factor(stokes$segment, levels=c("h","b","p"))

Check residuals by leaving out error term

stokes1.aov <- aov(ttxweight~species*segment, stokes)
plot(stokes1.aov)

Wedge-shaped with mean-variance relationship - redo after log transform

stokes$lttxweight <- log10(stokes$ttxweight)
stokes2.aov <- aov(lttxweight~species*segment, stokes)
plot(stokes2.aov)

Fit full model with log(ttxweight)

stokes3.aov <- aov(lttxweight~species*segment+Error(indiv), stokes)
summary(stokes3.aov)

Error: indiv
          Df Sum Sq Mean Sq F value Pr(>F)  
species    1  0.809   0.809    6.17  0.032 *
Residuals 10  1.311   0.131                 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Error: Within
                Df Sum Sq Mean Sq F value  Pr(>F)    
segment          2  17.15    8.57    47.0 2.8e-08 ***
species:segment  2   0.07    0.04     0.2    0.82    
Residuals       20   3.65    0.18                    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Use ez for comparison with type 3 SS - same result as design is balanced

ezstokes <- ezANOVA(data=stokes, dv=lttxweight, wid=indiv, within=segment, between=species, type=3)
print(ezstokes)
$ANOVA
           Effect DFn DFd       F         p p<.05     ges
2         species   1  10  6.1699 3.232e-02     * 0.14013
3         segment   2  20 46.9649 2.779e-08     * 0.77558
4 species:segment   2  20  0.2022 8.186e-01       0.01466

$`Mauchly's Test for Sphericity`
           Effect      W      p p<.05
3         segment 0.7193 0.2271      
4 species:segment 0.7193 0.2271      

$`Sphericity Corrections`
           Effect    GGe     p[GG] p[GG]<.05    HFe     p[HF] p[HF]<.05
3         segment 0.7808 6.941e-07         * 0.8994 1.215e-07         *
4 species:segment 0.7808 7.655e-01           0.8994 7.963e-01          

Get var components using OLS

Note that these estimates treat B(A)*C as the residual for B(A) vc

stokes.vca <- anovaMM(lttxweight~species/(indiv)+segment+species*segment, NegVC=TRUE, stokes)
stokes.vca


ANOVA-Type Estimation of Mixed Model:
--------------------------------------

    [Fixed Effects]

                         int          speciesBadventitium              speciesBkewense                     segmentb                     segmenth                     segmentp 
                    -0.38541                      0.32619                      0.00000                      0.27268                      1.66743                      0.00000 
speciesBadventitium:segmentb     speciesBkewense:segmentb speciesBadventitium:segmenth     speciesBkewense:segmenth speciesBadventitium:segmentp     speciesBkewense:segmentp 
                     0.06889                      0.00000                     -0.14820                      0.00000                      0.00000                      0.00000 


    [Variance Components]

  Name          DF        SS       MS       VC       %Total     SD       CV[%]     
1 total         29.367096                   0.165407 100        0.406702 98.914014 
2 species:indiv 10        1.310664 0.131066 -0.01717 -10.380622 0        0         
3 error         20        3.651543 0.182577 0.182577 110.380622 0.42729  103.921222

Mean: 0.4112 (N = 36) 

Experimental Design: balanced  |  Method: ANOVA
VCAinference(stokes.vca, alpha=0.05, ci.method="satterthwaite")



Inference from Mixed Model Fit
------------------------------

> VCA Result:
-------------

    [Fixed Effects]

                         int          speciesBadventitium              speciesBkewense                     segmentb                     segmenth                     segmentp 
                     -0.3854                       0.3262                       0.0000                       0.2727                       1.6674                       0.0000 
speciesBadventitium:segmentb     speciesBkewense:segmentb speciesBadventitium:segmenth     speciesBkewense:segmenth speciesBadventitium:segmentp     speciesBkewense:segmentp 
                      0.0689                       0.0000                      -0.1482                       0.0000                       0.0000                       0.0000 


    [Variance Components]

  Name          DF      SS     MS     VC      %Total   SD     CV[%]   
1 total         29.3671               0.1654  100      0.4067 98.914  
2 species:indiv 10      1.3107 0.1311 -0.0172 -10.3806 0      0       
3 error         20      3.6515 0.1826 0.1826  110.3806 0.4273 103.9212

Mean: 0.4112 (N = 36) 

Experimental Design: balanced  |  Method: ANOVA


> VC:
-----
              Estimate     DF CI LCL CI UCL One-Sided LCL One-Sided UCL
total           0.1654 29.367 0.1052 0.2976        0.1130        0.2699
species:indiv  -0.0172  0.784                                          
error           0.1826 20.000 0.1069 0.3807        0.1163        0.3365

> SD:
-----
              Estimate     DF CI LCL CI UCL One-Sided LCL One-Sided UCL
total           0.4067 29.367 0.3243 0.5456        0.3361        0.5195
species:indiv   0.0000  0.784                                          
error           0.4273 20.000 0.3269 0.6170        0.3410        0.5801

> CV[%]:
--------
              Estimate     DF CI LCL CI UCL One-Sided LCL One-Sided UCL
total            98.91 29.367  78.88  132.7         81.74         126.4
species:indiv     0.00  0.784                                          
error           103.92 20.000  79.51  150.1         82.92         141.1


95% Confidence Level  |  CIs for negative VCs excluded  
Satterthwaite methodology used for computing CIs 

Fit mixed effects models with lmer

stokes.lmer <- lmer(lttxweight~species+segment+species*segment+(1|indiv), REML=TRUE, stokes)
boundary (singular) fit: see help('isSingular')

Check residuals from lmer plot

plot(stokes.lmer)

summary(stokes.lmer, ddf="Kenward-Roger")
Linear mixed model fit by REML. t-tests use Kenward-Roger's method ['lmerModLmerTest']
Formula: lttxweight ~ species + segment + species * segment + (1 | indiv)
   Data: stokes

REML criterion at convergence: 50.5

Scaled residuals: 
    Min      1Q  Median      3Q     Max 
-2.8114 -0.3996  0.0869  0.7268  1.7277 

Random effects:
 Groups   Name        Variance Std.Dev.
 indiv    (Intercept) 0.000    0.000   
 Residual             0.165    0.407   
Number of obs: 36, groups:  indiv, 12

Fixed effects:
                  Estimate Std. Error      df t value Pr(>|t|)    
(Intercept)         0.4112     0.0678 10.0000    6.07  0.00012 ***
species1            0.1499     0.0678 10.0000    2.21  0.05146 .  
segment1            0.9598     0.0959 20.0000   10.01  3.1e-09 ***
segment2           -0.3264     0.0959 20.0000   -3.40  0.00281 ** 
species1:segment1  -0.0609     0.0959 20.0000   -0.64  0.53257    
species1:segment2   0.0477     0.0959 20.0000    0.50  0.62447    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Correlation of Fixed Effects:
            (Intr) specs1 sgmnt1 sgmnt2 spc1:1
species1     0.000                            
segment1     0.000  0.000                     
segment2     0.000  0.000 -0.500              
spcs1:sgmn1  0.000  0.000  0.000  0.000       
spcs1:sgmn2  0.000  0.000  0.000  0.000 -0.500
optimizer (nloptwrap) convergence code: 0 (OK)
boundary (singular) fit: see help('isSingular')
anova(stokes.lmer, ddf="Kenward-Roger")
Type III Analysis of Variance Table with Kenward-Roger's method
                Sum Sq Mean Sq NumDF DenDF F value  Pr(>F)    
species           0.81    0.81     1    10    4.89   0.051 .  
segment          17.15    8.57     2    20   51.84 1.2e-08 ***
species:segment   0.07    0.04     2    20    0.22   0.802    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Contrast head vs anterior and anterior vs posterior segments

stokes.emm <- emmeans(stokes.lmer, ~segment)
NOTE: Results may be misleading due to involvement in interactions
stokes.con <- contrast(stokes.emm, "consec")
summary(stokes.con, adjust="none")
 contrast estimate    SE df t.ratio p.value
 b - h      -1.286 0.166 20  -7.747  <.0001
 p - b      -0.307 0.166 20  -1.850  0.0792

Results are averaged over the levels of: species 
Degrees-of-freedom method: kenward-roger 

Get variance components with CIs

stokes.ci <- confint.merMod(stokes.lmer)
Computing profile confidence intervals ...
Warning: Last two rows have identical or NA .zeta values: using minstepWarning: non-monotonic profile for .sig01Warning: bad spline fit for .sig01: falling back to linear interpolationWarning: collapsing to unique 'x' values
stokes.vc <- (stokes.ci)^2
print(stokes.vc)
                      2.5 %  97.5 %
.sig01            0.0000000 0.04990
.sigma            0.0897578 0.22736
(Intercept)       0.0821288 0.28703
species1          0.0006396 0.07533
segment1          0.6141143 1.29058
segment2          0.2525582 0.02255
species1:segment1 0.0562032 0.01330
species1:segment2 0.0165198 0.05011
LS0tCnRpdGxlOiAiUUsgQm94IDExLjEiCm91dHB1dDoKICBodG1sX25vdGVib29rCi0tLQoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkKYGBgCgpTdG9rZXMgZXQgYWwuICgyMDE0KSBzdHVkaWVkIHRoZSBuZXVyb3RveGluIHRldHJvZG90b3hpbiAoVFRYKSBpbiBmbGF0d29ybXMuIFRoZSBiZXR3ZWVuLXBsb3RzIGZhY3RvciB3YXMgZmxhdHdvcm0gc3BlY2llcyAoZml4ZWQgd2l0aCB0d28gZ3JvdXBzOiAqQmlwYWxpdW0gYWR2ZW50aXRpdW0qIGFuZCAqQmlwYWxpdW0ga2V3ZW5zZSopIHdpdGggaW5kaXZpZHVhbCBmbGF0d29ybXMgKHBsb3RzKSBuZXN0ZWQgd2l0aGluIHNwZWNpZXMuIFRoZSB3aXRoaW4tcGxvdHMgZmFjdG9yIHdhcyBib2R5IHNlZ21lbnQgKGZpeGVkIHdpdGggdGhyZWUgZ3JvdXBzOiBoZWFkLCBhbnRlcmlvciBib2R5LCBwb3N0ZXJpb3IgYm9keSkgYW5kIGVhY2ggc2VnbWVudCByZXByZXNlbnRlZCBhICJzdWItcGxvdCIuIFRoZSByZXNwb25zZSB2YXJpYWJsZSB3YXMgdGhlIFRUWCBjb25jZW50cmF0aW9uIG9mIHRpc3N1ZSBhZGp1c3RlZCBmb3Igd2VpZ2h0LiBUaGUgbWFpbiByZXNlYXJjaCBxdWVzdGlvbnMgd2VyZSBhYm91dCB0aGUgZml4ZWQgZWZmZWN0cyBvZiBzcGVjaWVzLCBib2R5IHNlZ21lbnQgYW5kIHRoZWlyIGludGVyYWN0aW9uIG9uIFRUWCBjb25jZW50cmF0aW9uLCBidXQgdGhlIGFuYWx5c2VzIGFsc28gcHJvdmlkZSBpbmZvcm1hdGlvbiBhYm91dCB0aGUgdmFyaWFuY2VzIGFzc29jaWF0ZWQgd2l0aCB0aGUgcmFuZG9tIGVmZmVjdHMgb2YgaW5kaXZpZHVhbCB3aXRoaW4gc3BlY2llcyBhbmQgdGhlIHJhbmRvbSBpbnRlcmFjdGlvbiBiZXR3ZWVuIGluZGl2aWR1YWxzIHdpdGhpbiBzcGVjaWVzIGFuZCBib2R5IHNlZ21lbnQuCgpbIVtdKC4uL21lZGlhL0JpcGFsaXVtX2FkdmVudGl0aXVtXyhZUE1fSVpfMDQ2OTE2KV8wMS5qcGVnKV0oaHR0cHM6Ly9jb21tb25zLndpa2ltZWRpYS5vcmcvd2lraS9GaWxlOkJpcGFsaXVtX2FkdmVudGl0aXVtXyhZUE1fSVpfMDQ2OTE2KV8wMS5qcGVnKQoKKkJpcGFsaXVtIGFkdmVuaXRpdW0qLiBZYWxlIFBlYWJvZHkgTXVzZXVtLCAhW10oLi4vbWVkaWEvY2MtemVyby5wbmcpe3dpZHRoPSI1NyJ9LCB2aWEgV2lraW1lZGlhIENvbW1vbnMKClshW10oLi4vbWVkaWEvQmlwYWxpdW1fa2V3ZW5zZV9LYXVhaS5qcGcpXShodHRwczovL2NvbW1vbnMud2lraW1lZGlhLm9yZy93aWtpL0ZpbGU6QmlwYWxpdW1fa2V3ZW5zZV9LYXVhaS5qcGcpCgoqQmlwYWxpdW0ga2V3ZW5zZSouIERvbiBMb2FyaWUgWyFbXSguLi9tZWRpYS9ieS5wbmcpe3dpZHRoPSI1NyJ9XShodHRwczovL2NyZWF0aXZlY29tbW9ucy5vcmcvbGljZW5zZXMvYnkvNC4wKSwgdmlhIFdpa2ltZWRpYSBDb21tb25zCgpUaGUgZGF0YSBhcmUgW2hlcmVdKGh0dHBzOi8vZG9pLm9yZy8xMC4xMzcxL2pvdXJuYWwucG9uZS4wMTAwNzE4KQoKU3Rva2VzLCBBLiBOLiwgRHVjZXksIFAuIEsuLCBOZXVtYW4tTGVlLCBMLiwgSGFuaWZpbiwgQy4gVC4sIEZyZW5jaCwgUy4gUy4sIFBmcmVuZGVyLCBNLiBFLiwgQnJvZGllLCBFLiBELiwgM3JkICYgQnJvZGllLCBFLiBELiwgSnIuICgyMDE0KS4gQ29uZmlybWF0aW9uIGFuZCBkaXN0cmlidXRpb24gb2YgdGV0cm9kb3RveGluIGZvciB0aGUgZmlyc3QgdGltZSBpbiB0ZXJyZXN0cmlhbCBpbnZlcnRlYnJhdGVzOiB0d28gdGVycmVzdHJpYWwgZmxhdHdvcm0gc3BlY2llcyAoKkJpcGFsaXVtIGFkdmVudGl0aXVtKiBhbmQgKkJpcGFsaXVtIGtld2Vuc2UqKS4gKlBMb1MgT25lKiwgOSwgZTEwMDcxOC4KCiMjIyBQcmVsaW1pbmFyaWVzCgpGaXJzdCwgbG9hZCB0aGUgcmVxdWlyZWQgcGFja2FnZXMgKGFmZXgsIGNhciwgbGF0dGljZSwgbG1lNCwgbG1lclRlc3QsIG5sbWUsIFZDQSwgZXosIGVtbWVhbnMpIGFuZCwgZm9yIGNvbnZlbmllbmNlLCBhcGFUYWJsZXMKCmBgYHtyIGluY2x1ZGU9RkFMU0UsIHJlc3VsdHM9J2hpZGUnfQpzb3VyY2UoIi4uL1IvbGlicmFyaWVzLlIiKSAgICNUaGlzIGlzIHRoZSBjb21tb24gbGlicmFyeQpgYGAKCkltcG9ydCBzdG9rZXMgZGF0YSBmaWxlIChbc3Rva2VzLmNzdl0oLi4vZGF0YS9zdG9rZXMuY3N2KSkKCmBgYHtyfQpzdG9rZXMgPC0gcmVhZC5jc3YoIi4uL2RhdGEvc3Rva2VzLmNzdiIpCmhlYWQoc3Rva2VzLDEwKQpgYGAKClNldCBjb250cmFzdHMgZnJvbSBhZmV4IG1ha2UgaW5kaXZpZHVhbCBhIGZhY3RvciwgbWFrZSBzdXJlIHNwZWNpZXMgYSBmYWN0b3IgdG9vIHB1dCBzZWdtZW50cyBpbnRvIHNlbnNpYmxlIG9yZGVyCgpgYGB7ciByZXN1bHRzPSdoaWRlJ30Kc2V0X3N1bV9jb250cmFzdHMoKQpzdG9rZXMkaW5kaXYgPC0gZmFjdG9yKHN0b2tlcyRpbmRpdikKc3Rva2VzJHNwZWNpZXM8LWZhY3RvcihzdG9rZXMkc3BlY2llcykKc3Rva2VzJHNlZ21lbnQgPC0gZmFjdG9yKHN0b2tlcyRzZWdtZW50LCBsZXZlbHM9YygiaCIsImIiLCJwIikpCmBgYAoKQ2hlY2sgcmVzaWR1YWxzIGJ5IGxlYXZpbmcgb3V0IGVycm9yIHRlcm0KCmBgYHtyIH0Kc3Rva2VzMS5hb3YgPC0gYW92KHR0eHdlaWdodH5zcGVjaWVzKnNlZ21lbnQsIHN0b2tlcykKcGxvdChzdG9rZXMxLmFvdikKYGBgCgpXZWRnZS1zaGFwZWQgd2l0aCBtZWFuLXZhcmlhbmNlIHJlbGF0aW9uc2hpcCAtIHJlZG8gYWZ0ZXIgbG9nIHRyYW5zZm9ybQoKYGBge3IgfQpzdG9rZXMkbHR0eHdlaWdodCA8LSBsb2cxMChzdG9rZXMkdHR4d2VpZ2h0KQpzdG9rZXMyLmFvdiA8LSBhb3YobHR0eHdlaWdodH5zcGVjaWVzKnNlZ21lbnQsIHN0b2tlcykKcGxvdChzdG9rZXMyLmFvdikKYGBgCgojIyBGaXQgZnVsbCBtb2RlbCB3aXRoIGxvZyh0dHh3ZWlnaHQpCgpgYGB7ciB9CnN0b2tlczMuYW92IDwtIGFvdihsdHR4d2VpZ2h0fnNwZWNpZXMqc2VnbWVudCtFcnJvcihpbmRpdiksIHN0b2tlcykKc3VtbWFyeShzdG9rZXMzLmFvdikKYGBgCgpVc2UgZXogZm9yIGNvbXBhcmlzb24gd2l0aCB0eXBlIDMgU1MgLSBzYW1lIHJlc3VsdCBhcyBkZXNpZ24gaXMgYmFsYW5jZWQKCmBgYHtyIH0KZXpzdG9rZXMgPC0gZXpBTk9WQShkYXRhPXN0b2tlcywgZHY9bHR0eHdlaWdodCwgd2lkPWluZGl2LCB3aXRoaW49c2VnbWVudCwgYmV0d2Vlbj1zcGVjaWVzLCB0eXBlPTMpCnByaW50KGV6c3Rva2VzKQpgYGAKCiMjIyBHZXQgdmFyIGNvbXBvbmVudHMgdXNpbmcgT0xTCgoqKk5vdGUqKiB0aGF0IHRoZXNlIGVzdGltYXRlcyB0cmVhdCBCKEEpXCpDIGFzIHRoZSByZXNpZHVhbCBmb3IgQihBKSB2YwoKYGBge3IgfQpzdG9rZXMudmNhIDwtIGFub3ZhTU0obHR0eHdlaWdodH5zcGVjaWVzLyhpbmRpdikrc2VnbWVudCtzcGVjaWVzKnNlZ21lbnQsIE5lZ1ZDPVRSVUUsIHN0b2tlcykKc3Rva2VzLnZjYQpWQ0FpbmZlcmVuY2Uoc3Rva2VzLnZjYSwgYWxwaGE9MC4wNSwgY2kubWV0aG9kPSJzYXR0ZXJ0aHdhaXRlIikKYGBgCgojIyBGaXQgbWl4ZWQgZWZmZWN0cyBtb2RlbHMgd2l0aCBsbWVyCgpgYGB7ciB9CnN0b2tlcy5sbWVyIDwtIGxtZXIobHR0eHdlaWdodH5zcGVjaWVzK3NlZ21lbnQrc3BlY2llcypzZWdtZW50KygxfGluZGl2KSwgUkVNTD1UUlVFLCBzdG9rZXMpCmBgYAoKQ2hlY2sgcmVzaWR1YWxzIGZyb20gbG1lciBwbG90CgpgYGB7ciB9CnBsb3Qoc3Rva2VzLmxtZXIpCnN1bW1hcnkoc3Rva2VzLmxtZXIsIGRkZj0iS2Vud2FyZC1Sb2dlciIpCmFub3ZhKHN0b2tlcy5sbWVyLCBkZGY9IktlbndhcmQtUm9nZXIiKQpgYGAKCiMjIyBDb250cmFzdCBoZWFkIHZzIGFudGVyaW9yIGFuZCBhbnRlcmlvciB2cyBwb3N0ZXJpb3Igc2VnbWVudHMKCmBgYHtyIH0Kc3Rva2VzLmVtbSA8LSBlbW1lYW5zKHN0b2tlcy5sbWVyLCB+c2VnbWVudCkKc3Rva2VzLmNvbiA8LSBjb250cmFzdChzdG9rZXMuZW1tLCAiY29uc2VjIikKc3VtbWFyeShzdG9rZXMuY29uLCBhZGp1c3Q9Im5vbmUiKQpgYGAKCiMjIyBHZXQgdmFyaWFuY2UgY29tcG9uZW50cyB3aXRoIENJcwoKYGBge3IgfQpzdG9rZXMuY2kgPC0gY29uZmludC5tZXJNb2Qoc3Rva2VzLmxtZXIpCnN0b2tlcy52YyA8LSAoc3Rva2VzLmNpKV4yCnByaW50KHN0b2tlcy52YykKYGBgCg==