knitr::opts_chunk$set(cache = TRUE, dev = c("png", "pdf"))
library(blme)
library(digest)
library(eucs)
library(here)
library(openblasctl)
library(xtable)
Data
mdg <- transform(
modeldata_grampians,
y = occupancy,
mlq = scale.default(poly(log(mean_moisture_index_of_low_qtr), 2))[, 1],
mlq2 = scale.default(poly(log(mean_moisture_index_of_low_qtr), 2))[, 2],
twi = scale.default(poly(log(topographic_wetness_index_3sec), 2))[, 1],
twi2 = scale.default(poly(log(topographic_wetness_index_3sec), 2))[, 2],
r1k = scale.default(poly(log(relief_1000m_radius), 2))[, 1],
r1k2 = scale.default(poly(log(relief_1000m_radius), 2))[, 2],
tn = scale.default(poly(log(total_nitrogen), 2))[, 1],
tn2 = scale.default(poly(log(total_nitrogen), 2))[, 2],
sla = scale.default(log(sla_mm2_per_mg)),
sm = scale.default(log(seed_mass_mg)),
mh = scale.default(log(max_height_m))
)
Model
call <- list(
formula =
y ~ mlq + mlq2 + twi + twi2 + r1k + r1k2 + tn + tn2 +
mlq:sla + mlq:sm + mlq:mh + mlq2:sla + mlq2:sm + mlq2:mh +
twi:sla + twi:sm + twi:mh + twi2:sla + twi2:sm + twi2:mh +
r1k:sla + r1k:sm + r1k:mh + r1k2:sla + r1k2:sm + r1k2:mh +
tn:sla + tn:sm + tn:mh + tn2:sla + tn2:sm + tn2:mh +
(mlq + mlq2 + twi + twi2 + r1k + r1k2 + tn + tn2 | taxon),
family = quote(binomial),
data = mdg,
fixef.prior = quote(normal(sd = 1)),
cov.prior = quote(
invwishart(
df = 9 + 4, scale = diag(sqrt((9 + 4) / 2), 9), common.scale = FALSE
)
),
control = quote(
glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 1e6))
)
)
file <- paste0(eucs_cache_path(), "/", digest(deparse(call)), ".rds")
call$data <- quote(mdg)
if (!file_test("-f", file)) {
openblas_set_num_threads(30)
saveRDS(do.call(bglmer, call), file)
openblas_set_num_threads(1)
}
model_grampians <- readRDS(file)
summary(model_grampians)
Cov prior : taxon ~ invwishart(df = 13, scale = c(2.5495, 0, 0, ...), posterior.scale = cov, common.scale = TRUE)
Fixef prior: normal(sd = c(1, ...), corr = c(0 ...), common.scale = FALSE)normal(sd = c(1, ...), corr = c(0 ...), common.scale = FALSE)
Prior dev : -36.3444
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [bglmerMod]
Family: binomial ( logit )
Formula: y ~ mlq + mlq2 + twi + twi2 + r1k + r1k2 + tn + tn2 + mlq:sla +
mlq:sm + mlq:mh + mlq2:sla + mlq2:sm + mlq2:mh + twi:sla +
twi:sm + twi:mh + twi2:sla + twi2:sm + twi2:mh + r1k:sla +
r1k:sm + r1k:mh + r1k2:sla + r1k2:sm + r1k2:mh + tn:sla +
tn:sm + tn:mh + tn2:sla + tn2:sm + tn2:mh + (mlq + mlq2 +
twi + twi2 + r1k + r1k2 + tn + tn2 | taxon)
Data: mdg
Control: glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 1e+06))
AIC BIC logLik deviance df.resid
4138.8 4694.2 -1991.4 3982.8 9062
Scaled residuals:
Min 1Q Median 3Q Max
-2.3002 -0.2788 -0.1186 -0.0389 15.6177
Random effects:
Groups Name Variance Std.Dev. Corr
taxon (Intercept) 1.16937 1.0814
mlq 0.21972 0.4687 -0.12
mlq2 0.56698 0.7530 -0.08 -0.47
twi 0.11733 0.3425 -0.09 0.20 0.00
twi2 0.08609 0.2934 0.13 0.03 -0.17 -0.07
r1k 0.34319 0.5858 -0.29 -0.41 0.57 -0.18 -0.07
r1k2 0.14525 0.3811 0.39 0.17 -0.20 0.08 0.11 -0.18
tn 0.15571 0.3946 -0.08 -0.43 0.45 -0.17 -0.10 0.38 -0.27
tn2 0.11103 0.3332 -0.08 0.04 -0.03 0.19 -0.04 -0.22 -0.13
-0.09
Number of obs: 9140, groups: taxon, 20
Fixed effects:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.952517 0.270563 -14.609 < 2e-16 ***
mlq -0.754599 0.238553 -3.163 0.001560 **
mlq2 -0.804486 0.223215 -3.604 0.000313 ***
twi 0.248615 0.124941 1.990 0.046607 *
twi2 -0.230252 0.097996 -2.350 0.018793 *
r1k 0.331276 0.244286 1.356 0.175068
r1k2 -0.513143 0.156213 -3.285 0.001020 **
tn 0.038942 0.173418 0.225 0.822326
tn2 -0.232909 0.116129 -2.006 0.044898 *
mlq:sla -0.648563 0.386835 -1.677 0.093623 .
mlq:sm 0.234553 0.334256 0.702 0.482856
mlq:mh 0.199616 0.249239 0.801 0.423188
mlq2:sla -0.624993 0.388772 -1.608 0.107921
mlq2:sm -0.314921 0.361699 -0.871 0.383934
mlq2:mh -0.169287 0.263254 -0.643 0.520187
twi:sla 0.537087 0.218241 2.461 0.013856 *
twi:sm -0.062108 0.198786 -0.312 0.754708
twi:mh -0.015197 0.141515 -0.107 0.914483
twi2:sla -0.288002 0.178871 -1.610 0.107375
twi2:sm -0.120662 0.162668 -0.742 0.458226
twi2:mh -0.043196 0.113130 -0.382 0.702592
r1k:sla 0.364892 0.322784 1.130 0.258287
r1k:sm 0.877609 0.302484 2.901 0.003716 **
r1k:mh -0.268953 0.212709 -1.264 0.206080
r1k2:sla -0.040378 0.225307 -0.179 0.857771
r1k2:sm -0.090706 0.205815 -0.441 0.659418
r1k2:mh 0.099557 0.142949 0.696 0.486147
tn:sla -0.142778 0.278619 -0.512 0.608338
tn:sm 0.090155 0.254761 0.354 0.723428
tn:mh -0.244277 0.182251 -1.340 0.180137
tn2:sla -0.000054 0.209273 0.000 0.999794
tn2:sm 0.114641 0.190812 0.601 0.547969
tn2:mh -0.061827 0.129849 -0.476 0.633969
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Table of random effects.
covariate_nms <- c(
mlq = "MMI",
mlq2 = "MMI$^2$",
twi = "TWI",
twi2 = "TWI$^2$",
r1k = "R1k",
r1k2 = "R1k$^2$",
tn = "TN",
tn2 = "TN$^2$"
)
vc <- summary(model_grampians)$varcor$taxon
stdev <- as.character(round(sqrt(diag(vc)), 1))
corr <- matrix(as.character(round(cov2cor(vc), 1)), 9)
corr[!lower.tri(corr)] <- ""
vtab <- cbind(stdev, corr)
vtab <- rbind(
c("$\\sigma$", "$\\rho$", "", "", "", "", "", "", "", ""),
rbind(c("", "$B_0$", covariate_nms)),
vtab
)
vtab <- cbind(
rownames(vtab) <- c("", "", "$B_0$", covariate_nms), vtab[, -10]
)
vtab <- xtable(
vtab, caption = "Random effects", label = "tab:varcovqua",
align = "lll|llllllll", digits = 1
)
dir.create(
here("notebooks/model_quadratic_grampians_files/figure-html"),
showWarnings = FALSE, recursive = TRUE
)
print(
vtab,
file = here(
"notebooks/model_quadratic_grampians_files/figure-html/vtab.tex"
),
include.rownames = FALSE,
table.placement = "htbp!",
caption.placement = "top",
hline.after = c(-1, 2, nrow(vtab)),
include.colnames = FALSE,
sanitize.text.function = identity
)
Table of fixed effects.
fe <- round(summary(model_grampians)$coefficients[, 1:2], 1)
rownames(fe) <- c(
"$B_0$",
covariate_nms,
paste(rep(covariate_nms, each = 3), c("SLA", "SM", "MH"), sep = "-")
)
colnames(fe) <- c("$\\mu$", "$\\sigma$")
fe <- xtable(
fe, caption = "Fixed effects", label = "tab:fequa",
align = "lll", digits = 1
)
print(
fe,
file = here(
"notebooks/model_quadratic_grampians_files/figure-html/fetab.tex"
),
include.rownames = TRUE,
table.placement = "htbp!",
caption.placement = "top",
hline.after = c(-1, 1, 9, nrow(fe)),
include.colnames = TRUE,
sanitize.text.function = identity
)
IycgLS0tCiMnIHRpdGxlOiAiTW9kZWwgb2YgR3JhbXBpYW5zIE9jY3VwYW5jeSBhbmQgVHJhaXQgRGF0YSB3aXRoIHF1YWRyYXRpYyByZWxhdGlvbnNoaXBzIgojJyBhdXRob3I6ICJXaWxsaWFtIEsuIE1vcnJpcyIKIycgZGF0ZTogImByIFN5cy5EYXRlKClgIgojJyBvdXRwdXQ6CiMnICAgcm1hcmtkb3duOjpodG1sX25vdGVib29rOgojJyAgICAgY29kZV9mb2xkaW5nOiBoaWRlCiMnIC0tLQoKIysgc2V0dXAsIG1lc3NhZ2U9RkFMU0UKa25pdHI6Om9wdHNfY2h1bmskc2V0KGNhY2hlID0gVFJVRSwgZGV2ID0gYygicG5nIiwgInBkZiIpKQpsaWJyYXJ5KGJsbWUpCmxpYnJhcnkoZGlnZXN0KQpsaWJyYXJ5KGV1Y3MpCmxpYnJhcnkoaGVyZSkKbGlicmFyeShvcGVuYmxhc2N0bCkKbGlicmFyeSh4dGFibGUpCgojJyAjIyBEYXRhCiMrIGxvYWQtZGF0YQptZGcgPC0gdHJhbnNmb3JtKAogIG1vZGVsZGF0YV9ncmFtcGlhbnMsCiAgeSAgICA9IG9jY3VwYW5jeSwKICBtbHEgID0gc2NhbGUuZGVmYXVsdChwb2x5KGxvZyhtZWFuX21vaXN0dXJlX2luZGV4X29mX2xvd19xdHIpLCAyKSlbLCAxXSwKICBtbHEyID0gc2NhbGUuZGVmYXVsdChwb2x5KGxvZyhtZWFuX21vaXN0dXJlX2luZGV4X29mX2xvd19xdHIpLCAyKSlbLCAyXSwKICB0d2kgID0gc2NhbGUuZGVmYXVsdChwb2x5KGxvZyh0b3BvZ3JhcGhpY193ZXRuZXNzX2luZGV4XzNzZWMpLCAyKSlbLCAxXSwKICB0d2kyID0gc2NhbGUuZGVmYXVsdChwb2x5KGxvZyh0b3BvZ3JhcGhpY193ZXRuZXNzX2luZGV4XzNzZWMpLCAyKSlbLCAyXSwKICByMWsgID0gc2NhbGUuZGVmYXVsdChwb2x5KGxvZyhyZWxpZWZfMTAwMG1fcmFkaXVzKSwgMikpWywgMV0sCiAgcjFrMiA9IHNjYWxlLmRlZmF1bHQocG9seShsb2cocmVsaWVmXzEwMDBtX3JhZGl1cyksIDIpKVssIDJdLAogIHRuICAgPSBzY2FsZS5kZWZhdWx0KHBvbHkobG9nKHRvdGFsX25pdHJvZ2VuKSwgMikpWywgMV0sCiAgdG4yICA9IHNjYWxlLmRlZmF1bHQocG9seShsb2codG90YWxfbml0cm9nZW4pLCAyKSlbLCAyXSwKICBzbGEgID0gc2NhbGUuZGVmYXVsdChsb2coc2xhX21tMl9wZXJfbWcpKSwKICBzbSAgID0gc2NhbGUuZGVmYXVsdChsb2coc2VlZF9tYXNzX21nKSksCiAgbWggICA9IHNjYWxlLmRlZmF1bHQobG9nKG1heF9oZWlnaHRfbSkpCikKCiMnICMjIE1vZGVsCiMrIHJ1bi1tb2RlbCwgbWVzc2FnZT1GQUxTRSwgY2FjaGU9RkFMU0UKY2FsbCA8LSBsaXN0KAogIGZvcm11bGEgPQogICAgeSB+IG1scSArIG1scTIgKyB0d2kgKyB0d2kyICsgcjFrICsgcjFrMiArIHRuICsgdG4yICsKICAgICAgbWxxOnNsYSArIG1scTpzbSArIG1scTptaCArIG1scTI6c2xhICsgbWxxMjpzbSArIG1scTI6bWggKwogICAgICB0d2k6c2xhICsgdHdpOnNtICsgdHdpOm1oICsgdHdpMjpzbGEgKyB0d2kyOnNtICsgdHdpMjptaCArCiAgICAgIHIxazpzbGEgKyByMWs6c20gKyByMWs6bWggKyByMWsyOnNsYSArIHIxazI6c20gKyByMWsyOm1oICsKICAgICAgdG46c2xhICsgdG46c20gKyB0bjptaCArIHRuMjpzbGEgKyB0bjI6c20gKyB0bjI6bWggKwogICAgICAobWxxICsgbWxxMiArIHR3aSArIHR3aTIgKyByMWsgKyByMWsyICsgdG4gKyB0bjIgfCB0YXhvbiksCiAgZmFtaWx5ID0gcXVvdGUoYmlub21pYWwpLAogIGRhdGEgPSBtZGcsCiAgZml4ZWYucHJpb3IgPSBxdW90ZShub3JtYWwoc2QgPSAxKSksCiAgY292LnByaW9yID0gcXVvdGUoCiAgICBpbnZ3aXNoYXJ0KAogICAgICBkZiA9IDkgKyA0LCBzY2FsZSA9IGRpYWcoc3FydCgoOSArIDQpIC8gMiksIDkpLCBjb21tb24uc2NhbGUgPSBGQUxTRQogICAgKQogICksCiAgY29udHJvbCA9IHF1b3RlKAogICAgZ2xtZXJDb250cm9sKG9wdGltaXplciA9ICJib2J5cWEiLCBvcHRDdHJsID0gbGlzdChtYXhmdW4gPSAxZTYpKQogICkKKQpmaWxlIDwtIHBhc3RlMChldWNzX2NhY2hlX3BhdGgoKSwgIi8iLCBkaWdlc3QoZGVwYXJzZShjYWxsKSksICIucmRzIikKCmNhbGwkZGF0YSA8LSBxdW90ZShtZGcpCgppZiAoIWZpbGVfdGVzdCgiLWYiLCBmaWxlKSkgewogIG9wZW5ibGFzX3NldF9udW1fdGhyZWFkcygzMCkKICBzYXZlUkRTKGRvLmNhbGwoYmdsbWVyLCBjYWxsKSwgZmlsZSkKICBvcGVuYmxhc19zZXRfbnVtX3RocmVhZHMoMSkKfQoKbW9kZWxfZ3JhbXBpYW5zIDwtIHJlYWRSRFMoZmlsZSkKCnN1bW1hcnkobW9kZWxfZ3JhbXBpYW5zKQoKIycgIyMgVGFibGUgb2YgcmFuZG9tIGVmZmVjdHMuCiMrcmFuZWYKY292YXJpYXRlX25tcyA8LSBjKAogIG1scSAgPSAiTU1JIiwKICBtbHEyID0gIk1NSSReMiQiLAogIHR3aSAgPSAiVFdJIiwKICB0d2kyID0gIlRXSSReMiQiLAogIHIxayAgPSAiUjFrIiwKICByMWsyID0gIlIxayReMiQiLAogIHRuICAgPSAiVE4iLAogIHRuMiAgPSAiVE4kXjIkIgopCgp2YyA8LSBzdW1tYXJ5KG1vZGVsX2dyYW1waWFucykkdmFyY29yJHRheG9uCnN0ZGV2IDwtIGFzLmNoYXJhY3Rlcihyb3VuZChzcXJ0KGRpYWcodmMpKSwgMSkpCmNvcnIgPC0gbWF0cml4KGFzLmNoYXJhY3Rlcihyb3VuZChjb3YyY29yKHZjKSwgMSkpLCA5KQpjb3JyWyFsb3dlci50cmkoY29ycildIDwtICIiCnZ0YWIgPC0gY2JpbmQoc3RkZXYsIGNvcnIpCnZ0YWIgPC0gcmJpbmQoCiAgYygiJFxcc2lnbWEkIiwgIiRcXHJobyQiLCAiIiwgIiIsICIiLCAiIiwgIiIsICIiLCAiIiwgIiIpLAogIHJiaW5kKGMoIiIsICIkQl8wJCIsIGNvdmFyaWF0ZV9ubXMpKSwKICB2dGFiCikKdnRhYiA8LSBjYmluZCgKICByb3duYW1lcyh2dGFiKSA8LSBjKCIiLCAiIiwgIiRCXzAkIiwgY292YXJpYXRlX25tcyksIHZ0YWJbLCAtMTBdCikKCnZ0YWIgPC0geHRhYmxlKAogIHZ0YWIsIGNhcHRpb24gPSAiUmFuZG9tIGVmZmVjdHMiLCBsYWJlbCA9ICJ0YWI6dmFyY292cXVhIiwKICBhbGlnbiA9ICJsbGx8bGxsbGxsbGwiLCBkaWdpdHMgPSAxCikKCmRpci5jcmVhdGUoCiAgaGVyZSgibm90ZWJvb2tzL21vZGVsX3F1YWRyYXRpY19ncmFtcGlhbnNfZmlsZXMvZmlndXJlLWh0bWwiKSwKICBzaG93V2FybmluZ3MgPSBGQUxTRSwgcmVjdXJzaXZlID0gVFJVRQopCgpwcmludCgKICB2dGFiLAogIGZpbGUgPSBoZXJlKAogICAgIm5vdGVib29rcy9tb2RlbF9xdWFkcmF0aWNfZ3JhbXBpYW5zX2ZpbGVzL2ZpZ3VyZS1odG1sL3Z0YWIudGV4IgogICksCiAgaW5jbHVkZS5yb3duYW1lcyA9IEZBTFNFLAogIHRhYmxlLnBsYWNlbWVudCA9ICJodGJwISIsCiAgY2FwdGlvbi5wbGFjZW1lbnQgPSAidG9wIiwKICBobGluZS5hZnRlciA9IGMoLTEsIDIsIG5yb3codnRhYikpLAogIGluY2x1ZGUuY29sbmFtZXMgPSBGQUxTRSwKICBzYW5pdGl6ZS50ZXh0LmZ1bmN0aW9uID0gaWRlbnRpdHkKKQoKIycgIyMgVGFibGUgb2YgZml4ZWQgZWZmZWN0cy4KIytmaXhlZgpmZSA8LSByb3VuZChzdW1tYXJ5KG1vZGVsX2dyYW1waWFucykkY29lZmZpY2llbnRzWywgMToyXSwgMSkKcm93bmFtZXMoZmUpIDwtIGMoCiAgIiRCXzAkIiwKICBjb3ZhcmlhdGVfbm1zLAogIHBhc3RlKHJlcChjb3ZhcmlhdGVfbm1zLCBlYWNoID0gMyksIGMoIlNMQSIsICJTTSIsICJNSCIpLCBzZXAgPSAiLSIpCikKY29sbmFtZXMoZmUpIDwtIGMoIiRcXG11JCIsICIkXFxzaWdtYSQiKQoKZmUgPC0geHRhYmxlKAogIGZlLCBjYXB0aW9uID0gIkZpeGVkIGVmZmVjdHMiLCBsYWJlbCA9ICJ0YWI6ZmVxdWEiLAogIGFsaWduID0gImxsbCIsIGRpZ2l0cyA9IDEKKQoKcHJpbnQoCiAgZmUsCiAgZmlsZSA9IGhlcmUoCiAgICAibm90ZWJvb2tzL21vZGVsX3F1YWRyYXRpY19ncmFtcGlhbnNfZmlsZXMvZmlndXJlLWh0bWwvZmV0YWIudGV4IgogICksCiAgaW5jbHVkZS5yb3duYW1lcyA9IFRSVUUsCiAgdGFibGUucGxhY2VtZW50ID0gImh0YnAhIiwKICBjYXB0aW9uLnBsYWNlbWVudCA9ICJ0b3AiLAogIGhsaW5lLmFmdGVyID0gYygtMSwgMSwgOSwgbnJvdyhmZSkpLAogIGluY2x1ZGUuY29sbmFtZXMgPSBUUlVFLAogIHNhbml0aXplLnRleHQuZnVuY3Rpb24gPSBpZGVudGl0eQopCg==