tests/testthat/test-auto-ttest.R

In LMMstar: Repeated Measurement Models for Discrete Times

### test-auto-ttest.R --- 
##----------------------------------------------------------------------
## Author: Brice Ozenne
## Created: May 31 2021 (15:20) 
## Version: 
## Last-Updated: jul 31 2023 (18:07) 
##           By: Brice Ozenne
##     Update #: 56
##----------------------------------------------------------------------
## 
### Commentary: 
## 
### Change Log:
##----------------------------------------------------------------------
## 
### Code:

if(FALSE){
    library(testthat)
    library(lava)
    library(multcomp)
    library(nlme)

    library(LMMstar)
}

context("Check lmm on examples of t-tests")
LMMstar.options(optimizer = "FS", method.numDeriv = "Richardson", precompute.moments = TRUE,
                columns.confint = c("estimate","se","df","lower","upper","p.value"))

## * single t-test
## ** simulate data
n <- 15
p <- 3
X.name <- paste0("X",1:p)
link.lvm <- paste0("Y~",X.name)
formula.lvm <- as.formula(paste0("Y~",paste0(X.name,collapse="+")))

m <- lvm(formula.lvm)
distribution(m,~Id) <- Sequence.lvm(a = 1, b = n)
distribution(m,~Gender.num) <- binomial.lvm()
distribution(m,~X3) <- binomial.lvm(size=2)
transform(m,Gene~X3) <- function(x){factor(x,levels=0:2,labels=c("LL","LA","AA"))}
transform(m,Gender~Gender.num) <- function(x){factor(x,levels=0:1,labels=c("M","F"))}
transform(m,id~Gender.num) <- function(x){paste0("id",1:NROW(x))}
latent(m) <- ~Gender.num+X3
set.seed(10)
d <- lava::sim(m,n, latent = FALSE)
d$time <- "t1"

## ** test
test_that("single t-test",{
    e.lmm <- lmm(Y ~ Gender-1, repetition = ~Gender|id, data = d, trace = 0, df = TRUE)
    e2.lmm <- lmm(Y ~ Gender, repetition = ~Gender|id, data = d, trace = 0, df = TRUE)

    ## e3.lmm <- lmm(Y ~ Gender, repetition = ~Gender|id, structure = "UN", data = d, trace = 0)
    e.gls <- gls(Y ~ Gender, weights = varIdent(form=~1|Gender), data = d)
    e.ttest <- t.test(Y~Gender, data = d)
    
    expect_equal(as.double(logLik(e.lmm)),as.double(logLik(e.gls)))
    expect_equal(as.double(logLik(e2.lmm)),as.double(logLik(e.gls)))
    expect_equal(sort(unname(e.ttest$estimate)), sort(unname(coef(e.lmm, effects = "mean"))))
    expect_equal(e.ttest$p.value, anova(e.lmm, effects = c("GenderM-GenderF=0"))$multivariate$p.value, tol = 1e-5)
    expect_equal(e.ttest$p.value, confint(e2.lmm)["GenderF","p.value"], tol = 1e-5)
    ## summary(e.gls)$tTable
    ## summary(e.lmm)$tTable
})
## summary(anova(e.lmm))
## summary(anova(e2.lmm))
## summary(e.lmm)

## * paired t-test
data(armd.wide, package = "nlmeU")
subjCC <- armd.wide[!is.na(armd.wide$visual0) & !is.na(armd.wide$visual52),"subject"]
armd.wideCC <- armd.wide[armd.wide$subject %in% subjCC,]
armd.longCC <- reshape2::melt(armd.wideCC, 
                              id.var = c("subject","treat.f","lesion","miss.pat"),
                              measure.vars = c("visual0","visual4","visual12","visual24","visual52"),
                              variable.name = "week", 
                              value.name = "visual")
armd.longCC$week <- factor(armd.longCC$week, 
                         level = c("visual0","visual4","visual12","visual24","visual52"), 
                         labels = c(0,4,12,24,52))
rownames(armd.longCC) <- NULL

test_that("paired t-test",{
    ## LMMstar.options(optimizer = "FS")
    e.tt <- t.test(visual52-visual0 ~ treat.f, data = armd.wideCC)
    e.lmm <- suppressMessages(lmm(visual ~ week*treat.f, 
                                 repetition = ~ week | subject, structure = "UN",
                                 data = armd.longCC[armd.longCC$week %in% c("0","52"),]))
    e.confintlmm <- confint(e.lmm)
    expect_equivalent(abs(diff(e.tt$estimate)), abs(e.confintlmm["week52:treat.fActive","estimate"]), tol = 1e-5)
    ## expect_equivalent(e.tt$stderr, e.confintlmm["week52:treat.fActive","se"], tol = 1e-5) ##  difference 0.01 (2.28 vs. 2.29)
    ## expect_equivalent(e.tt$parameter, e.confintlmm["week52:treat.fActive","df"], tol = 1e-5) ##  difference 1.5 (191.5 vs 193)
    
})


## * multiple t-test
## ** simulate data
m <- lvm(c(Y1,Y2,Y3,Y4) ~ age + gender)
categorical(m, labels = c("male","female")) <- ~gender
transform(m, id~gender) <- function(x){1:NROW(x)}
distribution(m, ~age) <- gaussian.lvm(mean = 50, sd = 10)

set.seed(10)
dW <- lava::sim(m, 30)

## move to the long format
name.varying <- paste0("Y",1:4)
dL <- reshape(dW, direction  = "long",
              idvar = c("id","age","gender"),
              varying = name.varying,
              v.names = "Y",
              timevar = "visit")
rownames(dL) <- NULL
dL$visit <- factor(dL$visit,
                   levels = 1:length(name.varying),
                   labels = name.varying)
 

## ** test
test_that("multiple t-test",{
    ## profvis::profvis(e.lmm <- lmm(Y ~ visit + gender:visit - 1, structure = UN(gender~visit|id), data = dL, trace = 0))
    e.lmm <- lmm(Y ~ visit:gender - 1, repetition = gender~visit|id, structure = "UN", data = dL, trace = 0, df = TRUE)
    e.lh <- anova(e.lmm, effects = c("gender:Y1"="visitY1:gendermale - visitY1:genderfemale = 0",
                                     "gender:Y2"="visitY2:gendermale - visitY2:genderfemale = 0",
                                     "gender:Y3"="visitY3:gendermale - visitY3:genderfemale = 0",
                                     "gender:Y4"="visitY4:gendermale - visitY4:genderfemale = 0"))
    
    ## check likelihood and score
    expect_equal(logLik(e.lmm), -240.1934, tol = 1e-5)

    e.gls <- gls(Y ~ visit + visit:gender, correlation = corSymm(form=~1|id), weights = varIdent(form=~1|visit), data = dL)
    ls.ttest <- list(t.test(Y1~gender, data = dW),
                     t.test(Y2~gender, data = dW),
                     t.test(Y3~gender, data = dW),
                     t.test(Y4~gender, data = dW))
    ## print(e.lh, method = "none")

    expect_equal(confint(e.lh)$se, sapply(ls.ttest,"[[","stderr"), tol = 1e-5)
    expect_equal(as.double(unlist(confint(e.lh, method = "none")$df)),
                 as.double(do.call(rbind,lapply(ls.ttest,"[[","parameter"))), tol = 1e-1)
    expect_equal(as.double(unlist(confint(e.lh, method = "none")[,c("lower","upper")])),
                 as.double(do.call(rbind,lapply(ls.ttest,"[[","conf.int"))), tol = 1e-3)
})



##----------------------------------------------------------------------
### test-auto-ttest.R ends here