diff --git a/R/MADMMplasso.R b/R/MADMMplasso.R index 1dd100b..80e6809 100644 --- a/R/MADMMplasso.R +++ b/R/MADMMplasso.R @@ -50,7 +50,7 @@ #' @example inst/examples/MADMMplasso_example.R #' @export -MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = .001, max_it = 50000, e.abs = 1E-3, e.rel = 1E-3, maxgrid, nlambda, rho = 5, my_print = F, alph = 1.8, tree, cv = F, parallel = T, pal = 0, gg = NULL, tol = 1E-4, cl = 4, legacy = FALSE) { +MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = .001, max_it = 50000, e.abs = 1E-3, e.rel = 1E-3, maxgrid, nlambda, rho = 5, my_print = F, alph = 1.8, tree, parallel = T, pal = 0, gg = NULL, tol = 1E-4, cl = 4, legacy = FALSE) { N <- nrow(X) p <- ncol(X) @@ -211,7 +211,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = .001, max admm_MADMMplasso( beta0, theta0, beta, beta_hat, theta, rho1, X, Z, max_it, my_W_hat, XtY, y, N, e.abs, e.rel, alpha, lam[i, ], alph, svd.w, tree, my_print, - invmat, cv, gg[i, ],legacy + invmat, gg[i, ],legacy ) } parallel::stopCluster(cl) @@ -222,7 +222,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = .001, max admm_MADMMplasso( beta0, theta0, beta, beta_hat, theta, rho1, X, Z, max_it, my_W_hat, XtY, y, N, e.abs, e.rel, alpha, lam[g, ], alph, svd.w, tree, my_print, - invmat, cv, gg[g, ],legacy + invmat, gg[g, ],legacy ) } ) @@ -241,7 +241,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = .001, max my_values <- admm_MADMMplasso( beta0, theta0, beta, beta_hat, theta, rho1, X, Z, max_it, my_W_hat, XtY, y, N, e.abs, e.rel, alpha, lambda, alph, svd.w, tree, my_print, invmat, - cv, gg[hh, ],legacy + gg[hh, ],legacy ) beta <- my_values$beta @@ -297,18 +297,10 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = .001, max Y_HAT[[hh]] <- y_hat THETA[[hh]] <- as.sparse3Darray(theta1) - if (cv == F) { - if (hh == 1) { - print(c(hh, (n_main_terms[hh]), non_zero_theta[hh], obj1)) - } else { - print(c(hh, (n_main_terms[hh]), non_zero_theta[hh], obj[hh - 1], obj1)) - } + if (hh == 1) { + print(c(hh, (n_main_terms[hh]), non_zero_theta[hh], obj1)) } else { - if (hh == 1) { - print(c(hh, (n_main_terms[hh]), non_zero_theta[hh], obj1)) - } else { - print(c(hh, (n_main_terms[hh]), non_zero_theta[hh], obj[hh - 1], obj1)) - } + print(c(hh, (n_main_terms[hh]), non_zero_theta[hh], obj[hh - 1], obj1)) } hh <- hh + 1 diff --git a/R/admm_MADMMplasso.R b/R/admm_MADMMplasso.R index 7c15529..8926060 100644 --- a/R/admm_MADMMplasso.R +++ b/R/admm_MADMMplasso.R @@ -27,7 +27,6 @@ #' However, user decide on a specific structure and then input a tree that follows such structure. #' @param my_print Should information form each ADMM iteration be printed along the way? Default TRUE. This prints the dual and primal residuals #' @param invmat A list of length ncol(y), each containing the C_d part of equation 32 in the paper -#' @param cv TODO: fill paramater description #' @param gg penalty terms for the tree structure for lambda_1 and lambda_2 for the admm call. #' @param legacy If \code{TRUE}, use the R version of the algorithm. Defaults to #' C++. @@ -49,7 +48,7 @@ #' @export -admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, max_it, W_hat, XtY, y, N, e.abs, e.rel, alpha, lambda, alph, svd.w, tree, my_print = T, invmat, cv = cv, gg = 0.2, legacy = FALSE) { +admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, max_it, W_hat, XtY, y, N, e.abs, e.rel, alpha, lambda, alph, svd.w, tree, my_print = T, invmat, gg = 0.2, legacy = FALSE) { if (!legacy) { out <- admm_MADMMplasso_cpp( beta0, theta0, beta, beta_hat, theta, rho1, X, Z, max_it, W_hat, XtY, y, diff --git a/R/cv_MADMMplasso.R b/R/cv_MADMMplasso.R index c4e9024..8944f02 100644 --- a/R/cv_MADMMplasso.R +++ b/R/cv_MADMMplasso.R @@ -52,7 +52,7 @@ cv_MADMMplasso <- function(fit, nfolds, X, Z, y, alpha = 0.5, lambda = fit$Lambd print(c("fold,", ii)) oo <- foldid == ii - ggg[[ii]] <- MADMMplasso(X = X[!oo, , drop = F], Z = Z[!oo, , drop = F], y = y[!oo, , drop = F], alpha = alpha, my_lambda = lambda, lambda_min = .01, max_it = max_it, e.abs = e.abs, e.rel = e.rel, nlambda = length(lambda[, 1]), rho = rho, tree = TT, my_print = my_print, alph = alph, cv = T, parallel = parallel, pal = pal, gg = gg, tol = tol, cl = cl) + ggg[[ii]] <- MADMMplasso(X = X[!oo, , drop = F], Z = Z[!oo, , drop = F], y = y[!oo, , drop = F], alpha = alpha, my_lambda = lambda, lambda_min = .01, max_it = max_it, e.abs = e.abs, e.rel = e.rel, nlambda = length(lambda[, 1]), rho = rho, tree = TT, my_print = my_print, alph = alph, parallel = parallel, pal = pal, gg = gg, tol = tol, cl = cl) cv_p <- predict.MADMMplasso(ggg[[ii]], X = X[oo, , drop = F], Z = Z[oo, ], y = y[oo, ]) ggg[[ii]] <- 0 diff --git a/man/MADMMplasso.Rd b/man/MADMMplasso.Rd index ec3d9e3..9da412d 100644 --- a/man/MADMMplasso.Rd +++ b/man/MADMMplasso.Rd @@ -21,7 +21,6 @@ MADMMplasso( my_print = F, alph = 1.8, tree, - cv = F, parallel = T, pal = 0, gg = NULL, diff --git a/tests/testthat/test-admm_MADMMplasso_cpp.R b/tests/testthat/test-admm_MADMMplasso_cpp.R index 1841c78..0dcf7c2 100644 --- a/tests/testthat/test-admm_MADMMplasso_cpp.R +++ b/tests/testthat/test-admm_MADMMplasso_cpp.R @@ -164,7 +164,7 @@ my_values <- suppressWarnings(suppressMessages(admm_MADMMplasso( beta0 = beta0, theta0 = theta0, beta = beta, beta_hat = beta_hat, theta = theta, rho, X, Z, max_it, W_hat = my_W_hat, XtY, y, N, e.abs, e.rel, alpha, lambda = lambda, alph, svd.w = svd.w, tree = TT, - my_print = mprt, invmat = invmat, cv = FALSE, gg = gg, legacy = TRUE + my_print = mprt, invmat = invmat, gg = gg, legacy = TRUE ))) beta <- my_values$beta theta <- my_values$theta