diff --git a/inst/examples/MADMMplasso_example.R b/inst/examples/MADMMplasso_example.R index af035ff..03cdb81 100644 --- a/inst/examples/MADMMplasso_example.R +++ b/inst/examples/MADMMplasso_example.R @@ -82,7 +82,7 @@ tol <- 1E-3 fit <- MADMMplasso( X, Z, y, alpha = alpha, my_lambda = matrix(rep(0.2, ncol(y)), 1), - lambda_min = 0.001, max_it = 5000, e.abs = e.abs, e.rel = e.rel, maxgrid = nlambda, - nlambda = nlambda, rho = 5, tree = TT, my_print = FALSE, alph = TRUE, - pal = TRUE, gg = gg1, tol = tol, cl = 6 + lambda_min = 0.001, max_it = 1000, e.abs = e.abs, e.rel = e.rel, + maxgrid = nlambda, nlambda = nlambda, rho = 5, tree = TT, my_print = FALSE, + alph = TRUE, gg = gg1, tol = tol, cl = 2L ) diff --git a/inst/examples/cv_MADMMplasso_example.R b/inst/examples/cv_MADMMplasso_example.R index 269b986..25d0f72 100644 --- a/inst/examples/cv_MADMMplasso_example.R +++ b/inst/examples/cv_MADMMplasso_example.R @@ -1,97 +1,91 @@ - # nolint start: indentation_linter -\donttest{ - # Train the model - # generate some data - set.seed(1235) - N <- 100 - p <- 50 - nz <- 4 - K <- nz - X <- matrix(rnorm(n = N * p), nrow = N, ncol = p) - mx <- colMeans(X) - sx <- sqrt(apply(X, 2, var)) - X <- scale(X, mx, sx) - X <- matrix(as.numeric(X), N, p) - Z <- matrix(rnorm(N * nz), N, nz) - mz <- colMeans(Z) - sz <- sqrt(apply(Z, 2, var)) - Z <- scale(Z, mz, sz) - beta_1 <- rep(x = 0, times = p) - beta_2 <- rep(x = 0, times = p) - beta_3 <- rep(x = 0, times = p) - beta_4 <- rep(x = 0, times = p) - beta_5 <- rep(x = 0, times = p) - beta_6 <- rep(x = 0, times = p) +# Train the model +# generate some data +set.seed(1235) +N <- 100 +p <- 50 +nz <- 4 +K <- nz +X <- matrix(rnorm(n = N * p), nrow = N, ncol = p) +mx <- colMeans(X) +sx <- sqrt(apply(X, 2, var)) +X <- scale(X, mx, sx) +X <- matrix(as.numeric(X), N, p) +Z <- matrix(rnorm(N * nz), N, nz) +mz <- colMeans(Z) +sz <- sqrt(apply(Z, 2, var)) +Z <- scale(Z, mz, sz) +beta_1 <- rep(x = 0, times = p) +beta_2 <- rep(x = 0, times = p) +beta_3 <- rep(x = 0, times = p) +beta_4 <- rep(x = 0, times = p) +beta_5 <- rep(x = 0, times = p) +beta_6 <- rep(x = 0, times = p) - beta_1[1:5] <- c(2, 2, 2, 2, 2) - beta_2[1:5] <- c(2, 2, 2, 2, 2) - beta_3[6:10] <- c(2, 2, 2, -2, -2) - beta_4[6:10] <- c(2, 2, 2, -2, -2) - beta_5[11:15] <- c(-2, -2, -2, -2, -2) - beta_6[11:15] <- c(-2, -2, -2, -2, -2) +beta_1[1:5] <- c(2, 2, 2, 2, 2) +beta_2[1:5] <- c(2, 2, 2, 2, 2) +beta_3[6:10] <- c(2, 2, 2, -2, -2) +beta_4[6:10] <- c(2, 2, 2, -2, -2) +beta_5[11:15] <- c(-2, -2, -2, -2, -2) +beta_6[11:15] <- c(-2, -2, -2, -2, -2) - Beta <- cbind(beta_1, beta_2, beta_3, beta_4, beta_5, beta_6) - colnames(Beta) <- c(1:6) +Beta <- cbind(beta_1, beta_2, beta_3, beta_4, beta_5, beta_6) +colnames(Beta) <- c(1:6) - theta <- array(0, c(p, K, 6)) - theta[1, 1, 1] <- 2 - theta[3, 2, 1] <- 2 - theta[4, 3, 1] <- -2 - theta[5, 4, 1] <- -2 - theta[1, 1, 2] <- 2 - theta[3, 2, 2] <- 2 - theta[4, 3, 2] <- -2 - theta[5, 4, 2] <- -2 - theta[6, 1, 3] <- 2 - theta[8, 2, 3] <- 2 - theta[9, 3, 3] <- -2 - theta[10, 4, 3] <- -2 - theta[6, 1, 4] <- 2 - theta[8, 2, 4] <- 2 - theta[9, 3, 4] <- -2 - theta[10, 4, 4] <- -2 - theta[11, 1, 5] <- 2 - theta[13, 2, 5] <- 2 - theta[14, 3, 5] <- -2 - theta[15, 4, 5] <- -2 - theta[11, 1, 6] <- 2 - theta[13, 2, 6] <- 2 - theta[14, 3, 6] <- -2 - theta[15, 4, 6] <- -2 +theta <- array(0, c(p, K, 6)) +theta[1, 1, 1] <- 2 +theta[3, 2, 1] <- 2 +theta[4, 3, 1] <- -2 +theta[5, 4, 1] <- -2 +theta[1, 1, 2] <- 2 +theta[3, 2, 2] <- 2 +theta[4, 3, 2] <- -2 +theta[5, 4, 2] <- -2 +theta[6, 1, 3] <- 2 +theta[8, 2, 3] <- 2 +theta[9, 3, 3] <- -2 +theta[10, 4, 3] <- -2 +theta[6, 1, 4] <- 2 +theta[8, 2, 4] <- 2 +theta[9, 3, 4] <- -2 +theta[10, 4, 4] <- -2 +theta[11, 1, 5] <- 2 +theta[13, 2, 5] <- 2 +theta[14, 3, 5] <- -2 +theta[15, 4, 5] <- -2 +theta[11, 1, 6] <- 2 +theta[13, 2, 6] <- 2 +theta[14, 3, 6] <- -2 +theta[15, 4, 6] <- -2 - pliable = matrix(0,N,6) - for (e in 1:6) { - pliable[,e]<- compute_pliable(X, Z, theta[,,e]) - } - - esd<-diag(6) - e<-MASS::mvrnorm(N,mu=rep(0,6),Sigma=esd) - y_train<-X%*%Beta+pliable+e - y=y_train +pliable <- matrix(0, N, 6) +for (e in 1:6) { + pliable[, e] <- compute_pliable(X, Z, theta[, , e]) +} - colnames(y)<- c( paste("y",1:(ncol(y)),sep = "") ) - TT=tree_parms(y) - plot(TT$h_clust) - gg1=matrix(0,2,2) - gg1[1,]<-c(0.02,0.02) - gg1[2,]<-c(0.02,0.02) - nlambda = 50 - e.abs=1E-4 - e.rel=1E-2 - alpha=.2 - tol=1E-3 - fit <- MADMMplasso( - X, Z, y, alpha=alpha, my_lambda=NULL, lambda_min=0.001, max_it=100, - e.abs=e.abs, e.rel=e.rel, maxgrid=50, nlambda=nlambda, rho=5,tree=TT, - my_print=FALSE, alph=1, gg=gg1, tol=tol, cl=2L - ) - gg1=fit$gg +esd <- diag(6) +e <- MASS::mvrnorm(N, mu = rep(0, 6), Sigma = esd) +y_train <- X %*% Beta + pliable + e +y <- y_train - cv_admp <- cv_MADMMplasso( - fit, nfolds=5, X, Z, y, alpha=alpha, lambda=fit$Lambdas, max_it=100, - e.abs=e.abs, e.rel=e.rel, nlambda, rho=5, my_print=FALSE, alph=1, - foldid=NULL, gg=gg1, TT=TT, tol=tol - ) - plot(cv_admp) -} -# nolint end: indentation_linter +colnames(y) <- c(paste("y", 1:(ncol(y)), sep = "")) +TT <- tree_parms(y) +plot(TT$h_clust) +gg1 <- matrix(0, 2, 2) +gg1[1, ] <- c(0.02, 0.02) +gg1[2, ] <- c(0.02, 0.02) +nlambda <- 3 +e.abs <- 1E-3 +e.rel <- 1E-1 +alpha <- .2 +tol <- 1E-2 +fit <- MADMMplasso( + X, Z, y, alpha = alpha, my_lambda = NULL, lambda_min = 0.001, max_it = 100, + e.abs = e.abs, e.rel = e.rel, maxgrid = nlambda, nlambda = nlambda, rho = 5, + tree = TT, my_print = FALSE, alph = 1, gg = gg1, tol = tol, cl = 2L +) +cv_admp <- cv_MADMMplasso( + fit, nfolds = 5, X, Z, y, alpha = alpha, lambda = fit$Lambdas, max_it = 100, + e.abs = e.abs, e.rel = e.rel, nlambda, rho = 5, my_print = FALSE, alph = 1, + foldid = NULL, gg = fit$gg, TT = TT, tol = tol +) +plot(cv_admp) diff --git a/man/MADMMplasso.Rd b/man/MADMMplasso.Rd index 35008a9..1f5b119 100644 --- a/man/MADMMplasso.Rd +++ b/man/MADMMplasso.Rd @@ -185,9 +185,9 @@ tol <- 1E-3 fit <- MADMMplasso( X, Z, y, alpha = alpha, my_lambda = matrix(rep(0.2, ncol(y)), 1), - lambda_min = 0.001, max_it = 5000, e.abs = e.abs, e.rel = e.rel, maxgrid = nlambda, - nlambda = nlambda, rho = 5, tree = TT, my_print = FALSE, alph = TRUE, - pal = TRUE, gg = gg1, tol = tol, cl = 6 + lambda_min = 0.001, max_it = 1000, e.abs = e.abs, e.rel = e.rel, + maxgrid = nlambda, nlambda = nlambda, rho = 5, tree = TT, my_print = FALSE, + alph = TRUE, gg = gg1, tol = tol, cl = 2L ) } \author{ diff --git a/man/cv_MADMMplasso.Rd b/man/cv_MADMMplasso.Rd index bba9f8e..34a8d40 100644 --- a/man/cv_MADMMplasso.Rd +++ b/man/cv_MADMMplasso.Rd @@ -80,101 +80,95 @@ results containing the CV values Carries out cross-validation for a MADMMplasso model over a path of regularization values } \examples{ - # nolint start: indentation_linter -\donttest{ - # Train the model - # generate some data - set.seed(1235) - N <- 100 - p <- 50 - nz <- 4 - K <- nz - X <- matrix(rnorm(n = N * p), nrow = N, ncol = p) - mx <- colMeans(X) - sx <- sqrt(apply(X, 2, var)) - X <- scale(X, mx, sx) - X <- matrix(as.numeric(X), N, p) - Z <- matrix(rnorm(N * nz), N, nz) - mz <- colMeans(Z) - sz <- sqrt(apply(Z, 2, var)) - Z <- scale(Z, mz, sz) - beta_1 <- rep(x = 0, times = p) - beta_2 <- rep(x = 0, times = p) - beta_3 <- rep(x = 0, times = p) - beta_4 <- rep(x = 0, times = p) - beta_5 <- rep(x = 0, times = p) - beta_6 <- rep(x = 0, times = p) - - beta_1[1:5] <- c(2, 2, 2, 2, 2) - beta_2[1:5] <- c(2, 2, 2, 2, 2) - beta_3[6:10] <- c(2, 2, 2, -2, -2) - beta_4[6:10] <- c(2, 2, 2, -2, -2) - beta_5[11:15] <- c(-2, -2, -2, -2, -2) - beta_6[11:15] <- c(-2, -2, -2, -2, -2) - - Beta <- cbind(beta_1, beta_2, beta_3, beta_4, beta_5, beta_6) - colnames(Beta) <- c(1:6) - - theta <- array(0, c(p, K, 6)) - theta[1, 1, 1] <- 2 - theta[3, 2, 1] <- 2 - theta[4, 3, 1] <- -2 - theta[5, 4, 1] <- -2 - theta[1, 1, 2] <- 2 - theta[3, 2, 2] <- 2 - theta[4, 3, 2] <- -2 - theta[5, 4, 2] <- -2 - theta[6, 1, 3] <- 2 - theta[8, 2, 3] <- 2 - theta[9, 3, 3] <- -2 - theta[10, 4, 3] <- -2 - theta[6, 1, 4] <- 2 - theta[8, 2, 4] <- 2 - theta[9, 3, 4] <- -2 - theta[10, 4, 4] <- -2 - theta[11, 1, 5] <- 2 - theta[13, 2, 5] <- 2 - theta[14, 3, 5] <- -2 - theta[15, 4, 5] <- -2 - theta[11, 1, 6] <- 2 - theta[13, 2, 6] <- 2 - theta[14, 3, 6] <- -2 - theta[15, 4, 6] <- -2 - - pliable = matrix(0,N,6) - for (e in 1:6) { - pliable[,e]<- compute_pliable(X, Z, theta[,,e]) - } - - esd<-diag(6) - e<-MASS::mvrnorm(N,mu=rep(0,6),Sigma=esd) - y_train<-X\%*\%Beta+pliable+e - y=y_train - - colnames(y)<- c( paste("y",1:(ncol(y)),sep = "") ) - TT=tree_parms(y) - plot(TT$h_clust) - gg1=matrix(0,2,2) - gg1[1,]<-c(0.02,0.02) - gg1[2,]<-c(0.02,0.02) - nlambda = 50 - e.abs=1E-4 - e.rel=1E-2 - alpha=.2 - tol=1E-3 - fit <- MADMMplasso( - X, Z, y, alpha=alpha, my_lambda=NULL, lambda_min=0.001, max_it=5000, - e.abs=e.abs, e.rel=e.rel, maxgrid=50, nlambda=nlambda, rho=5,tree=TT, - my_print=FALSE, alph=1, gg=gg1, tol=tol, cl=2L - ) - gg1=fit$gg - - cv_admp <- cv_MADMMplasso( - fit, nfolds=5, X, Z, y, alpha=alpha, lambda=fit$Lambdas, max_it=5000, - e.abs=e.abs, e.rel=e.rel, nlambda, rho=5, my_print=FALSE, alph=1, - foldid=NULL, gg=gg1, TT=TT, tol=tol - ) - plot(cv_admp) +# Train the model +# generate some data +set.seed(1235) +N <- 100 +p <- 50 +nz <- 4 +K <- nz +X <- matrix(rnorm(n = N * p), nrow = N, ncol = p) +mx <- colMeans(X) +sx <- sqrt(apply(X, 2, var)) +X <- scale(X, mx, sx) +X <- matrix(as.numeric(X), N, p) +Z <- matrix(rnorm(N * nz), N, nz) +mz <- colMeans(Z) +sz <- sqrt(apply(Z, 2, var)) +Z <- scale(Z, mz, sz) +beta_1 <- rep(x = 0, times = p) +beta_2 <- rep(x = 0, times = p) +beta_3 <- rep(x = 0, times = p) +beta_4 <- rep(x = 0, times = p) +beta_5 <- rep(x = 0, times = p) +beta_6 <- rep(x = 0, times = p) + +beta_1[1:5] <- c(2, 2, 2, 2, 2) +beta_2[1:5] <- c(2, 2, 2, 2, 2) +beta_3[6:10] <- c(2, 2, 2, -2, -2) +beta_4[6:10] <- c(2, 2, 2, -2, -2) +beta_5[11:15] <- c(-2, -2, -2, -2, -2) +beta_6[11:15] <- c(-2, -2, -2, -2, -2) + +Beta <- cbind(beta_1, beta_2, beta_3, beta_4, beta_5, beta_6) +colnames(Beta) <- c(1:6) + +theta <- array(0, c(p, K, 6)) +theta[1, 1, 1] <- 2 +theta[3, 2, 1] <- 2 +theta[4, 3, 1] <- -2 +theta[5, 4, 1] <- -2 +theta[1, 1, 2] <- 2 +theta[3, 2, 2] <- 2 +theta[4, 3, 2] <- -2 +theta[5, 4, 2] <- -2 +theta[6, 1, 3] <- 2 +theta[8, 2, 3] <- 2 +theta[9, 3, 3] <- -2 +theta[10, 4, 3] <- -2 +theta[6, 1, 4] <- 2 +theta[8, 2, 4] <- 2 +theta[9, 3, 4] <- -2 +theta[10, 4, 4] <- -2 +theta[11, 1, 5] <- 2 +theta[13, 2, 5] <- 2 +theta[14, 3, 5] <- -2 +theta[15, 4, 5] <- -2 +theta[11, 1, 6] <- 2 +theta[13, 2, 6] <- 2 +theta[14, 3, 6] <- -2 +theta[15, 4, 6] <- -2 + +pliable <- matrix(0, N, 6) +for (e in 1:6) { + pliable[, e] <- compute_pliable(X, Z, theta[, , e]) } -# nolint end: indentation_linter + +esd <- diag(6) +e <- MASS::mvrnorm(N, mu = rep(0, 6), Sigma = esd) +y_train <- X \%*\% Beta + pliable + e +y <- y_train + +colnames(y) <- c(paste("y", 1:(ncol(y)), sep = "")) +TT <- tree_parms(y) +plot(TT$h_clust) +gg1 <- matrix(0, 2, 2) +gg1[1, ] <- c(0.02, 0.02) +gg1[2, ] <- c(0.02, 0.02) +nlambda <- 3 +e.abs <- 1E-3 +e.rel <- 1E-1 +alpha <- .2 +tol <- 1E-2 +fit <- MADMMplasso( + X, Z, y, alpha = alpha, my_lambda = NULL, lambda_min = 0.001, max_it = 100, + e.abs = e.abs, e.rel = e.rel, maxgrid = nlambda, nlambda = nlambda, rho = 5, + tree = TT, my_print = FALSE, alph = 1, gg = gg1, tol = tol, cl = 2L +) +cv_admp <- cv_MADMMplasso( + fit, nfolds = 5, X, Z, y, alpha = alpha, lambda = fit$Lambdas, max_it = 100, + e.abs = e.abs, e.rel = e.rel, nlambda, rho = 5, my_print = FALSE, alph = 1, + foldid = NULL, gg = fit$gg, TT = TT, tol = tol +) +plot(cv_admp) }