> # test.glmnet.R: glmnetUtils tests for plotmo and plotres
> 
> source("test.prolog.R")
> library(earth)
Loading required package: Formula
Loading required package: plotmo
Loading required package: plotrix
> library(glmnetUtils)
> data(ozone1)
> data(etitanic)
> get.tit <- function() # abbreviated titanic data
+ {
+     tit <- etitanic
+     pclass <- as.character(tit$pclass)
+     # change the order of the factors so not alphabetical
+     pclass[pclass == "1st"] <- "first"
+     pclass[pclass == "2nd"] <- "class2"
+     pclass[pclass == "3rd"] <- "classthird"
+     tit$pclass <- factor(pclass, levels=c("class2", "classthird", "first"))
+     # log age is so we have a continuous predictor even when model is age~.
+     set.seed(2015)
+     tit$logage <- log(tit$age) + rnorm(nrow(tit))
+     tit$parch <- NULL
+     # by=12 gives us a small fast model with an additive and a interaction term
+     tit <- tit[seq(1, nrow(etitanic), by=12), ]
+ }
> plotmores <- function(object, ..., trace=0, SHOWCALL=TRUE, title.extra="", ncol=2) {
+     old.par <- par(no.readonly=TRUE)
+     on.exit(par(old.par))
+     par(mfrow=c(2,ncol))
+     caption <- paste(deparse(substitute(object)), collapse=" ")
+     call <- match.call(expand.dots=TRUE)
+     call <- strip.space(paste(deparse(substitute(call)), collapse=" "))
+     call <- gsub(",", ", ", call)
+     call <- paste(title.extra, call, sep="")
+     printf("%s\n", call)
+     # plotmo on glmnet mods is boring but we test it anyway
+     plotres(object, trace=trace, SHOWCALL=SHOWCALL, do.par=FALSE, which=c(1,3), ...)
+     title(paste("\n", call), outer=TRUE)
+     plotmo(object, trace=trace, SHOWCALL=SHOWCALL, do.par=FALSE, ...)
+ }
> tit <- get.tit()
> set.seed(2015)
> xmat <- as.matrix(tit[,c(2,5,6)])
> agedata <- data.frame(tit[,4], xmat)
> colnames(agedata) <- c("age", "survived", "sibsp", "logage")
> set.seed(2015)
> mod.glmnet.xmat <- glmnet(xmat, tit[,4]) # tit[,4] is age
> plotres(mod.glmnet.xmat)
> plotmo(mod.glmnet.xmat)
 plotmo grid:    survived sibsp  logage
                        0     0 3.06991
> plotmores(mod.glmnet.xmat, predict.s=2.5)
plotmores(object=mod.glmnet.xmat, predict.s=2.5)
 plotmo grid:    survived sibsp  logage
                        0     0 3.06991
> 
> mod.glmnet.agedata <- glmnet(age~., data=agedata)
> expect.err(try(plotres(mod.glmnet.agedata)), "for this plot, glmnet.formula must be called with use.model.frame=TRUE")
Error : for this plot, glmnet.formula must be called with use.model.frame=TRUE
Got expected error from try(plotres(mod.glmnet.agedata))
> mod.glmnet.agedata <- glmnet(age~., data=agedata, use.model.frame=TRUE)
> plotmores(mod.glmnet.agedata, predict.s=2.5)
plotmores(object=mod.glmnet.agedata, predict.s=2.5)
 plotmo grid:    survived sibsp  logage
                        0     0 3.06991
> 
> set.seed(2015)
> mod.cv.glmnet.xmat <- cv.glmnet(xmat, tit[,4], nfolds=3)
> 
> cat("==Test plotmo trace=1 and lambda.min\n")
==Test plotmo trace=1 and lambda.min
> plotmores(mod.cv.glmnet.xmat, predict.s="lambda.min", trace=1, ncol=3)
plotmores(object=mod.cv.glmnet.xmat, predict.s="lambda.min", trace=1, ncol=3)
stats::residuals(object=cv.glmnet.object, type="response")
residuals() was unsuccessful, will use predict() instead
stats::predict(cv.glmnet.object, matrix[3,3], type="response", s="lambda.min")
stats::fitted(object=cv.glmnet.object)
fitted() was unsuccessful, will use predict() instead
got model response from getCall(object)$y
graphics::plot(cv.glmnet.object)

training rsq 0.29
stats::predict(cv.glmnet.object, matrix[3,3], type="response", s="lambda.min")
stats::fitted(object=cv.glmnet.object)
fitted() was unsuccessful, will use predict() instead
got model response from getCall(object)$y

 plotmo grid:    survived sibsp  logage
                        0     0 3.06991

> 
> set.seed(2015)
> mod.cv.glmnet.agedata <- cv.glmnet(age~., data=agedata)
> expect.err(try(plotres(mod.cv.glmnet.agedata)), "for this plot, cv.glmnet.formula must be called with use.model.frame=TRUE")
Error : for this plot, cv.glmnet.formula must be called with use.model.frame=TRUE
Got expected error from try(plotres(mod.cv.glmnet.agedata))
> set.seed(2015)
> mod.cv.glmnet.agedata <- cv.glmnet(age~., data=agedata, use.model.frame=TRUE)
> cat("==Test lambda.min\n")
==Test lambda.min
> plotmores(mod.cv.glmnet.agedata, predict.s="lambda.min", trace=1, ncol=3)
plotmores(object=mod.cv.glmnet.agedata, predict.s="lambda.min", trace=1, ncol=3)
stats::residuals(object=cv.glmnet.formula.object, type="response")
residuals() was unsuccessful, will use predict() instead
stats::predict(cv.glmnet.formula.object, data.frame[3,3], type="response",
               s="lambda.min")
stats::fitted(object=cv.glmnet.formula.object)
fitted() was unsuccessful, will use predict() instead
got model response from model.frame(age ~ survived + sibsp + logage,
                                    data=call$data, na.action="na.omit")
graphics::plot(cv.glmnet.formula.object)

training rsq 0.33
stats::predict(cv.glmnet.formula.object, data.frame[3,3], type="response",
               s="lambda.min")
stats::fitted(object=cv.glmnet.formula.object)
fitted() was unsuccessful, will use predict() instead
got model response from model.frame(age ~ survived + sibsp + logage,
                                    data=call$data, na.action="na.omit")

 plotmo grid:    survived sibsp  logage
                        0     0 3.06991

> 
> printf("======== binomial model\n")
======== binomial model
> 
> set.seed(2016)
> n <- 50
> p <- 4
> xx <- matrix(rnorm(n*p), n, p)
> colnames(xx) <- paste("x", 1:ncol(xx), sep="")
> yy <- ifelse(xx[,1] + xx[,2] + rnorm(n) > .5, TRUE, FALSE)
> print(cov(xx, yy))
         [,1]
x1 0.19664644
x2 0.19303946
x3 0.11937700
x4 0.03037754
> yy <- factor(yy)
> dataxy <- data.frame(yy, xx)
> binomial.mod <- glmnet(xx, yy, family="binomial")
> plotmores(binomial.mod, ncol=3)
plotmores(object=binomial.mod, ncol=3)
 plotmo grid:    x1          x2        x3         x4
         -0.2965405 -0.03311923 0.2416254 0.01017809
> binomial.mod.form <- glmnet(yy~., data=dataxy, family="binomial", use.model.frame=TRUE)
> plotmores(binomial.mod.form, ncol=3)
plotmores(object=binomial.mod.form, ncol=3)
 plotmo grid:    x1          x2        x3         x4
         -0.2965405 -0.03311923 0.2416254 0.01017809
> par(org.par)
> 
> printf("======== glmnet family=\"mgaussian\"\n")
======== glmnet family="mgaussian"
> set.seed(2015)
> p <- 10
> n <- 30
> xx <- cbind((1:n)/n, matrix(rnorm(n*(p-1)),n,p-1))
> colnames(xx) <- paste0("x", 1:p)
> # ymultresp <- cbind(rowSums(xx[,1:5]^3), rowSums(xx[,5:p]^3), 1:n)
> set.seed(1)
> ymultresp <- cbind(xx[,1]+.001*rnorm(n), rowSums(xx[,2:5]^3), rnorm(n))
> glmnet.mgaussian <- glmnet(xx, ymultresp, family="mgaussian")
> plotres(glmnet.mgaussian, nresponse=1, SHOWCALL=TRUE, which=c(1:3), do.par=2, info=1)
> # manually calculate the residuals
> plot(x=predict(glmnet.mgaussian, newx=xx, s=0)[,1,1],
+      y=ymultresp[,1] - predict(glmnet.mgaussian, newx=xx, s=0)[,1,1],
+      pch=20, xlab="Fitted", ylab="Residuals",
+      main="Manually calculated residuals, nresponse=1, s=0")
> abline(h=0, col="gray")
> par(org.par)
> 
> # # TODO is glmnet mgaussian supported with a formula interface?
> # dataxy <- data.frame(ymultresp, xx)
> # colnames(dataxy) <- c("y1", "y2", "y3", "x1", "x2", "x3", "x4", "x5", "x5", "x6", "x7", "x8", "x9", "x10")
> # glmnet.mgaussian.form <- glmnet(xx, ymultresp, family="mgaussian")
> # plotres(glmnet.mgaussian.form, nresponse=1, SHOWCALL=TRUE, which=c(1:3), do.par=2, info=1)
> 
> par(mfrow=c(2,3), mar=c(3,3,3,.5), oma=c(0,0,3,0), mgp=c(1.5,0.4,0), tcl=-0.3)
> 
> data(trees)
> set.seed(2015)
> # variable with a long name
> x50 <- cbind(trees[,1:2], Girth12345678901234567890=rnorm(nrow(trees)))
> mod.with.long.name <- glmnet(data.matrix(x50),data.matrix(trees$Volume))
> plotmores(mod.with.long.name, ncol=3)
plotmores(object=mod.with.long.name, ncol=3)
 plotmo grid:    Girth Height Girth12345678901234567890
                  12.9     76               0.004544606
> data.x50 <- data.frame(trees$Volume, x50)
> colnames(data.x50) <- c("Volume",  "Girth", "Height", "Girth12345678901234567890")
> mod.with.long.name.form <- glmnet(Volume~., data=data.x50, use.model.frame=TRUE)
> plotmores(mod.with.long.name.form, ncol=3)
plotmores(object=mod.with.long.name.form, ncol=3)
 plotmo grid:    Girth Height Girth12345678901234567890
                  12.9     76               0.004544606
> par(org.par)
> 
> #-- make sure that we can work with all families
> 
> set.seed(2016)
> par(mfrow=c(3,3), mar=c(3,3,3,1))
> n <- 100
> p <- 4
> xx <- matrix(rnorm(n*p), n, p)
> g2 <- sample(1:2, n, replace=TRUE)
> data.xg2 <- data.frame(g2, xx)
> for(family in c("gaussian","binomial","poisson")) {
+     title.extra <- paste(family, ": ")
+     mod <- glmnet(xx,g2,family=family)
+     plotmores(mod, xvar="lambda", ncol=3, title.extra=title.extra)
+     title.extra <- paste("formula", family, ": ")
+     mod.form <- glmnet(g2~., data.xg2, family=family, use.model.frame=TRUE)
+     plotmores(mod.form, xvar="lambda", ncol=3, title.extra=title.extra)
+ }
gaussian : plotmores(object=mod, xvar="lambda", title.extra=title.extra, ncol=3)
 plotmo grid:    x1        x2         x3        x4
         -0.2662071 0.1805768 0.03613807 0.2422419
formula gaussian : plotmores(object=mod.form, xvar="lambda", title.extra=title.extra, ncol=3)
 plotmo grid:    X1        X2         X3        X4
         -0.2662071 0.1805768 0.03613807 0.2422419
binomial : plotmores(object=mod, xvar="lambda", title.extra=title.extra, ncol=3)
 plotmo grid:    x1        x2         x3        x4
         -0.2662071 0.1805768 0.03613807 0.2422419
formula binomial : plotmores(object=mod.form, xvar="lambda", title.extra=title.extra, ncol=3)
 plotmo grid:    X1        X2         X3        X4
         -0.2662071 0.1805768 0.03613807 0.2422419
poisson : plotmores(object=mod, xvar="lambda", title.extra=title.extra, ncol=3)
 plotmo grid:    x1        x2         x3        x4
         -0.2662071 0.1805768 0.03613807 0.2422419
formula poisson : plotmores(object=mod.form, xvar="lambda", title.extra=title.extra, ncol=3)
 plotmo grid:    X1        X2         X3        X4
         -0.2662071 0.1805768 0.03613807 0.2422419
> par(org.par)
> # cox
> library(plotmo)
> n <- 100
> p <- 20
> nzc <- trunc(p/10)
> set.seed(2016)
> beta <- rnorm(nzc)
> x7 <- matrix(rnorm(n*p), n, p)
> beta <- rnorm(nzc)
> fx <- x7[,seq(nzc)] %*% beta/3
> hx <- exp(fx)
> ty <- rexp(n, hx)
> tcens <- rbinom(n=n, prob=.3, size=1)# censoring indicator
> yy <- cbind(time=ty, status=1-tcens) # yy=Surv(ty,1-tcens) with library(survival)
> glmnet.cox <- glmnet(x=x7, y=yy, family="cox")
> plotmores(glmnet.cox, ncol=3, degree1=1:4)
plotmores(object=glmnet.cox, degree1=1:4, ncol=3)
 plotmo grid:    x1        x2        x3        x4        x5          x6
         -0.2662071 0.1805768 0.1144668 0.2262892 0.1050429 -0.02858422
         x7         x8        x9       x10        x11        x12       x13
 -0.0799275 0.08172409 -0.107284 0.2036831 0.08643651 -0.0435986 0.1664937
          x14        x15       x16       x17        x18        x19         x20
 -0.003946797 -0.1313896 0.1714765 0.2209166 -0.2018331 -0.1230542 -0.04088624
> par(org.par)
> # TODO formula interface not tested for cox models
> 
> source("test.epilog.R")
