test_that("REML estimates", { skip_if_not_installed("nlme") ## Taken from example set.seed(123456) tre = rphylo(60, 0.1, 0.01) tre_h <- max(vcv(tre)) taxa = sort(tre$tip.label) b0 = 0; b1 = 1; b2 = -2; x <- rTrait(n = 1, phy = tre, model = "BM", parameters = list(ancestral.state = 0, sigma2 = 10)) f <- sample(c(0, 1), length(taxa), replace = TRUE) names(f) <- names(x) y <- b0 + b1*x + b2 * f + rTrait(n = 1, phy = tre, model = "lambda", parameters = list( ancestral.state = 0, sigma2 = 1, lambda = 0.5)) # adding measurement errors z <- y + rnorm(length(taxa), 0, 1) dat = data.frame(trait = z[taxa], pred = x[taxa], fac = as.factor(f[taxa]), species = taxa) ## Fit - BM - ML fit = phylolm(trait ~ pred + fac, data = dat, phy = tre, model = "BM") fit_gls <- nlme::gls(trait ~ pred + fac, data = dat, correlation = corBrownian(1, tre, form = ~species), method = "ML") expect_equal(as.numeric(logLik(fit)), fit_gls$logLik) expect_equal(fit$coefficients, fit_gls$coefficients) expect_equal(fit$vcov, fit_gls$varBeta) expect_equal(fit$n, fit_gls$dims$N) expect_equal(fit$d, fit_gls$dims$p) expect_equal(summary(fit)$coefficients[, "t.value"], summary(fit_gls)$tTable[, "t-value"]) expect_equal(fit$fitted[taxa], fit_gls$fitted[taxa]) expect_equal(fit$residuals[taxa], fit_gls$residuals[taxa]) expect_equal(AIC(fit), AIC(fit_gls)) expect_equal(as.numeric(logLik(fit)), as.numeric(logLik(fit_gls))) expect_equal(fit$sigma2, fit_gls$sigma^2 / tre_h) ## Fit - BM - REML fit = phylolm(trait ~ pred, data = dat, phy = tre, model = "BM", REML = TRUE) fit_gls <- nlme::gls(trait ~ pred, data = dat, correlation = corBrownian(1, tre, form = ~species), method = "REML") expect_equal(as.numeric(logLik(fit)), fit_gls$logLik) expect_equal(fit$coefficients, fit_gls$coefficients) expect_equal(fit$vcov, fit_gls$varBeta) expect_equal(fit$n, fit_gls$dims$N) expect_equal(fit$d, fit_gls$dims$p) expect_equal(summary(fit)$coefficients[, "t.value"], summary(fit_gls)$tTable[, "t-value"]) expect_equal(fit$fitted[taxa], fit_gls$fitted[taxa]) expect_equal(fit$residuals[taxa], fit_gls$residuals[taxa]) expect_equal(AIC(fit), AIC(fit_gls)) expect_equal(as.numeric(logLik(fit)), logLik(fit_gls)[1]) expect_equal(fit$sigma2, fit_gls$sigma^2 / tre_h) ## Fit - lambda - ML fit = phylolm(trait ~ pred + fac, data = dat, phy = tre, model = "lambda") fit_gls <- nlme::gls(trait ~ pred + fac, data = dat, correlation = corPagel(1, tre, form = ~species), method = "ML") expect_equal(as.numeric(logLik(fit)), fit_gls$logLik) expect_equal(fit$coefficients, fit_gls$coefficients, tolerance = 1e-5) expect_equal(fit$vcov, fit_gls$varBeta, tolerance = 1e-5) expect_equal(fit$n, fit_gls$dims$N) expect_equal(fit$d, fit_gls$dims$p) expect_equal(summary(fit)$coefficients[, "t.value"], summary(fit_gls)$tTable[, "t-value"], tolerance = 1e-5) expect_equal(fit$fitted[taxa], fit_gls$fitted[taxa], tolerance = 1e-5) expect_equal(fit$residuals[taxa], fit_gls$residuals[taxa], tolerance = 1e-5) expect_equal(AIC(fit), AIC(fit_gls)) expect_equal(as.numeric(logLik(fit)), logLik(fit_gls)[1]) expect_equal(fit$optpar, fit_gls$modelStruct$corStruct[1], tolerance = 1e-5) expect_equal(fit$sigma2, fit_gls$sigma^2 / tre_h, tolerance = 1e-5) ## Fit - lambda - REML fit = phylolm(trait ~ pred, data = dat, phy = tre, model = "lambda", REML = TRUE) fit_gls <- nlme::gls(trait ~ pred, data = dat, correlation = corPagel(1, tre, form = ~species), method = "REML") expect_equal(fit$logLik, fit_gls$logLik) expect_equal(fit$coefficients, fit_gls$coefficients, tolerance = 1e-6) expect_equal(fit$vcov, fit_gls$varBeta, tolerance = 1e-6) expect_equal(fit$n, fit_gls$dims$N) expect_equal(fit$d, fit_gls$dims$p) expect_equal(summary(fit)$coefficients[, "t.value"], summary(fit_gls)$tTable[, "t-value"], tolerance = 1e-6) expect_equal(fit$fitted[taxa], fit_gls$fitted[taxa], tolerance = 1e-6) expect_equal(fit$residuals[taxa], fit_gls$residuals[taxa], tolerance = 1e-6) expect_equal(AIC(fit), AIC(fit_gls)) expect_equal(as.numeric(logLik(fit)), logLik(fit_gls)[1]) expect_equal(fit$optpar, fit_gls$modelStruct$corStruct[1], tolerance = 1e-6) expect_equal(fit$sigma2, fit_gls$sigma^2 / tre_h, tolerance = 1e-6) ## Fit - OU - ML fit = phylolm(trait ~ pred + fac, data = dat, phy = tre, model = "OUrandomRoot") fit_gls <- nlme::gls(trait ~ pred + fac, data = dat, correlation = corMartins(0.1, tre, form = ~species), method = "ML") expect_equal(fit$logLik, fit_gls$logLik) expect_equal(fit$coefficients, fit_gls$coefficients, tolerance = 1e-6) expect_equal(fit$vcov, fit_gls$varBeta, tolerance = 1e-6) expect_equal(fit$n, fit_gls$dims$N) expect_equal(fit$d, fit_gls$dims$p) expect_equal(summary(fit)$coefficients[, "t.value"], summary(fit_gls)$tTable[, "t-value"], tolerance = 1e-5) expect_equal(fit$fitted[taxa], fit_gls$fitted[taxa], tolerance = 1e-6) expect_equal(fit$residuals[taxa], fit_gls$residuals[taxa], tolerance = 1e-6) expect_equal(AIC(fit), AIC(fit_gls)) expect_equal(as.numeric(logLik(fit)), logLik(fit_gls)[1]) expect_equal(fit$optpar, fit_gls$modelStruct$corStruct[1], tolerance = 1e-6) expect_equal(fit$sigma2 / 2 / fit$optpar, fit_gls$sigma^2, tolerance = 1e-6) ## Fit - OU - REML fit = phylolm(trait ~ pred, data = dat, phy = tre, model = "OUrandomRoot", REML = TRUE) fit_gls <- nlme::gls(trait ~ pred, data = dat, correlation = corMartins(0.1, tre, form = ~species), method = "REML") expect_equal(fit$logLik, fit_gls$logLik) expect_equal(fit$coefficients, fit_gls$coefficients, tolerance = 1e-6) expect_equal(fit$vcov, fit_gls$varBeta, tolerance = 1e-6) expect_equal(fit$n, fit_gls$dims$N) expect_equal(fit$d, fit_gls$dims$p) expect_equal(summary(fit)$coefficients[, "t.value"], summary(fit_gls)$tTable[, "t-value"], tolerance = 1e-5) expect_equal(fit$fitted[taxa], fit_gls$fitted[taxa], tolerance = 1e-6) expect_equal(fit$residuals[taxa], fit_gls$residuals[taxa], tolerance = 1e-6) expect_equal(AIC(fit), AIC(fit_gls)) expect_equal(as.numeric(logLik(fit)), logLik(fit_gls)[1]) expect_equal(fit$optpar, fit_gls$modelStruct$corStruct[1], tolerance = 1e-6) expect_equal(fit$sigma2 / 2 / fit$optpar, fit_gls$sigma^2, tolerance = 1e-6) })