diff --git a/R/functions.R b/R/functions.R
index d55451fc0141681a0f7c3060e48bc97ed5455dd1..1cc0df517bfe0579d8e4be4ffb45c7d76b06dcd0 100644
--- a/R/functions.R
+++ b/R/functions.R
@@ -90,7 +90,7 @@
#' \dontrun{
#' browseVignettes("joinet") # further examples}
#'
-joinet <- function(Y,X,family="gaussian",nfolds=10,foldid=NULL,type.measure="deviance",alpha.base=1,alpha.meta=0,...){
+joinet <- function(Y,X,family="gaussian",nfolds=10,foldid=NULL,type.measure="deviance",alpha.base=1,alpha.meta=1,...){
#--- temporary ---
# family <- "gaussian"; nfolds <- 10; foldid <- NULL; type.measure <- "deviance"
@@ -100,7 +100,19 @@ joinet <- function(Y,X,family="gaussian",nfolds=10,foldid=NULL,type.measure="dev
X <- as.matrix(X)
cornet:::.check(x=Y,type="matrix",miss=TRUE)
- if(any(stats::cor(Y,use="pairwise.complete.obs")<0,na.rm=TRUE)){warning("Negative correlation!",call.=FALSE)}
+
+ ### trial start ###
+ for(i in 1:(ncol(Y)-1)){
+ for(j in i:ncol(Y)){
+ cor <- stats::cor.test(Y[,i],Y[,j],use="pairwise.complete.obs")
+ if(cor$statistic<0 & cor$p.value<0.05){
+ warning(paste("Columns",i,"and",j,"are negatively correlated."))
+ }
+ }
+ }
+ ### trial end ###
+
+ #if(any(stats::cor(Y,use="pairwise.complete.obs")<0,na.rm=TRUE)){warning("Negative correlation!",call.=FALSE)}
cornet:::.check(x=X,type="matrix")
#cornet:::.check(x=family,type="vector",values=c("gaussian","binomial","poisson"))
if(nrow(Y)!=nrow(X)){stop("Contradictory sample size.",call.=FALSE)}
@@ -515,11 +527,15 @@ print.joinet <- function(x,...){
#' set.seed(1)
#' cv.joinet(Y=Y,X=X,alpha.base=0) # ridge}
#'
-cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ext=NULL,foldid.int=NULL,type.measure="deviance",alpha.base=1,alpha.meta=1,compare=NULL,mice=FALSE,cvpred=FALSE,...){
+cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ext=NULL,foldid.int=NULL,type.measure="deviance",alpha.base=1,alpha.meta=1,compare=NULL,mice=FALSE,cvpred=FALSE,times=FALSE,...){
if(FALSE){
- nfolds.ext <- 5; nfolds.int <- 10; foldid.ext <- foldid.int <- NULL; type.measure <- "deviance"; alpha.base <- 1; alpha.meta <- 1; compare <- c("mnorm","spls","mars","mrf"); mice <- cvpred <- TRUE
- nfolds.ext <- 1; foldid.ext <- fold; nfolds.int <- 10; foldid.int <- NULL
+ family <- "gaussian"; nfolds.ext <- 5; nfolds.int <- 10; foldid.ext <- foldid.int <- NULL; type.measure <- "deviance"; alpha.base <- alpha.meta <- 1; mice <- cvpred <- times <- FALSE
+ #nfolds.ext <- 1; foldid.ext <- fold; nfolds.int <- 10; foldid.int <- NULL; compare <- TRUE
+ }
+
+ if(!is.null(compare) && length(compare)==1 && compare){
+ compare <- c("mnorm","spls","mars","mrf","map","rmtl","mtps","mcen", "gpm","sier","mrce")
}
n <- nrow(Y)
@@ -546,7 +562,7 @@ cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ex
for(i in seq_along(compare)){
pkg <- switch(compare[i],mnorm="glmnet",mars="earth",spls="spls",mtps="MTPS",
rmtl="RMTL",mrf="MultivariateRandomForest",mcen="mcen",
- map="remMap",stop("Invalid method.",call.FALSE))
+ map="remMap",sier="SiER",gpm="GPM",mrce="MRCE",ecc="MLPUGS",stop("Invalid method.",call.=FALSE))
if(!pkg %in% pkgs){
stop("Method \"",compare[i],"\" requires package \"",pkg,"\".",call.=FALSE)
}
@@ -564,14 +580,23 @@ cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ex
models <- c("base","meta",compare,"none")
pred <- lapply(X=models,function(x) matrix(data=NA,nrow=n,ncol=q))
- names(pred) <- models
+ time <- lapply(X=models,function(x) NA)
+ names(pred) <- names(time) <- models
for(i in seq_len(nfolds.ext)){
Y0 <- Y[foldid.ext!=i,,drop=FALSE]
+ #Y1 <- Y[foldid.ext==i,,drop=FALSE]
X0 <- X[foldid.ext!=i,,drop=FALSE]
X1 <- X[foldid.ext==i,,drop=FALSE]
+ # standardise features (trial)
+ #mu <- apply(X=X0,MARGIN=2,FUN=function(x) mean(x))
+ #sd <- apply(X=X0,MARGIN=2,FUN=function(x) stats::sd(x))
+ #X0 <- t((t(X0)-mu)/sd)[,sd!=0]
+ #X1 <- t((t(X1)-mu)/sd)[,sd!=0]
+ # or standardise once before cv?
+
# remove constant features
cond <- apply(X=X0,MARGIN=2,FUN=function(x) stats::sd(x)!=0)
X0 <- X0[,cond]; X1 <- X1[,cond]
@@ -583,10 +608,14 @@ cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ex
}
# base and meta learners
+ start <- Sys.time()
fit <- joinet(Y=Y0,X=X0,family=family,type.measure=type.measure,alpha.base=alpha.base,alpha.meta=alpha.meta,foldid=foldid) # add ellipsis (...)
+ # also do not standardise!
temp <- predict.joinet(fit,newx=X1)
pred$base[foldid.ext==i,] <- temp$base
pred$meta[foldid.ext==i,] <- temp$meta
+ end <- Sys.time()
+ time$meta <- as.numeric(difftime(end,start,units="secs"))
# missing values
if(mice & any(is.na(Y0))){
@@ -603,32 +632,54 @@ cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ex
# other learners
if("mnorm" %in% compare){
+ cat("mnorm"," ")
+ start <- Sys.time()
+ if(any(family!="gaussian")){
+ stop("mnorm requires \"gaussian\" family.",call.=FALSE)
+ }
net <- glmnet::cv.glmnet(x=X0,y=y0,family="mgaussian",foldid=foldid,alpha=alpha.base) # add ellipsis (...)
pred$mnorm[foldid.ext==i,] <- stats::predict(object=net,newx=X1,s="lambda.min",type="response")
+ end <- Sys.time()
+ time$mnorm <- as.numeric(difftime(end,start,units="secs"))
+ } else {
+ net <- glmnet::glmnet(x=X0,y=y0,family="mgaussian")
}
if("mars" %in% compare){
+ cat("mars"," ")
+ start <- Sys.time()
if(all(family=="gaussian")){
- object <- earth::earth(x=X0,y=y0)
+ object <- earth::earth(x=X0,y=y0,nfold=nfolds.int) # add:pmethod="cv"; new: nfolds and pmethod
+ # equivalent: object <- mda::mars(x=X0,y=y0)
} else if(all(family=="binomial")){
- object <- earth::earth(x=X0,y=y0,glm=list(family=binomial))
+ object <- earth::earth(x=X0,y=y0,glm=list(family=stats::binomial),nfold=nfolds.int) # add pmethod="cv", new: nfolds and pmethod
} else {
- stop("Invalid.",call.=FALSE)
+ stop("MARS requires either \"gaussian\" or \"binomial\" family.",call.=FALSE)
}
pred$mars[foldid.ext==i,] <- earth:::predict.earth(object=object,newdata=X1,type="response")
-
- #object <- mda::mars(x=X0,y=Y0)
- #pred$mars[foldid.ext==i,] <- mda:::predict.mars(object=object,newdata=X1)
+ end <- Sys.time()
+ time$mars <- as.numeric(difftime(end,start,units="secs"))
+ #mean((Y-pred$mars)^2,na.rm=TRUE)
}
if("spls" %in% compare){
- cv.spls <- spls::cv.spls(x=X0,y=y0,fold=nfolds.int,K=seq_len(10),
- eta=seq(from=0.1,to=0.9,by=0.1),plot.it=FALSE)
- object <- spls::spls(x=X0,y=y0,K=cv.spls$K.opt,eta=cv.spls$eta.opt)
+ cat("spls"," ")
+ start <- Sys.time()
+ if(any(family!="gaussian")){
+ stop("spls requires \"gaussian\" family.")
+ }
+ invisible(utils::capture.output(cv.spls <- spls::cv.spls(x=X0,y=y0,fold=nfolds.int,K=seq_len(min(ncol(X0),10)),
+ eta=seq(from=0.1,to=0.9,by=0.1),plot.it=FALSE))) #scale.x=FALSE
+ object <- spls::spls(x=X0,y=y0,K=cv.spls$K.opt,eta=cv.spls$eta.opt) #scale.x=FALSE
pred$spls[foldid.ext==i,] <- spls::predict.spls(object=object,newx=X1,type="fit")
+ end <- Sys.time()
+ time$spls <- as.numeric(difftime(end,start,units="secs"))
}
if("mtps" %in% compare){
+ cat("mtps"," ")
+ start <- Sys.time()
+
if(alpha.base==0){
step1 <- MTPS::glmnet.ridge
} else if(alpha.base==1){
@@ -636,6 +687,7 @@ cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ex
} else {
stop("MTPS requires alpha.base 0 or 1.",call.=FALSE)
}
+
#-------------------------------
#--- manual lambda.min start ---
#body <- body(step1)
@@ -650,14 +702,36 @@ cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ex
#}
#--- manual lambda.min end ---
#-----------------------------
- step2 <- MTPS::rpart1
+
+ #---------------------------
+ #--- manual kmeans start ---
+ #fun <- MTPS::cv.multiFit
+ #body <- body(fun)
+ #body[[11]][[3]][[3]] <- nrow(unique(y0))
+ #body(fun) <- body
+ #assignInNamespace(x="cv.multiFit",value=step1,ns="MTPS")
+ #--- manual kmeans end ---
+ #-------------------------
+
+ if(all(family=="gaussian")){
+ step2 <- MTPS::rpart1
+ } else if(all(family=="binomial")){
+ step2 <- MTPS::glm1
+ } else {
+ stop("MTPS requires family gaussian or binomial.",call.=FALSE)
+ }
+
object <- MTPS::MTPS(xmat=X0,ymat=y0,family=family,nfold=nfolds.int,
- method.step1=step1,method.step2=step2)
+ method.step1=step1,method.step2=step2,cv=TRUE,residual=TRUE)
pred$mtps[foldid.ext==i,] <- MTPS::predict.MTPS(object=object,newdata=X1,type="response")
- # nfold has no effect for cv=FALSE (default)
+ end <- Sys.time()
+ time$mtps <- as.numeric(difftime(end,start,units="secs"))
+ # now using cross-validation residual stacking (CVRS)
}
if("rmtl" %in% compare){
+ cat("rmtl"," ")
+ start <- Sys.time()
if(all(family=="gaussian")){
type <- "Regression"
y0l <- lapply(seq_len(ncol(y0)),function(i) y0[,i,drop=FALSE])
@@ -671,91 +745,180 @@ cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ex
X1l <- lapply(seq_len(ncol(y0)),function(i) X1)
#---------------------------
#--- manual tuning start ---
- Lam2_seq <- 10^seq(from=2,to=-5,length.out=101)
- cvm <- numeric()
+ Lam1_seq <- c(10^seq(from=1,to=-4,length.out=11),0)
+ Lam2_seq <- c(10^seq(from=1,to=-4,length.out=11),0)
+ cvMTL <- list()
+ seed <- .Random.seed
for(j in seq_along(Lam2_seq)){
- set.seed(1)
- cvm[j] <- min(RMTL::cvMTL(X=X0l,Y=y0l,type=type,Lam1=0,Lam2=Lam2_seq[j])$cvm)
+ .Random.seed <- seed
+ cvMTL[[j]] <- RMTL::cvMTL(X=X0l,Y=y0l,type=type,Lam1_seq=Lam1_seq,Lam2=Lam2_seq[j])
}
- #graphics::plot(x=Lam2_seq,y=cvm)
+ cvm <- vapply(X=cvMTL,FUN=function(x) min(x$cvm),FUN.VALUE=numeric(1))
+ Lam1 <- cvMTL[[which.min(cvm)]]$Lam1.min
Lam2 <- Lam2_seq[which.min(cvm)]
+ #graphics::plot(x=Lam2_seq,y=cvm)
+ #cat(Lam1," ",Lam2,"\n")
#--- manual tuning end ----
#--------------------------
- cvMTL <- RMTL::cvMTL(X=X0l,Y=y0l,type=type,Lam2=Lam2)
- MTL <- RMTL::MTL(X=X0l,Y=y0l,type=type,Lam1=cvMTL$Lam1.min)
+ MTL <- RMTL::MTL(X=X0l,Y=y0l,type=type,Lam1=Lam1,Lam2=Lam2)
temp <- RMTL:::predict.MTL(object=MTL,newX=X1l)
pred$rmtl[foldid.ext==i,] <- do.call(what="cbind",args=temp)
+ end <- Sys.time()
+ time$rmtl <- as.numeric(difftime(end,start,units="secs"))
}
if("mrf" %in% compare){
- pred$mrf[foldid.ext==i,] <- MultivariateRandomForest::build_forest_predict(trainX=X0,trainY=Y0,
- n_tree=10,m_feature=floor(ncol(X0)/3),min_leaf=5,testX=X1)
- # use n_tree = 500
+ cat("mrf"," ")
+ start <- Sys.time()
+ if(any(family!="gaussian")){
+ stop("mrf requires \"gaussian\" family.")
+ }
+ pred$mrf[foldid.ext==i,] <- MultivariateRandomForest::build_forest_predict(trainX=X0,trainY=y0,
+ n_tree=100,m_feature=min(ncol(X)-1,5),min_leaf=5,testX=X1)
+ # use n_tree=500, m_feature=floor(ncol(X0)/3)
# alternative: IntegratedMRF
- # Check why this does not work!
+ # Check why this does not work well!
+ end <- Sys.time()
+ time$mrf <- as.numeric(difftime(end,start,units="secs"))
}
if("mcen" %in% compare){
- if(all(family=="gaussian")){mfamily <- "mgaussian"}
- if(all(family=="binomial")){mfamily <- "mbinomial"}
- object <- mcen::cv.mcen(x=X0,y=y0,family=mfamily,folds=foldid,ky=1)
+ cat("mcen"," ")
+ start <- Sys.time()
+ if(all(family=="gaussian")){
+ type <- "mgaussian"
+ } else if(all(family=="binomial")){
+ type <- "mbinomial"
+ } else {
+ stop("mcen requires either \"gaussian\" or \"binomial\".",call.=FALSE)
+ }
+ object <- mcen::cv.mcen(x=X0,y=y0,family=type,folds=foldid,ky=1,
+ gamma_y=seq(from=0.1,to=5.1,length.out=3),ndelta=3)
+ # TEMPORARY gamma_y and ndelta (for speed-up)
temp <- mcen:::predict.cv.mcen(object=object,newx=X1)
pred$mcen[foldid.ext==i,] <- as.matrix(temp)
- # default returns error (thus ky=1)
+ # single cluster (ky=1) due to setting and error
+ end <- Sys.time()
+ time$mcen <- as.numeric(difftime(end,start,units="secs"))
}
if("map" %in% compare){
- #if(alpha.base==0){
- # lamL1.v <- 0
- # lamL2.v <- fit$base$y1$lambda
- #} else if(alpha.base==1){
- # lamL1.v <- fit$base$y1$lambda
- # lamL2.v <- 0
- #} else {
- # stop("")
- #}
+ cat("map"," ")
+ start <- Sys.time()
+ if(any(family!="gaussian")){
+ stop("map requires \"gaussian\" family.")
+ }
mean <- colMeans(y0)
y0s <- y0-matrix(data=mean,nrow=nrow(X0),ncol=ncol(y0),byrow=TRUE)
- temp <- glmnet::glmnet(x=X0,y=y0s,family="mgaussian",intercept=FALSE)
- lamL1.v <- exp(seq(from=log(min(temp$lambda)),to=log(max(temp$lambda)),length.out=30))
- lamL2.v <- seq(from=0,to=5,by=1) # TEMPORARY
+ lamL1.v <- exp(seq(from=log(10),to=log(20),length.out=11))
+ lamL2.v <- seq(from=0,to=5,length.out=11)
cv <- remMap::remMap.CV(X=X0,Y=y0s,lamL1.v=lamL1.v,lamL2.v=lamL2.v)
#graphics::plot(x=lamL1.v,y=log(as.numeric(cv$ols.cv[,3])))
- index <- which(cv$ols.cv==min(cv$ols.cv),arr.ind=TRUE)
+ index <- which(cv$ols.cv==min(cv$ols.cv),arr.ind=TRUE)[1,]
+ #cat(index,"\n")
object <- remMap::remMap(X.m=X0,Y.m=y0s,lamL1=lamL1.v[index[1]],lamL2=lamL2.v[index[2]])
pred$map[foldid.ext==i,] <- matrix(data=mean,nrow=nrow(X1),ncol=ncol(y0),byrow=TRUE) + X1 %*% object$phi
# alternative: groupRemMap
+ end <- Sys.time()
+ time$map <- as.numeric(difftime(end,start,units="secs"))
}
- if(FALSE){ #"mrce" %in% compare
- # bug?
- lam1 <- rev(10^seq(from=-2,to=0,by=0.5))
- lam2 <- rev(10^seq(from=-2,to=0,by=0.5))
- #lam1 <- lam2 <- 10^seq(from=0,to=-0.7,length.out=5)
- #lam2 <- rev(10^seq(from=0,to=2,by=0.5))
- #lam2 <- c(2,1,0.5)
- #lam1 <- 10^seq(from=0,to=-5,length.out=11)
- #lam2 <- seq(from=1,to=0.1,by=-0.1)
- object <- MRCE::mrce(X=X0,Y=y0,lam1.vec=lam1,lam2.vec=lam2,method="cv",silent=FALSE,cov.tol=0.1,tol.out=1e-10)
- pred$mrce[foldid.ext==i,] <- matrix(object$muhat,nrow=nrow(X1),ncol=q,byrow=TRUE) + x1 %*% object$Bhat
- }
-
- if(FALSE){ # "sier" %in% compare
- stop("SiER not yet implemented",call.=FALSE) # slow!
- object <- SiER::cv.SiER(X=X0,Y=y0,K.cv=5,thres=0.5)
+ if("sier" %in% compare){
+ cat("sier"," ")
+ start <- Sys.time()
+ if(any(family!="gaussian")){
+ stop("SiER requires \"gaussian\" family.",call.=FALSE)
+ }
+ invisible(utils::capture.output(object <- SiER::cv.SiER(X=X0,Y=y0,K.cv=5,upper.comp=10,thres=0.01)))
+ # should be upper.comp=10 and thres=0.01
pred$sier[foldid.ext==i,] <- SiER::pred.SiER(cv.fit=object,X.new=X1)
+ end <- Sys.time()
+ time$sier <- as.numeric(difftime(end,start,units="secs"))
}
- if(FALSE){ #"gpm" %in% compare
+ if("gpm" %in% compare){
+ cat("gpm"," ")
+ start <- Sys.time()
if(any(family!="gaussian")){
stop("GPM requires \"gaussian\" family.",call.=FALSE)
}
- object <- GPM::Fit(X=X0,Y=Y0)
+ object <- GPM::Fit(X=X0,Y=y0)
pred$gpm[foldid.ext==i,] <- GPM::Predict(XF=X1,Model=object)$YF
# Check why this does not work!
+ end <- Sys.time()
+ time$gpm <- as.numeric(difftime(end,start,units="secs"))
+ }
+
+ if("mrce" %in% compare){
+ cat("mrce"," ")
+ start <- Sys.time()
+ if(any(family!="gaussian")){
+ stop("MRCE requires \"gaussian\" family.",call.=FALSE) # check this!
+ }
+ lam1 <- lam2 <- 10^seq(from=1,to=-4,length.out=11)
+ invisible(utils::capture.output(trials <- lapply(lam2,function(x) tryCatch(expr=MRCE::mrce(X=X0,Y=y0,lam1.vec=lam1,lam2.vec=x,method="cv"),error=function(x) NULL))))
+ cv.err <- sapply(trials,function(x) ifelse(is.null(x),Inf,min(x$cv.err)))
+ object <- trials[[which.min(cv.err)]]
+ pred$mrce[foldid.ext==i,] <- matrix(object$muhat,nrow=nrow(X1),ncol=q,byrow=TRUE) + X1 %*% object$Bhat
+ end <- Sys.time()
+ time$mrce <- as.numeric(difftime(end,start,units="secs"))
}
- if(FALSE){ "MSGLasso" %in% compare
+ if(!is.null(compare)){cat("\n")}
+
+ #--- development snippets ---
+
+ if(FALSE){ # "ecc"
+ start <- Sys.time()
+ cat("ecc"," ")
+ if(any(family!="binomial")){
+ stop("MLPUGS requires \"binomial\" family.",call.=FALSE)
+ }
+
+ X0f <- as.data.frame(X0)
+ y0f <- as.data.frame(y0)
+ X1f <- as.data.frame(X1)
+
+ if(FALSE){
+ # works!
+ object <- MLPUGS::ecc(x=X0f,y=y0f,.f=stats::glm.fit,family=stats::binomial(link="logit"))
+ pred_glm <- predict(object,X1f,
+ .f = function(glm_fit, newdata) {
+ eta <- as.matrix(newdata) %*% glm_fit$coef
+ output <- glm_fit$family$linkinv(eta)
+ colnames(output) <- "1"
+ return(output)
+ }, n.iters = 10, burn.in = 0, thin = 1)
+ }
+
+ if(FALSE){
+ # fails! respect same form for X0 and X1
+ object <- MLPUGS::ecc(x=X0,y=y0,.f=glmnet::cv.glmnet,family="binomial")
+ #temp <- MLPUGS:::predict.ECC(object,newx=X1,.f=glmnet::predict.cv.glmnet,newdata=X1)
+ pred_glm <- predict(object,X1,
+ .f = function(fit, newdata) {
+ newx <- as.matrix(newdata)
+ pred <- glmnet:::predict.cv.glmnet(fit,newx=newx,s="lambda.min",type="response")
+ return(as.matrix(pred))
+ }, n.iters = 10, burn.in = 0, thin = 1)
+
+ }
+
+ object <- MLPUGS::ecc(x=X0f,y=y0f,.f=randomForest::randomForest)
+ pred_ecc <- predict(object,newdata=X1f,n.iters=300,burn.in=100,thin=2,
+ .f = function(rF,newdata){randomForest:::predict.randomForest(rF, newdata, type = "prob")})
+ # works with n.iter=2 , burn.int=0 and thin=1 (bad choices!)
+ pred$ecc[foldid.ext==i,] <- summary(pred_ecc,type="prob")
+ # default seems to work, too, but might also leads to bad results in the
+ # (unrealistic) simulation
+
+ end <- Sys.time()
+ time$ecc <- as.numeric(difftime(end,start,units="secs"))
+ }
+
+ # if family=="binomial" test whether any pred outside unit interval
+
+ if(FALSE){ # "MSGLasso" %in% compare
MSGLasso::MSGLasso.cv(X=X0,Y=Y0)
# requires many user inputs
}
@@ -801,6 +964,9 @@ cv.joinet <- function(Y,X,family="gaussian",nfolds.ext=5,nfolds.int=10,foldid.ex
if(cvpred){
loss <- list(loss=loss,cvpred=pred$meta)
}
+ if(times){
+ loss <- list(loss=loss,time=time)
+ }
return(loss)
}
diff --git a/docs/articles/joinet.html b/docs/articles/joinet.html
index 5458000a4216a4b34cf6fb14c64f6139c3dab01d..aa0f35af5035367b4bcc5716617556015814073c 100644
--- a/docs/articles/joinet.html
+++ b/docs/articles/joinet.html
@@ -158,95 +158,13 @@
## [,1] [,2]
## base 1.204741 1.523550
-## meta 1.161487 1.283678
+## meta 1.185200 1.278125
## none 3.206394 3.495571
Reference
Armin Rauschenberger and Enrico Glaab (2020). “joinet: predicting correlated outcomes jointly to improve clinical prognosis”. Manuscript in preparation.
-
-
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
index 8fea9c4d2b44234b2a9576ed3861604f04c6d6e0..82a3bc5e7070664e17b0adf89e30a4218a0656c8 100644
--- a/docs/pkgdown.yml
+++ b/docs/pkgdown.yml
@@ -4,5 +4,5 @@ pkgdown_sha: ~
articles:
article: article.html
joinet: joinet.html
-last_built: 2020-06-08T15:55Z
+last_built: 2020-06-29T15:24Z
diff --git a/docs/reference/cv.joinet.html b/docs/reference/cv.joinet.html
index 7a54775ecae35768a6e2e5f6061112d64a1e4dbe..0b39c798304c068089a323228761dae8aec69f59 100644
--- a/docs/reference/cv.joinet.html
+++ b/docs/reference/cv.joinet.html
@@ -140,6 +140,7 @@
compare = NULL,
mice = FALSE,
cvpred = FALSE,
+ times = FALSE,
...
)
diff --git a/docs/reference/joinet.html b/docs/reference/joinet.html
index f6dddadeb78a8833fef56bdde068bc2b9e71ee3f..0989687bd1cb75b5b63a954d3a2d107577a5c16d 100644
--- a/docs/reference/joinet.html
+++ b/docs/reference/joinet.html
@@ -134,7 +134,7 @@
foldid = NULL,
type.measure = "deviance",
alpha.base = 1,
- alpha.meta = 0,
+ alpha.meta = 1,
...
)
diff --git a/docs/reference/predict.joinet.html b/docs/reference/predict.joinet.html
index 159f487bfd1cf42cc877f28d5297543f99f0f95f..5f901c5b78d60e77ae701a9cb2e2fe3dd69566d1 100644
--- a/docs/reference/predict.joinet.html
+++ b/docs/reference/predict.joinet.html
@@ -218,57 +218,57 @@ with \(n\) rows (samples) and \(q\) columns (variables).
#> [50,] 0.32655598 -1.650189753 -0.59297402
#>
#> $meta
-#> [,1] [,2] [,3]
-#> [1,] 0.120026857 -2.63552370 -2.58637745
-#> [2,] 0.311517089 -1.57742790 -1.80530334
-#> [3,] 0.970038575 2.83530787 2.50770389
-#> [4,] 0.988790465 3.94203727 3.41749124
-#> [5,] 0.702397389 0.20191699 -0.07301232
-#> [6,] 0.069874337 -3.01383050 -2.75113316
-#> [7,] 0.178293600 -1.79055373 -1.33607264
-#> [8,] 0.994417547 4.65204823 4.42063500
-#> [9,] 0.825454272 0.92712611 0.33068070
-#> [10,] 0.122295626 -2.58218395 -2.83894610
-#> [11,] 0.992972765 4.45732386 4.34260769
-#> [12,] 0.315048704 -0.99259865 -0.55695917
-#> [13,] 0.006376865 -5.52584767 -5.43421552
-#> [14,] 0.604946394 0.15758601 0.59296195
-#> [15,] 0.356113893 -0.95306415 -0.75195663
-#> [16,] 0.496057561 -0.75220207 -1.26978360
-#> [17,] 0.320794509 -1.10958000 -1.05497247
-#> [18,] 0.804808814 0.64766735 0.02552338
-#> [19,] 0.834600977 1.22772641 1.64662367
-#> [20,] 0.062637571 -3.37591257 -3.52530885
-#> [21,] 0.271715919 -1.32688363 -0.85251362
-#> [22,] 0.507637975 -0.60258988 -0.83624877
-#> [23,] 0.694579538 0.19562106 -0.51989858
-#> [24,] 0.406609311 -0.57645076 -0.18326513
-#> [25,] 0.012589218 -4.82289140 -4.55079851
-#> [26,] 0.935270035 2.28086412 2.23449684
-#> [27,] 0.143615352 -2.33101536 -2.18288391
-#> [28,] 0.971697981 2.86526752 2.61585773
-#> [29,] 0.013944811 -4.69966856 -4.55513448
-#> [30,] 0.015768781 -4.71928228 -4.44410746
-#> [31,] 0.891631228 1.50966480 1.39712353
-#> [32,] 0.853434630 1.11696980 0.44705866
-#> [33,] 0.772218415 0.74754148 0.52945800
-#> [34,] 0.480168883 -0.47818857 -0.27919160
-#> [35,] 0.030260125 -4.02999089 -3.72147791
-#> [36,] 0.946608961 2.36236767 2.06071075
-#> [37,] 0.131953701 -2.45489591 -2.16067825
-#> [38,] 0.142539577 -2.28403264 -1.85682897
-#> [39,] 0.985751175 3.60577123 2.96090103
-#> [40,] 0.863879903 1.29591149 0.94749069
-#> [41,] 0.204237405 -1.70922989 -1.59867884
-#> [42,] 0.852342486 1.15387209 0.99870566
-#> [43,] 0.559959816 -0.35427152 -0.43712903
-#> [44,] 0.170830538 -2.18882713 -1.81502079
-#> [45,] 0.639682562 -0.00439300 -0.15009278
-#> [46,] 0.934408843 2.02660474 1.83111336
-#> [47,] 0.358655524 -1.10381588 -0.90429501
-#> [48,] 0.070055480 -3.13250260 -3.05061558
-#> [49,] 0.681260321 0.05548031 -0.11998977
-#> [50,] 0.317122867 -1.19819266 -1.48472862
+#> [,1] [,2] [,3]
+#> [1,] 0.10220137 -2.8366810 -2.58549073
+#> [2,] 0.22806673 -1.8261107 -1.76560859
+#> [3,] 0.95484141 2.8130533 2.62981542
+#> [4,] 0.98730517 4.1550932 3.46554651
+#> [5,] 0.64845882 0.1406465 -0.04254334
+#> [6,] 0.08701080 -3.0352129 -2.82347419
+#> [7,] 0.24075871 -1.6987418 -1.38562725
+#> [8,] 0.99171832 4.7229217 4.59039026
+#> [9,] 0.82540857 1.0679076 0.27264687
+#> [10,] 0.13617019 -2.5849863 -2.95244727
+#> [11,] 0.98981676 4.5178102 4.52008410
+#> [12,] 0.41469313 -0.8318596 -0.60385413
+#> [13,] 0.01027685 -5.5214546 -5.64340291
+#> [14,] 0.64930175 0.2459392 0.62723142
+#> [15,] 0.41386111 -0.8637077 -0.78947614
+#> [16,] 0.45380923 -0.7919286 -1.31410010
+#> [17,] 0.40677141 -0.9432038 -1.14733110
+#> [18,] 0.75190956 0.6145579 0.02843515
+#> [19,] 0.80419429 1.1601342 1.79330367
+#> [20,] 0.06109382 -3.5090532 -3.60577442
+#> [21,] 0.29707148 -1.3498797 -0.83013621
+#> [22,] 0.47255039 -0.6514714 -0.84183516
+#> [23,] 0.72776624 0.4000683 -0.64909323
+#> [24,] 0.52225525 -0.3720559 -0.23537421
+#> [25,] 0.01722845 -4.8908178 -4.68018275
+#> [26,] 0.93788800 2.4494650 2.27769155
+#> [27,] 0.13861339 -2.4543910 -2.19278248
+#> [28,] 0.95152342 2.7650921 2.78092452
+#> [29,] 0.02171825 -4.6769505 -4.73129956
+#> [30,] 0.01570247 -4.9537324 -4.49632044
+#> [31,] 0.85305109 1.4396438 1.50410997
+#> [32,] 0.85232458 1.2707274 0.38427369
+#> [33,] 0.79166183 0.8978043 0.49722869
+#> [34,] 0.50644688 -0.4392424 -0.27447864
+#> [35,] 0.02911065 -4.2534806 -3.74533419
+#> [36,] 0.94251258 2.4986830 2.09603282
+#> [37,] 0.11040807 -2.6864056 -2.11437644
+#> [38,] 0.12885189 -2.4765109 -1.80685937
+#> [39,] 0.98204701 3.7581482 3.00880873
+#> [40,] 0.85949146 1.4074652 0.94281190
+#> [41,] 0.27978357 -1.5562501 -1.70556618
+#> [42,] 0.81267168 1.1047951 1.07696011
+#> [43,] 0.51433013 -0.4308933 -0.40489984
+#> [44,] 0.12318913 -2.5118215 -1.70952119
+#> [45,] 0.60957965 -0.0276023 -0.13221472
+#> [46,] 0.90379982 1.9552732 1.95275535
+#> [47,] 0.32662397 -1.2267246 -0.85622205
+#> [48,] 0.07567690 -3.2214496 -3.11672913
+#> [49,] 0.58299820 -0.1185430 -0.03693255
+#> [50,] 0.42367190 -0.9519434 -1.64962005
#>
diff --git a/docs/reference/weights.joinet.html b/docs/reference/weights.joinet.html
index b9afcb7c501da29eacd3897377b5d9551d0b1f94..291079da19ceca422a62bf0ba1797b7bf659947e 100644
--- a/docs/reference/weights.joinet.html
+++ b/docs/reference/weights.joinet.html
@@ -158,11 +158,11 @@ in the row on the outcomes in the column.
X <- matrix(rnorm(n*p),nrow=n,ncol=p)
Y <- replicate(n=q,expr=rnorm(n=n,mean=rowSums(X[,1:5])))
object <- joinet(Y=Y,X=X)
-weights(object)#> y1 y2 y3
-#> (Intercept) -0.02352901 -0.1279338 0.1990621
-#> V1 0.10704102 0.2456441 0.4650750
-#> V2 0.48427425 0.5331528 0.3894352
-#> V3 0.52435963 0.4199606 0.2731577
#> y1 y2 y3
+#> (Intercept) -0.04720442 -0.15165929 0.26901703
+#> V1 0.00000000 0.01158793 0.65726908
+#> V2 0.55230103 0.71134918 0.45932382
+#> V3 0.60228936 0.49505561 0.01764908