tests/testthat/test-gldrm.R In gldrm: Generalized Linear Density Ratio Models

```simData <- function(n, p, betaMax, link, ySim)
{
beta <- c(0, seq(-betaMax, betaMax, length.out=p))
x <- cbind(1, matrix(rnorm(n*p), nrow=n))
eta <- as.vector(x %*% beta)
y <- ySim(n, mu)

list(x=x, y=y, eta=eta, mu=mu, beta=beta)
}

test_that("gldrm and gldrmFit match", {
set.seed(100)
ySim <- function(n, mu) rgamma(n, 1, scale=mu)
dat <- simData(n=100, p=5, betaMax=0, lf, ySim)
m1[c("formula", "data", "link", "offset")] <- NULL
expect_equal(m1, m2, tolerance=1e-3, check.attributes=FALSE)
})

test_that("gldrm matches intercept-only (empirical distribution) model", {
set.seed(100)
ySim <- function(n, mu) rpois(n, 1)
dat <- simData(n=100, p=0, betaMax=0, make.link("identity"), ySim)

m1 <- as.vector(table(dat\$y)) / length(dat\$y)
m2 <- gldrm(dat\$y~dat\$x-1, data=NULL, link="identity")  # link function doesn't matter with no covariates
fcorr <- c(gldrm:::getTheta(spt=m2\$spt, f0=m2\$f0, mu=mean(dat\$y), sampprobs=NULL, ySptIndex=1)\$fTilt)  # tilt f0 so mean = mean(y)

## this is an intercept-only model, so all observations have fitted mean equal to mean(y)
expect_equal(mean(dat\$y), m2\$beta, check.attributes=FALSE)
## f0 should match response frequency table
expect_equal(m1, fcorr)
})

test_that("gldrm matches logistic regression", {
set.seed(100)
ySim <- function(n, mu) rbinom(n, 1, mu)
dat <- simData(n=100, p=5, betaMax=.5, make.link("logit"), ySim)

m1 <- with(dat, glm(y ~ -1 + x, family=binomial(link="logit")))

## SPGLM should match logistic regression coefficient estimates
## (semiparametric model is identical to fully parametric in this case)
expect_equal(as.vector(coef(m1)), m2\$beta, tolerance=1e-7, check.attributes=FALSE)
})

test_that("Can handle muHat on boundary of spt", {
n <- 10
y <- rep(c(0, 1), each=n/2)
x <- cbind(1, y)

expect_equal(m1\$beta, c(0, 1), check.attributes=FALSE)

expect_equal(m2\$mu, y)
})

test_that("Can handle singular covariate matrix", {
n <- 10
y <- rep(c(0, 1), each=n/2)
x <- matrix(1, nrow=n, ncol=2)