Modified from hybridgerm.Rmd (Oct 2017)
Identify reproductive barriers between two sympatric moth-fflinated plant species, Schiedea kaalae and S. hookeri by fitting a generalized linear mixed model (GLMM).
In the experimental design, the following crosstypes were made:
In this analysis the response variable is the fflen viability of each cross. Other barriers (hybrid survival, flowering) could be analyzed in a similar framework, with appropriate changes to the underlying distribution.
Fixed effects:
Potential random effects:
ff <- read.table("firstflower6_plusone.csv", header=T, sep="\t")#has one dummy entry that did not flower for each crosstype
ff$firstflower.date[ff$firstflower.date==""] <- NA
ff$firstflower.date[ff$use.firstflower!="yes"] <- NA
ff$firstflower.date <- as.Date(ff$firstflower.date)
ff$firstflower <- as.integer(round(difftime(ff$firstflower.date, "2016-03-01")))
ff <- ff[ff$crossid!=107,] ##FIND OUT WHAT CROSS THIS IS
ff$alive[ff$use.alive.flowered!="yes"] <- NA
ff <- ff[ff$alive=="yes",] #only consider flowering of live individuals
ff$alive <- ff$alive=="yes"
ff$flowered[ff$flowered=="?"] <- NA
ff$flowered <- ff$flowered=="yes"
ff <- ff[!is.na(ff$flowered),]
crosses <- read.table("hybrids.csv", header=T, sep="\t", colClasses=c(mompop="factor", dadpop="factor"))
crosscol <- c("green","blue","orange","red")
#treat populations as factors
ff$mompop <- crosses$mompop[match(ff$crossid, crosses$crossid)]
ff$momid <- crosses$momid[match(ff$crossid, crosses$crossid)]
ff$species <- crosses$momsp[match(ff$crossid, crosses$crossid)]
ff$dadpop <- crosses$dadpop[match(ff$crossid, crosses$crossid)]
ff$dadid <- crosses$dadid[match(ff$crossid, crosses$crossid)]
ff$dadsp <- crosses$dadsp[match(ff$crossid, crosses$crossid)]
ff$crosstype <- crosses$crosstype[match(ff$crossid, crosses$crossid)]
ff$cross <- crosses$cross[match(ff$crossid, crosses$crossid)]
#rename crosstype codes
ff$crosstype <- factor(ff$crosstype, levels=c("between", "within", "hybrid"))
#made "between" the first reference level to facilitate comparison between outcrossing populations and hybridizing species
ff$mompop <- sapply(ff$mompop, mapvalues, from = c("794","866","899","879","892","904","3587"), to = c("WK","WK","WK","879WKG","892WKG","904WPG","3587WP"))
ff$dadpop <- sapply(ff$dadpop, mapvalues, from = c("794","866","899","879","892","904","3587"), to = c("WK","WK","WK","879WKG","892WKG","904WPG","3587WP"))
#define interactions
ff <- within(ff, sxc <- interaction(species,crosstype))
ff <- within(ff, sxcxm <- interaction(species,crosstype,mompop,momid))
ff <- within(ff, mompid <- as.factor(paste(mompop,momid,sep=".")))
ff <- within(ff, dadpid <- as.factor(paste(dadpop,dadid,sep=".")))
ff <- within(ff, smompop <- as.factor(paste(species,mompop,sep="")))
#check final structure
str(ff)
'data.frame': 1368 obs. of 39 variables:
$ index : int 0 0 0 0 0 0 1 2 3 4 ...
$ crossid : int 1 4 6 108 115 117 1 1 1 1 ...
$ plantid : Factor w/ 33 levels "0","1","10","11",..: 33 33 33 33 33 33 2 15 26 27 ...
$ crossid.plantid : Factor w/ 1619 levels "","100-1","100-2",..: 1 1 1 1 1 1 99 155 201 221 ...
$ death.date : Factor w/ 133 levels "","100-2: 5/19/16",..: 1 1 1 1 1 1 1 1 1 1 ...
$ firstflower.day : Factor w/ 70 levels "","10/11","10/13",..: 1 1 1 1 1 1 3 23 1 26 ...
$ firstflower.date : Date, format: NA NA ...
$ use.alive.flowered : Factor w/ 3 levels "?","no","yes": 3 3 3 3 3 3 3 3 3 3 ...
$ alive : logi TRUE TRUE TRUE TRUE TRUE TRUE ...
$ use.firstflower : Factor w/ 4 levels "missed","never flowered",..: 3 3 3 3 3 3 4 4 1 4 ...
$ flowered : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
$ saved.1 : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 2 1 ...
$ saved.2 : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 2 1 ...
$ sampled.VOC : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...
$ biomass.inflo : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 2 2 1 2 ...
$ biomass.firstinflo : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 2 2 2 2 ...
$ use.fib : Factor w/ 4 levels "double","#N/A",..: 3 3 3 3 3 3 4 4 4 4 ...
$ delay : Factor w/ 35 levels "","0","1","10",..: 1 1 1 1 1 1 25 30 1 30 ...
$ firstinflo.collect.date: Factor w/ 71 levels "","2016-07-12",..: 1 1 1 1 1 1 47 64 21 56 ...
$ firstinflo.weigh.date : Factor w/ 49 levels "","2017-07-26",..: 1 1 1 1 1 1 18 21 16 21 ...
$ firstinflo.biomass.mg : Factor w/ 1094 levels "","100","100.1",..: 1 1 1 1 1 1 509 630 1003 462 ...
$ comments.fib : Factor w/ 31 levels "","10/13/17?",..: 1 1 1 1 1 1 1 1 1 1 ...
$ biomass.veg : logi NA NA NA NA NA NA ...
$ comments.SS : Factor w/ 44 levels "","?","\"1 terminlal infl\"",..: 1 1 1 1 1 1 1 1 30 1 ...
$ comments.JP.SGW : Factor w/ 78 levels "","105-9: 7/12/16 spray",..: 1 1 1 1 1 1 1 1 1 1 ...
$ firstflower : int NA NA NA NA NA NA 226 271 NA 250 ...
$ mompop : Factor w/ 5 levels "3587WP","WK",..: 3 3 3 4 4 4 3 3 3 3 ...
$ momid : Factor w/ 17 levels "1","10","10-1",..: 7 7 7 1 1 1 7 7 7 7 ...
$ species : Factor w/ 2 levels "hook","kaal": 1 1 1 2 2 2 1 1 1 1 ...
$ dadpop : Factor w/ 5 levels "3587WP","WK",..: 3 2 4 3 4 5 3 3 3 3 ...
$ dadid : Factor w/ 23 levels "1","10","10-1",..: 19 7 1 8 14 7 19 19 19 19 ...
$ dadsp : Factor w/ 2 levels "hook","kaal": 1 1 2 1 2 2 1 1 1 1 ...
$ crosstype : Factor w/ 3 levels "between","within",..: 2 1 3 3 2 1 2 2 2 2 ...
$ cross : Factor w/ 4 levels "HH","HK","KH",..: 1 1 2 3 4 4 1 1 1 1 ...
$ sxc : Factor w/ 6 levels "hook.between",..: 3 1 5 6 4 2 3 3 3 3 ...
$ sxcxm : Factor w/ 510 levels "hook.between.3587WP.1",..: 195 193 197 24 22 20 195 195 195 195 ...
$ mompid : Factor w/ 23 levels "3587WP.10","3587WP.14",..: 8 8 8 12 12 12 8 8 8 8 ...
$ dadpid : Factor w/ 24 levels "3587WP.10","3587WP.14",..: 9 20 12 8 15 17 9 9 9 9 ...
$ smompop : Factor w/ 5 levels "hook879WKG","hookWK",..: 1 1 1 4 4 4 1 1 1 1 ...
The sample sizes are unbalanced at all levels, including maternal population:
reptab <- with(ff, table(smompop,crosstype))
mosaic(reptab, pop=F)
labeling_cells(text = reptab, margin = 0)(reptab)
Replication is low for some within-population crosses. The replication is even lower for each maternal plant, so we need to be wary of estimates when subsetting at this level:
with(ff, kable(table(mompid,crosstype)))
| between | within | hybrid | |
|---|---|---|---|
| 3587WP.10 | 0 | 1 | 0 |
| 3587WP.14 | 17 | 0 | 8 |
| 3587WP.15 | 7 | 3 | 0 |
| 3587WP.7 | 25 | 16 | 16 |
| 3587WP.A | 5 | 2 | 0 |
| 3587WP.C | 16 | 1 | 0 |
| 879WKG.10-1 | 55 | 7 | 43 |
| 879WKG.2-2 | 41 | 54 | 108 |
| 879WKG.G-2 | 20 | 11 | 35 |
| 879WKG.H-2 | 0 | 1 | 8 |
| 879WKG.N-5 | 10 | 10 | 25 |
| 892WKG.1 | 29 | 6 | 11 |
| 892WKG.10 | 1 | 0 | 0 |
| 892WKG.2 | 3 | 0 | 0 |
| 892WKG.3 | 4 | 1 | 3 |
| 892WKG.4 | 1 | 0 | 1 |
| 892WKG.5 | 13 | 7 | 6 |
| 904WPG.2 | 17 | 10 | 17 |
| 904WPG.3 | 22 | 32 | 5 |
| 904WPG.5 | 82 | 36 | 28 |
| WK.2 | 171 | 20 | 132 |
| WK.2E- 1 | 7 | 0 | 34 |
| WK.4 | 70 | 14 | 40 |
To identify the best-fitting distribution, we make quantile-quantile plots of the raw data against various distributions. The more points within the confidence interval envelopes, the better the fit. Later, we present quantile-quantile plots of the model residuals to assess model fit.
Effects and interactions in these plots are simply given by the mean, which may be unduly influenced by high values.
intplot <- ggplot(ff,aes(fill=factor(flowered))) + geom_bar(position="fill") + labs(y="Proportion") + guides(fill=guide_legend(title="Flowered")) + facet_grid(~species)
intplot + aes(x=crosstype)
intplot + aes(x=mompop)
intplot + aes(x=mompid)
intplot + aes(x=dadpop)
We constructed the following models with the package glmmADMB. They all have the same fixed effects, species x crosstype, and response variable, flowered
| distribution, Random Effects: | None | Maternal plant | Maternal population |
|---|---|---|---|
| normal (norm) | X | X | X |
sc.bin <- glm(flowered~species*crosstype, data=ff, family="binomial")
sc.mix.mompid.bin <- glmer(flowered~species*crosstype + (1|mompid), data=ff, family="binomial")
sc.mix.mompop.bin <- glmer(flowered~species*crosstype + (1|mompop), data=ff, family="binomial")
sc.mix.momdadpid.bin <- glmer(flowered~species*crosstype + (1|mompid) + (1|dadpid), data=ff, family="binomial")
We will use the Aikake Information Criterion to pick the model the best fits the data, penalized by the number of parameters. Differences of 2 units are significant.
#AICtab(sc.b, sc.mix.mompop.b, sc.mix.mompid.b)
sc.names <- c("sc.bin", "sc.mix.mompid.bin", "sc.mix.mompop.bin","sc.mix.momdadpid.bin")
sc.list <- sapply(sc.names, get, USE.NAMES=T)
sc.AIC <- ICtab(sc.list,mnames=sc.names,type="AIC", base=T, delta=F) # for AICc, nobs=nobs(sc.list[[1]])
class(sc.AIC)<-"data.frame"
all.names <- c(sc.names)
all.list <- sapply(all.names, get, USE.NAMES=T)
all.AIC <- dfun(rbind(sc.AIC))
all.AIC <- all.AIC[order(all.AIC$dAIC),]
kable(all.AIC, format.arg=list(digits=3))
| dAIC | df | |
|---|---|---|
| sc.bin | 0.00 | 6 |
| sc.mix.mompid.bin | 2.00 | 7 |
| sc.mix.mompop.bin | 2.00 | 7 |
| sc.mix.momdadpid.bin | 3.46 | 8 |
The best-fiting model is a model with the following components:
The coefficients estimated for each model agree qualitatively.
sc.log.names <- sc.names
sc.log <- sapply(sc.log.names, get, USE.NAMES=T)
coefplot2(sc.log, legend.x="topright",legend=T,legend.args=list(cex=0.8, xpd=T, inset=c(-0.1,0)), col.pts=sample(gg_color_hue(length(sc.log.names))), spacing=0.05, lwd.2=2, lwd.1=4, intercept=T)
We chose the model with nearly the best (lowest) AIC, to carry out inference tests and parameter estimation.
mod <- sc.bin
print(mod)
Call: glm(formula = flowered ~ species * crosstype, family = "binomial",
data = ff)
Coefficients:
(Intercept) specieskaal
4.8176 0.6672
crosstypewithin crosstypehybrid
-1.4765 -2.0450
specieskaal:crosstypewithin specieskaal:crosstypehybrid
0.7279 -0.5494
Degrees of Freedom: 1367 Total (i.e. Null); 1362 Residual
Null Deviance: 354.4
Residual Deviance: 323.6 AIC: 335.6
By dropping it from the model and performing a likelihood-ratio test, we see that the species x crosstype interaction is not significant.
sxc.chisq <- drop1(mod, test="Chisq") #load from file
dfun(sxc.chisq)
Single term deletions
Model:
flowered ~ species * crosstype
Df Deviance dAIC LRT Pr(>Chi)
<none> 323.59 2.7283
species:crosstype 2 324.86 0.0000 1.2717 0.5295
The model estimated the following parameters, with individual parameter significance determined by the Wald z-test, and fixed effect significance determined by analysis of deviance Wald test.
summary(mod)
Call:
glm(formula = flowered ~ species * crosstype, family = "binomial",
data = ff)
Deviance Residuals:
Min 1Q Median 3Q Max
-3.3133 0.1269 0.1322 0.3482 0.3482
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 4.8176 0.5797 8.311 < 2e-16 ***
specieskaal 0.6672 1.1577 0.576 0.564384
crosstypewithin -1.4765 0.7713 -1.914 0.055577 .
crosstypehybrid -2.0450 0.6152 -3.324 0.000888 ***
specieskaal:crosstypewithin 0.7279 1.6149 0.451 0.652171
specieskaal:crosstypehybrid -0.5494 1.2625 -0.435 0.663414
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 354.37 on 1367 degrees of freedom
Residual deviance: 323.59 on 1362 degrees of freedom
AIC: 335.59
Number of Fisher Scoring iterations: 8
Anova(mod, type=3)
Analysis of Deviance Table (Type III tests)
Response: flowered
LR Chisq Df Pr(>Chisq)
species 0.3661 1 0.5451265
crosstype 17.5840 2 0.0001519 ***
species:crosstype 1.2717 2 0.5294877
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
These are box and QQ (to check normality) plots of the estimated random effect of each maternal plant.
predre <- setNames(data.frame(RE=ranef(mod)$mompid,SD=ranef(mod, sd=T)$`1`),c("RE","SD"))
ggplot(predre, aes(x = rownames(predre),y=RE)) +
geom_point(size = 2) + coord_flip()+
geom_errorbar(aes(ymin = RE-SD, ymax = RE+SD)) + labs(x="Maternal plants", y="Predicted random effects")
#Count
reStack <- ldply(ranef(mod))
print( qqmath( ~`(Intercept)`|.id, data=reStack, scales=list(relation="free"),
prepanel = prepanel.qqmathline,
panel = function(x, ...) {
panel.qqmathline(x, ...)
panel.qqmath(x, ...)
},
layout=c(1,1)))
The least square means procedure can generate predictor estimates of each type, and give their significance groupings with a post-hoc Tukey test. S. hookeri-produced hybrids produce less Viability than either crosses between or within S. hookeri populations. The other differences are not significant, but remember that the fixed effect of hybrid (vs. between) was significant (model summary).
#Count
rg <- ref.grid(mod)
#summary(rg)
sxc.lsm <- lsmeans(rg, ~ crosstype*species)
plot(sxc.lsm)
cld.mod <- cld(sxc.lsm, Letters=letters) #tukey letterings
library(boot)
cld.mod$response <- inv.logit(cld.mod$lsmean)
#cld.mod$SE[c(5,6)] <- 0
cld.mod$uSE <- inv.logit(cld.mod$lsmean+cld.mod$SE)
cld.mod$lSE <- inv.logit(cld.mod$lsmean-cld.mod$SE)
options(digits=4)
cld.mod[rev(order(cld.mod$species, cld.mod$crosstype)),]
crosstype species lsmean SE df asymp.LCL asymp.UCL .group response
hybrid kaal 2.890 0.4595 NA 1.990 3.791 ab 0.9474
within kaal 4.736 1.0044 NA 2.768 6.705 ab 0.9913
between kaal 5.485 1.0021 NA 3.521 7.449 ab 0.9959
hybrid hook 2.773 0.2062 NA 2.369 3.177 a 0.9412
within hook 3.341 0.5088 NA 2.344 4.338 ab 0.9658
between hook 4.818 0.5797 NA 3.681 5.954 b 0.9920
uSE lSE
0.9661 0.9192
0.9968 0.9766
0.9985 0.9888
0.9516 0.9287
0.9792 0.9444
0.9955 0.9858
Results are given on the logit (not the response) scale.
Confidence level used: 0.95
Results are given on the log odds ratio (not the response) scale.
P value adjustment: tukey method for comparing a family of 6 estimates
significance level used: alpha = 0.05
H.wb <- with(cld.mod[cld.mod$species=="hook",], response[crosstype=="within"]/response[crosstype=="between"] - 1)
K.wb <- with(cld.mod[cld.mod$species=="kaal",], response[crosstype=="within"]/response[crosstype=="between"] - 1)
K.H <- with(cld.mod[cld.mod$crosstype=="between",], response[species=="kaal"]/response[species=="hook"] - 1)
maxsp <- ifelse(K.H>0, "kaal","hook")
minsp <- ifelse(K.H<0, "kaal","hook")
maxresp <- with(cld.mod, response[species==maxsp & crosstype=="between"])
minresp <- with(cld.mod, response[species==minsp & crosstype=="between"])
HK.resp <- with(cld.mod, response[species=="hook" & crosstype=="hybrid"])
KH.resp <- with(cld.mod, response[species=="kaal" & crosstype=="hybrid"])
HK.int <- with(cld.mod, ifelse(HK.resp > minresp & HK.resp < maxresp, (HK.resp-minresp)/(maxresp-minresp),
ifelse(HK.resp < minresp, HK.resp/minresp-1, HK.resp/maxresp-1)))
KH.int <- with(cld.mod, ifelse(KH.resp > minresp & KH.resp < maxresp, (KH.resp-minresp)/(maxresp-minresp),
ifelse(KH.resp < minresp, KH.resp/minresp-1, KH.resp/maxresp-1)))
intermed <- (minresp + maxresp) / 2
round(c(H.wb,K.wb,K.H,HK.int,KH.int),2)
[1] -0.03 0.00 0.00 -0.05 -0.04
ggplot(as.data.frame(cld.mod), aes(y=response, x=relevel(crosstype, "within"), fill=species)) +
geom_col(position=position_dodge2()) +
geom_linerange(aes(ymin=lSE, ymax=uSE), position=position_dodge(0.9)) +
labs(x="", y="Proportion flowered",fill="Maternal species") +
scale_fill_manual(labels = c("S. hookeri ", "S. kaalae "), values=brewer.pal(name="Set1", n=3)[c(3,2)]) +
scale_x_discrete(labels = c("Intrapopulation", "Interpopulation", "Hybrid")) +
geom_text(aes(label=.group), position=position_dodge(0.9), hjust=0, vjust=-0.2) +
scale_y_continuous(expand = expand_scale(mult=c(0,0.04)), breaks = scales::pretty_breaks(n = 5), limits=c(0,1)) +
theme_classic() + theme(legend.text=element_text(face="italic", size=rel(1)), legend.position="bottom", axis.text = element_text(colour="black", size=rel(1)), text=element_text(size=14), axis.ticks.x = element_blank()) + geom_segment(aes(x=2.5, y=intermed, xend=3.5, yend=intermed))