From 8f037a1ad0ecd74a3fefc3d8bbc686805a006610 Mon Sep 17 00:00:00 2001 From: Klaus Holst Date: Mon, 6 Jan 2025 13:05:19 +0100 Subject: [PATCH] fixing nosuggests msg --- R/matrices.R | 15 ++++++++++----- tests/testthat/test-influence.R | 21 ++++++++++++--------- 2 files changed, 22 insertions(+), 14 deletions(-) diff --git a/R/matrices.R b/R/matrices.R index 7c3fdd35..9781bb70 100644 --- a/R/matrices.R +++ b/R/matrices.R @@ -213,10 +213,16 @@ mat.lvm <- function(x,ii=index(x),...) { parBelongsTo <- lapply(parBelongsTo,function(x) sort(unique(x))) - - return(list(mean=cbind(idxM,pidxM), - reg=cbind(idxA,pidxA), - cov=cbind(idxP,pidxP), + meanl <- idxM + if (!is.null(meanl)) meanl <- cbind(meanl, pidxM) + regl <- idxA + if (!is.null(regl)) regl <- cbind(regl, pidxA) + covl <- idxP + if (!is.null(covl)) covl <- cbind(covl, pidxP) + + return(list(mean=meanl, + reg=regl, + cov=covl, epar=ee, parval=parval, constrain.idx=constrain.idx, @@ -225,7 +231,6 @@ mat.lvm <- function(x,ii=index(x),...) { } - matrices.lvm <- function(x,pars,meanpar=NULL,epars=NULL,data=NULL,...) { ii <- index(x) pp <- c(rep(NA,ii$npar.mean),pars,epars) diff --git a/tests/testthat/test-influence.R b/tests/testthat/test-influence.R index 7fe3ebfa..bacf5a41 100644 --- a/tests/testthat/test-influence.R +++ b/tests/testthat/test-influence.R @@ -1,34 +1,35 @@ context("Influence functions") test_that("GEE", { - require("geepack") + if (requireNamespace("geepack",quietly=TRUE)) { d <- lvm(y ~ x, ~ id) |> distribution(~id, uniform.lvm(value=seq(1:20))) |> sim(100, seed=1) d0 <- d[order(d$id), ] - g <- geeglm(y ~ x, data=d0, id=d0$id) + g <- geepack::geeglm(y ~ x, data=d0, id=d0$id) V <- summary(g)$cov.scaled g0 <- glm(y ~ x, data=d) V0 <- vcov(estimate(g0, id = d$id)) testthat::expect_true(sum((V - V0)^2) < 1e-12) + } }) - test_that("merge, IC, estimate with 'id' argument", { - require("geepack") d <- data.frame(id=c("a","a","b","b","b","b","c","c","d"), id1=c("a","a","b1","b1","b2","b2","c","c","d"), y=rnorm(9), x=rnorm(9)) d$id0 <- as.numeric(as.factor(d$id)) l <- glm(y ~ x, data=d) - V <- summary(geeglm(y ~ x, id=d$id0, data=d))$cov.scaled - V0 <- vcov(estimate(l, id=d$id)) - testthat::expect_true(sum((V - V0)^2) < 1e-12) - e1 <- estimate(l, id=d$id1) + V0 <- vcov(e) V1 <- vcov(estimate(e1, id=c(1,2,2,3,4))) - testthat::expect_true(sum((V - V1)^2) < 1e-12) + + if (requireNamespace("geepack",quietly=TRUE)) { + V <- summary(geepack::geeglm(y ~ x, id=d$id0, data=d))$cov.scaled + testthat::expect_true(sum((V - V0)^2) < 1e-12) + testthat::expect_true(sum((V - V1)^2) < 1e-12) + } e <- merge(estimate(l), estimate(l), id=list(d$id, d$id1)) testthat::expect_true(sum((vcov(e1) - vcov(e)[3:4,3:4])^2) < 1e-12) @@ -47,6 +48,7 @@ test_that("negative binomial regression (glm.nb)", { x <- rnorm(n) lam <- z * exp(x) y <- rpois(n, lam) + if (requireNamespace("MASS",quietly=TRUE)) { m <- MASS::glm.nb(y ~ x) testthat::expect_true(abs(lava:::logL.glm(m) - logLik(m)) < 1e-6) p <- coef(m)+1 @@ -57,6 +59,7 @@ test_that("negative binomial regression (glm.nb)", { u1 <- as.vector(numDeriv::jacobian(function(p) lava:::logL.glm(m, p = p), p)) u2 <- score(m, p = p) testthat::expect_true(sum((u1 - u2)^2) < 1e-6) + } })