Nothing
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))])
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.