tests/testthat/test_glmmkin.R

test_that("cross-sectional id le 400 binomial", {
	skip_on_cran()

	data(example)
	suppressWarnings(RNGversion("3.5.0"))
	set.seed(123)
	pheno <- rbind(example$pheno, example$pheno[1:100, ])
	pheno$id <- 1:500
	pheno$disease[sample(1:500,20)] <- NA
	pheno$age[sample(1:500,20)] <- NA
	pheno$sex[sample(1:500,20)] <- NA
	pheno <- pheno[sample(1:500,450), ]
	pheno <- pheno[pheno$id <= 400, ]
	kins <- example$GRM
	obj1 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Brent")
	expect_equal(signif(as.numeric(obj1$theta)), signif(c(1, 0.1925217)))
	expect_equal(signif(as.numeric(obj1$coef)), signif(c(1.01676248, -0.01506251, -0.33240660)))
	obj2 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Brent")
	expect_equal(as.numeric(obj2$theta), c(1, 0))
	expect_equal(signif(as.numeric(obj2$coef)), signif(c(0.94253959, -0.01429532, -0.32823930)))
	obj3 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(signif(as.numeric(obj3$theta)), c(1, 0.1925))
	expect_equal(signif(as.numeric(obj3$coef)), signif(c(1.0224921, -0.0151259, -0.3328061)))
	obj4 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(as.numeric(obj4$theta), c(1, 0))
	expect_equal(signif(as.numeric(obj4$coef)), signif(c(0.94253959, -0.01429532, -0.32823930)))
	obj5 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(signif(as.numeric(obj5$theta)), signif(c(1, 0.1925225)))
	expect_equal(signif(as.numeric(obj5$coef)), signif(c(1.01676230, -0.01506251, -0.33240659)))
	obj6 <- glmmkin(disease ~ age + sex, data = pheno, kins = NULL, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(c(obj6$theta), 1)
	expect_equal(signif(as.numeric(obj6$coef)), signif(c(0.94253958, -0.01429532, -0.32823930)))
	obj <- glm(disease ~ age + sex, data = pheno, family = binomial(link = "logit"))
	expect_equal(obj6$coef, obj$coef)

	idx <- sample(nrow(pheno))
	pheno <- pheno[idx, ]
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Brent")
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Brent")
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(obj3$theta, obj$theta)
	expect_equal(obj3$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(obj4$theta, obj$theta)
	expect_equal(obj4$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(obj5$theta, obj$theta)
	expect_equal(obj5$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = NULL, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(obj6$theta, obj$theta)
	expect_equal(obj6$coef, obj$coef)
	obj <- glm(disease ~ age + sex, data = pheno, family = binomial(link = "logit"))
	expect_equal(obj6$coef, obj$coef)

	idx <- sample(nrow(kins))
	kins <- kins[idx, idx]
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Brent")
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Brent")
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(obj3$theta, obj$theta)
	expect_equal(obj3$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(obj4$theta, obj$theta)
	expect_equal(obj4$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(obj5$theta, obj$theta)
	expect_equal(obj5$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = NULL, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(obj6$theta, obj$theta)
	expect_equal(obj6$coef, obj$coef)
})

test_that("cross-sectional id gt 400 binomial", {
	skip_on_cran()

	data(example)
	suppressWarnings(RNGversion("3.5.0"))
	set.seed(123)
	pheno <- rbind(example$pheno, example$pheno[1:100, ])
	pheno$id <- 1:500
	pheno$disease[sample(1:500,20)] <- NA
	pheno$age[sample(1:500,20)] <- NA
	pheno$sex[sample(1:500,20)] <- NA
	pheno <- pheno[sample(1:500,450), ]
	kins <- diag(500)
	kins[1:400, 1:400] <- example$GRM
	rownames(kins) <- colnames(kins) <- 1:500
	obj1 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Brent")
	expect_equal(signif(as.numeric(obj1$theta)), signif(c(1, 0.1263608)))
	expect_equal(signif(as.numeric(obj1$coef)), signif(c(0.92300941, -0.01457307, -0.18165857)))
	obj2 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Brent")
	expect_equal(as.numeric(obj2$theta), c(1, 0))
	expect_equal(signif(as.numeric(obj2$coef)), signif(c(0.86840326, -0.01402939, -0.17898775)))
	obj3 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(signif(as.numeric(obj3$theta)), c(1, 0.121))
	expect_equal(signif(as.numeric(obj3$coef), digits = 5), signif(c(0.92527071, -0.01459762, -0.18179150), digits = 5))
	obj4 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(as.numeric(obj4$theta), c(1, 0))
	expect_equal(signif(as.numeric(obj4$coef)), signif(c(0.86840326, -0.01402939, -0.17898775)))
	obj5 <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(signif(as.numeric(obj5$theta)), signif(c(1, 0.1263611)))
	expect_equal(signif(as.numeric(obj5$coef)), signif(c(0.92300945, -0.01457307, -0.18165858)))
	obj6 <- glmmkin(disease ~ age + sex, data = pheno, kins = NULL, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(c(obj6$theta), 1)
	expect_equal(signif(as.numeric(obj6$coef)), signif(c(0.86840325, -0.01402939, -0.17898775)))
	obj <- glm(disease ~ age + sex, data = pheno, family = binomial(link = "logit"))
	expect_equal(obj6$coef, obj$coef)

	idx <- sample(nrow(pheno))
	pheno <- pheno[idx, ]
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Brent")
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Brent")
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(obj3$theta, obj$theta)
	expect_equal(obj3$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(obj4$theta, obj$theta)
	expect_equal(obj4$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(obj5$theta, obj$theta)
	expect_equal(obj5$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = NULL, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(obj6$theta, obj$theta)
	expect_equal(obj6$coef, obj$coef)
	obj <- glm(disease ~ age + sex, data = pheno, family = binomial(link = "logit"))
	expect_equal(obj6$coef, obj$coef)

	idx <- sample(nrow(kins))
	kins <- kins[idx, idx]
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Brent")
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Brent")
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(obj3$theta, obj$theta)
	expect_equal(obj3$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(obj4$theta, obj$theta)
	expect_equal(obj4$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = kins, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(obj5$theta, obj$theta)
	expect_equal(obj5$coef, obj$coef)
	obj <- glmmkin(disease ~ age + sex, data = pheno, kins = NULL, id = "id", family = binomial(link = "logit"), method = "REML", method.optim = "AI")
	expect_equal(obj6$theta, obj$theta)
	expect_equal(obj6$coef, obj$coef)
})

test_that("cross-sectional id le 400 gaussian", {
	skip_on_cran()

	data(example)
	suppressWarnings(RNGversion("3.5.0"))
	set.seed(123)
	pheno <- rbind(example$pheno, example$pheno[1:100, ])
	pheno$id <- 1:500
	pheno$disease[sample(1:500,20)] <- NA
	pheno$age[sample(1:500,20)] <- NA
	pheno$sex[sample(1:500,20)] <- NA
	pheno <- pheno[sample(1:500,450), ]
	pheno <- pheno[pheno$id <= 400, ]
	kins <- example$GRM
	obj1 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Brent")
	expect_equal(signif(as.numeric(obj1$theta)), signif(c(0.7682478, 1.3037470)))
	expect_equal(signif(as.numeric(obj1$coef)), signif(c(3.7634934, 0.0346562, 0.3062784)))
	obj2 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Brent")
	expect_equal(signif(as.numeric(obj2$theta)), signif(c(0.9391236, 1.0851816)))
	expect_equal(signif(as.numeric(obj2$coef)), signif(c(3.76521261, 0.03451443, 0.30509914)))
	obj3 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(signif(as.numeric(obj3$theta), digits = 5), signif(c(0.7174382, 1.2196450), digits = 5))
	expect_equal(signif(as.numeric(obj3$coef)), signif(c(3.76315625, 0.03469074, 0.30656586)))
	obj4 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(signif(as.numeric(obj4$theta)), signif(c(0.9622361, 1.0584597)))
	expect_equal(signif(as.numeric(obj4$coef)), signif(c(3.76551377, 0.03449328, 0.30492363)))
	obj5 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(signif(as.numeric(obj5$theta)), signif(c(0.7682481, 1.3037467)))
	expect_equal(signif(as.numeric(obj5$coef)), signif(c(3.7634933, 0.0346562, 0.3062784)))
	obj6 <- glmmkin(trait ~ age + sex, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(signif(as.numeric(obj6$theta)), signif(1.996857))
	expect_equal(signif(as.numeric(obj6$coef)), signif(c(3.89665633, 0.03156906, 0.27860778)))
	obj <- lm(trait ~ age + sex, data = pheno)
	expect_equal(c(obj6$theta), summary(obj)$sigma^2)
	expect_equal(obj6$coef, obj$coef)

	idx <- sample(nrow(pheno))
	pheno <- pheno[idx, ]
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Brent")
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Brent")
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(obj3$theta, obj$theta)
	expect_equal(obj3$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(obj4$theta, obj$theta)
	expect_equal(obj4$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(obj5$theta, obj$theta)
	expect_equal(obj5$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(obj6$theta, obj$theta)
	expect_equal(obj6$coef, obj$coef)
	obj <- lm(trait ~ age + sex, data = pheno)
	expect_equal(c(obj6$theta), summary(obj)$sigma^2)
	expect_equal(obj6$coef, obj$coef)

	idx <- sample(nrow(kins))
	kins <- kins[idx, idx]
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Brent")
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Brent")
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(obj3$theta, obj$theta)
	expect_equal(obj3$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(obj4$theta, obj$theta)
	expect_equal(obj4$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(obj5$theta, obj$theta)
	expect_equal(obj5$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(obj6$theta, obj$theta)
	expect_equal(obj6$coef, obj$coef)
})

test_that("cross-sectional id gt 400 gaussian", {
	skip_on_cran()

	data(example)
	suppressWarnings(RNGversion("3.5.0"))
	set.seed(123)
	pheno <- rbind(example$pheno, example$pheno[1:100, ])
	pheno$id <- 1:500
	pheno$disease[sample(1:500,20)] <- NA
	pheno$age[sample(1:500,20)] <- NA
	pheno$sex[sample(1:500,20)] <- NA
	pheno <- pheno[sample(1:500,450), ]
	kins <- diag(500)
	kins[1:400, 1:400] <- example$GRM
	rownames(kins) <- colnames(kins) <- 1:500
	obj1 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Brent")
	expect_equal(signif(as.numeric(obj1$theta)), signif(c(0.7205609, 1.3795640)))
	expect_equal(signif(as.numeric(obj1$coef)), signif(c(3.90459575, 0.03650594, 0.37958367)))
	obj2 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Brent")
	expect_equal(signif(as.numeric(obj2$theta)), signif(c(0.7485909, 1.3321148)))
	expect_equal(signif(as.numeric(obj2$coef)), signif(c(3.90396978, 0.03649397, 0.37960264)))
	obj3 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(signif(as.numeric(obj3$theta)), signif(c(0.6044086, 1.2692581)))
	expect_equal(signif(as.numeric(obj3$coef)), signif(c(3.90659373, 0.03654332, 0.37947361)))
	obj4 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(signif(as.numeric(obj4$theta)), signif(c(0.7188051, 1.2219687)))
	expect_equal(signif(as.numeric(obj4$coef)), signif(c(3.90453205, 0.03650473, 0.37958592)))
	obj5 <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(signif(as.numeric(obj5$theta)), signif(c(0.7205609, 1.3795639)))
	expect_equal(signif(as.numeric(obj5$coef)), signif(c(3.90459568, 0.03650594, 0.37958367)))
	obj6 <- glmmkin(trait ~ age + sex, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(signif(as.numeric(obj6$theta)), signif(2.051809))
	expect_equal(signif(as.numeric(obj6$coef)), signif(c(3.7836398, 0.0344577, 0.3602852)))
	obj <- lm(trait ~ age + sex, data = pheno)
	expect_equal(c(obj6$theta), summary(obj)$sigma^2)
	expect_equal(obj6$coef, obj$coef)

	idx <- sample(nrow(pheno))
	pheno <- pheno[idx, ]
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Brent")
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Brent")
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(obj3$theta, obj$theta)
	expect_equal(obj3$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(obj4$theta, obj$theta)
	expect_equal(obj4$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(obj5$theta, obj$theta)
	expect_equal(obj5$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(obj6$theta, obj$theta)
	expect_equal(obj6$coef, obj$coef)
	obj <- lm(trait ~ age + sex, data = pheno)
	expect_equal(c(obj6$theta), summary(obj)$sigma^2)
	expect_equal(obj6$coef, obj$coef)

	idx <- sample(nrow(kins))
	kins <- kins[idx, idx]
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Brent")
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Brent")
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "Nelder-Mead")
	expect_equal(obj3$theta, obj$theta)
	expect_equal(obj3$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "ML", method.optim = "Nelder-Mead")
	expect_equal(obj4$theta, obj$theta)
	expect_equal(obj4$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(obj5$theta, obj$theta)
	expect_equal(obj5$coef, obj$coef)
	obj <- glmmkin(trait ~ age + sex, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"), method = "REML", method.optim = "AI")
	expect_equal(obj6$theta, obj$theta)
	expect_equal(obj6$coef, obj$coef)
})

test_that("longitudinal repeated measures gaussian", {
	skip_on_cran()

	data(example)
	suppressWarnings(RNGversion("3.5.0"))
	set.seed(123)
	pheno <- example$pheno2
	kins <- example$GRM
	obj1 <- glmmkin(y.repeated ~ sex, data = pheno, kins = kins, id = "id",random.slope = NULL, family = gaussian(link = "identity"))
	expect_equal(signif(as.numeric(obj1$theta)), signif(c(0.5089983, 0.2410866, 0.2129918)))
	expect_equal(signif(as.numeric(obj1$coef)), signif(c(0.9871441, 0.6134051)))
	obj2 <- glmmkin(y.repeated ~ sex, data = pheno, kins = NULL, id = "id",random.slope = NULL, family = gaussian(link = "identity"))
	expect_equal(signif(as.numeric(obj2$theta)), signif(c(0.5089982, 0.4374597)))
	expect_equal(signif(as.numeric(obj2$coef)), signif(c(1.0237, 0.6141)))

	idx <- sample(nrow(pheno))
	pheno <- pheno[idx, ]
	obj <- glmmkin(y.repeated ~ sex, data = pheno, kins = kins, id = "id",random.slope = NULL, family = gaussian(link = "identity"))
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(y.repeated ~ sex, data = pheno, kins = NULL, id = "id",random.slope = NULL, family = gaussian(link = "identity"))
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)

	idx <- sample(nrow(kins))
	kins <- kins[idx, idx]
	obj <- glmmkin(y.repeated ~ sex, data = pheno, kins = kins, id = "id",random.slope = NULL, family = gaussian(link = "identity"))
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(y.repeated ~ sex, data = pheno, kins = NULL, id = "id",random.slope = NULL, family = gaussian(link = "identity"))
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
})

test_that("longitudinal random time trend gaussian", {
	skip_on_cran()

	data(example)
	suppressWarnings(RNGversion("3.5.0"))
	set.seed(123)
	pheno <- example$pheno2
	kins <- example$GRM
	obj1 <- glmmkin(y.trend ~ sex + time, data = pheno, kins = kins, id = "id",random.slope = "time", family = gaussian(link = "identity"))
	expect_equal(signif(as.numeric(obj1$theta), digits = 5), signif(c(2.0139758, 1.5056913, 0.5443502, 1.2539360, -0.2469174, 1.1690885, 0.6931906), digits = 5))
	expect_equal(signif(as.numeric(obj1$coef)), signif(c(1.1834620, 0.6320665, 1.0701016)))
	obj2 <- glmmkin(y.trend ~ sex + time, data = pheno, kins = NULL, id = "id",random.slope = "time", family = gaussian(link = "identity"))
	expect_equal(signif(as.numeric(obj2$theta)), signif(c(2.0139758, 1.8949301, 0.8748916, 1.7403904)))
	expect_equal(signif(as.numeric(obj2$coef), digits = 5), signif(c(1.1532040, 0.6177671, 1.0189475), digits = 5))

	idx <- sample(nrow(pheno))
	pheno <- pheno[idx, ]
	obj <- glmmkin(y.trend ~ sex + time, data = pheno, kins = kins, id = "id",random.slope = "time", family = gaussian(link = "identity"))
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(y.trend ~ sex + time, data = pheno, kins = NULL, id = "id",random.slope = "time", family = gaussian(link = "identity"))
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)

	idx <- sample(nrow(kins))
	kins <- kins[idx, idx]
	obj <- glmmkin(y.trend ~ sex + time, data = pheno, kins = kins, id = "id",random.slope = "time", family = gaussian(link = "identity"))
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(y.trend ~ sex + time, data = pheno, kins = NULL, id = "id",random.slope = "time", family = gaussian(link = "identity"))
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
})

test_that("multiple phenotypes gaussian", {
	skip_on_cran()

	data(example)
	suppressWarnings(RNGversion("3.5.0"))
	set.seed(103)
	kins <- example$GRM
	tau1 <- matrix(c(3,0.5,0,0.5,2.5,-0.1,0,-0.1,3),3,3)
	tau2 <- matrix(c(2.5,0.8,0.2,0.8,4.8,-0.1,0.2,-0.1,2.8),3,3)
	kins.chol <- chol(tau1 %x% kins + tau2 %x% diag(400))
	tmp <- as.vector(crossprod(kins.chol, rnorm(1200)))
	x1 <- rnorm(400)
	x2 <- rbinom(400,1,0.5)
	pheno <- data.frame(id = 1:400, x1 = x1, x2 = x2, y1 = 0.5*x1+0.8*x2+tmp[1:400], y2 = x1-0.3*x2+tmp[401:800], y3 = x2+tmp[801:1200])
	obj1 <- glmmkin(cbind(y1,y2,y3)~x1+x2, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"))
	expect_equal(signif(c(as.vector(obj1$theta[[1]]),as.vector(obj1$theta[[2]])), digits = 5), signif(c(3.13246847, 1.52966809, 0.27819033, 1.52966809, 5.21123625, -1.87847885, 0.27819033, -1.87847885, 3.04660044, 1.69332546, -0.36423974, -0.07708463, -0.36423974, 2.07095534, 1.62893810, -0.07708463, 1.62893810, 2.61803110), digits = 5))
	expect_equal(signif(c(obj1$coef)), signif(c(0.20216323, 0.30601599, 0.74140916, 0.04119201, 1.04136078, -0.40556256, 1.08891927, 0.02044031, 1.01281152)))
	obj2 <- glmmkin(cbind(y1,y2,y3)~x1+x2, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"))
	expect_equal(signif(c(obj2$theta[[1]])), signif(c(4.6708159, 1.1614428, 0.1580549, 1.1614428, 7.2537122, -0.2297423, 0.1580549, -0.2297423, 5.6175721)))
	expect_equal(signif(c(obj2$coef), digits = 5), signif(c(0.13897937, 0.31965037, 0.77867243, 0.26349000, 1.03272869, -0.46414252, 1.25165117, 0.01778239, 0.95851562), digits = 5))

	idx <- sample(nrow(pheno))
	pheno <- pheno[idx, ]
	obj <- glmmkin(cbind(y1,y2,y3)~x1+x2, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"))
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(cbind(y1,y2,y3)~x1+x2, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"))
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)

	idx <- sample(nrow(kins))
	kins <- kins[idx, idx]
	obj <- glmmkin(cbind(y1,y2,y3)~x1+x2, data = pheno, kins = kins, id = "id", family = gaussian(link = "identity"))
	expect_equal(obj1$theta, obj$theta)
	expect_equal(obj1$coef, obj$coef)
	obj <- glmmkin(cbind(y1,y2,y3)~x1+x2, data = pheno, kins = NULL, id = "id", family = gaussian(link = "identity"))
	expect_equal(obj2$theta, obj$theta)
	expect_equal(obj2$coef, obj$coef)
})

Try the GMMAT package in your browser

Any scripts or data that you put into this service are public.

GMMAT documentation built on Nov. 17, 2023, 5:07 p.m.