tests/testthat/test-logistic-dma.R

In hanase/dma: Dynamic Model Averaging

context('Logistic DMA')

generate.data <- function() {
    #simulate some data to test
    coef <- c(.08,-.4,-.1)
    coefmat <- cbind(rep(coef[1],200),rep(coef[2],200),rep(coef[3],200))
    #then, dynamic ones
    coefmat <- cbind(coefmat,seq(1,.45,length.out=nrow(coefmat)),
                     seq(-.75,-.15,length.out=nrow(coefmat)),
                     c(rep(-1.5,nrow(coefmat)/2),rep(-.5,nrow(coefmat)/2)))
    npar <- ncol(coefmat)-1
    
    #simulate data
    set.seed(1234)
    dat <- matrix(rnorm(200*(npar),0,1),200,(npar))
    ydat <- exp(rowSums((cbind(rep(1,nrow(dat)),dat))[1:100,]*coefmat[1:100,]))/
        (1+exp(rowSums(cbind(rep(1,nrow(dat)),dat)[1:100,]*coefmat[1:100,])))
    y <- c(ydat,exp(rowSums(cbind(rep(1,nrow(dat)),dat)[-c(1:100),c(1,5,6)]*
                                coefmat[-c(1:100),c(1,5,6)]))/
               (1+exp(rowSums(cbind(rep(1,nrow(dat)),dat)[-c(1:100),c(1,5,6)]*
                                  coefmat[-c(1:100),c(1,5,6)]))))
    u <- runif (length(y))
    y <- as.numeric (u < y)
    
    #Consider three candidate models
    mmat <- matrix(c(1,1,1,1,1,0,0,0,1,1,1,0,1,0,1),3,5, byrow = TRUE)
    return(list(dat = dat, y = y, mmat = mmat))
}

run.logistic <- function(lambda = .99, alpha = .99, autotune = FALSE, initialsamp = 20) {
    d <- generate.data()
    # static mode
    ldma.stat <- logistic.dma(d$dat, d$y, d$mmat, lambda = lambda, alpha = alpha, 
                              autotune = autotune, initialsamp = initialsamp)
    
    # Using DMA in a "streaming" mode
    modl <- logdma.init(d$dat[1:20,], d$y[1:20], d$mmat)
    yhat <- matrix(0, ncol=3, nrow=200)
    for(i in 21:200){
        yhat[i,] <- logdma.predict(modl, d$dat[i,])
        modl <- logdma.update(modl, d$dat[i,], d$y[i], 
                              lambda = lambda, autotune = autotune)
    }
    ldma.stream <- logdma.average(modl, alpha = alpha)
    ldma.stream$laplacemodel <- NULL
    ldma.stream$varcov <- NULL
    return(list(stat = ldma.stat, stream = ldma.stream))
}

test_that('Example in logistic.dma without tuning works', {
    ldma <- run.logistic()
    expect_true(length(names(ldma$stat)) == 13)
    expect_equal(dim(ldma$stat$pmp), c(3,200))
    expect_false(any(is.na(ldma$stat$pmp)))
    expect_identical(ldma$stat[order(names(ldma$stat))], 
                     ldma$stream[order(names(ldma$stream))])
})

test_that('Example in logistic.dma with tuning works', {
    skip_on_cran()
    ldma <- run.logistic(autotune = TRUE)
    expect_true(length(names(ldma$stat)) == 13)
    expect_equal(dim(ldma$stat$pmp), c(3,200))
    expect_false(any(is.na(ldma$stat$pmp)))
    expect_identical(ldma$stat[order(names(ldma$stat))], 
                     ldma$stream[order(names(ldma$stream))])
})