From dd4bf1605452db77762e2298a6ad5f12b2c01669 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 11:16:11 +0200 Subject: [PATCH 1/9] Updated RoxygenNote version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b95c3c8..16a81af 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -51,5 +51,5 @@ Suggests: License: GPL-3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Config/testthat/edition: 3 From b9efc195374bdc28619c32288118e99da9de16d6 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 11:17:39 +0200 Subject: [PATCH 2/9] Using implicit `return()` (#45) Arguably faster, easier to read, and conformant to functional programming. For an interesting discussion on the topic, see . --- R/MADMMplasso.R | 7 ++----- R/admm_MADMMplasso.R | 2 +- R/compute_pliable.R | 2 +- R/conv_Nd2T.R | 2 +- R/hh_nlambda_loop.R | 5 +++-- R/objective.R | 4 ++-- src/reg.cpp | 1 - tests/testthat/test-admm_MADMMplasso_cpp.R | 2 +- tests/testthat/test-reg.R | 2 +- 9 files changed, 12 insertions(+), 15 deletions(-) diff --git a/R/MADMMplasso.R b/R/MADMMplasso.R index b7e6f40..691e6bd 100644 --- a/R/MADMMplasso.R +++ b/R/MADMMplasso.R @@ -100,8 +100,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma lammax <- lapply( seq_len(dim(y)[2]), function(g) { - l_max <- max(abs(t(X) %*% (r - colMeans(r))) / length(r[, 1])) / ((1 - alpha) + (max(gg[1, ]) * max(CW) + max(gg[2, ]))) - return(l_max) + max(abs(t(X) %*% (r - colMeans(r))) / length(r[, 1])) / ((1 - alpha) + (max(gg[1, ]) * max(CW) + max(gg[2, ]))) } ) @@ -109,9 +108,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma lambda_i <- lapply( seq_len(dim(y)[2]), function(g) { - lam_i <- exp(seq(log(big_lambda[[g]]), log(big_lambda[[g]] * rat), length = maxgrid)) - - return(lam_i) + exp(seq(log(big_lambda[[g]]), log(big_lambda[[g]] * rat), length = maxgrid)) } ) gg1 <- seq((gg[1, 1]), (gg[1, 2]), length = maxgrid) diff --git a/R/admm_MADMMplasso.R b/R/admm_MADMMplasso.R index 37f135f..fbcc149 100644 --- a/R/admm_MADMMplasso.R +++ b/R/admm_MADMMplasso.R @@ -124,7 +124,7 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m new_G[1:p] <- rho * (1 + new_G[1:p]) new_G[-1:-p] <- rho * (1 + new_G[-1:-p]) - invmat <- lapply(seq_len(D), function(j) return(new_G + rho * (new_I[j] + 1))) + invmat <- lapply(seq_len(D), function(j) new_G + rho * (new_I[j] + 1)) for (jj in 1:D) { group <- (rho) * (t(G) %*% t(V[, , jj]) - t(G) %*% t(O[, , jj])) diff --git a/R/compute_pliable.R b/R/compute_pliable.R index 177b6d2..a91cb76 100644 --- a/R/compute_pliable.R +++ b/R/compute_pliable.R @@ -17,5 +17,5 @@ compute_pliable <- function(X, Z, theta) { ) xz_term <- (Reduce(f = "+", x = xz_theta)) - return(xz_term) + xz_term } diff --git a/R/conv_Nd2T.R b/R/conv_Nd2T.R index 617f7f1..b074530 100644 --- a/R/conv_Nd2T.R +++ b/R/conv_Nd2T.R @@ -22,7 +22,7 @@ conv_Nd2T <- function(Nd, w, w_max) { Tw[Nd[ch, 2]] <- Tw[Nd[ch, 2]] * w - return(list(Jt = Jt, Tw = Tw)) + list(Jt = Jt, Tw = Tw) } # =========================== diff --git a/R/hh_nlambda_loop.R b/R/hh_nlambda_loop.R index 991f14f..b273ff5 100644 --- a/R/hh_nlambda_loop.R +++ b/R/hh_nlambda_loop.R @@ -83,10 +83,11 @@ hh_nlambda_loop <- function( hh <- hh + 1 } ### lambda - out <- list( + + # Output + list( obj = obj, n_main_terms = n_main_terms, non_zero_theta = non_zero_theta, BETA0 = BETA0, THETA0 = THETA0, BETA = BETA, BETA_hat = BETA_hat, Y_HAT = Y_HAT, THETA = THETA ) - return(out) } diff --git a/R/objective.R b/R/objective.R index 0a99ce5..86038f0 100644 --- a/R/objective.R +++ b/R/objective.R @@ -14,7 +14,7 @@ objective <- function(beta0, theta0, beta, theta, X, Z, y, alpha, lambda, p, N, pliable_norm[ee] <- sum(unlist(norm_1_l)) } - objective_l <- mse + (1 - alpha) * min(lambda / 4) * IB + (1 - alpha) * min(lambda / 4) * l_1 + sum(pliable_norm) - return(objective_l) + # Output + mse + (1 - alpha) * min(lambda / 4) * IB + (1 - alpha) * min(lambda / 4) * l_1 + sum(pliable_norm) } diff --git a/src/reg.cpp b/src/reg.cpp index ced67b6..e2abf84 100644 --- a/src/reg.cpp +++ b/src/reg.cpp @@ -21,7 +21,6 @@ arma::vec lm_arma(const arma::vec &R, const arma::mat &Z) { // [[Rcpp::export]] arma::mat reg(const arma::mat r, const arma::mat Z) { - arma::rowvec beta01(r.n_cols, arma::fill::zeros); arma::mat theta01(Z.n_cols, r.n_cols, arma::fill::zeros); diff --git a/tests/testthat/test-admm_MADMMplasso_cpp.R b/tests/testthat/test-admm_MADMMplasso_cpp.R index 108a099..b87c5e5 100644 --- a/tests/testthat/test-admm_MADMMplasso_cpp.R +++ b/tests/testthat/test-admm_MADMMplasso_cpp.R @@ -4,7 +4,7 @@ model <- function(beta0, theta0, beta, theta, X, Z) { N <- nrow(X) intercepts <- (matrix(1, N)) %*% beta0 + Z %*% ((theta0)) shared_model <- X %*% (beta) - return(intercepts + shared_model) + intercepts + shared_model } reg_temp <- function(r, Z) { diff --git a/tests/testthat/test-reg.R b/tests/testthat/test-reg.R index 8a47ee5..74ed484 100644 --- a/tests/testthat/test-reg.R +++ b/tests/testthat/test-reg.R @@ -7,7 +7,7 @@ reg_R <- function(r, Z) { beta01[e] <- matrix(new1$coefficients[1]) theta01[, e] <- as.vector(new1$coefficients[-1]) } - return(list(beta0 = beta01, theta0 = theta01)) + list(beta0 = beta01, theta0 = theta01) } # Testing ====================================================================== From a5f304de2f43c6954edc0dee2801ae6009e0be0f Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 11:18:42 +0200 Subject: [PATCH 3/9] Removed TODO (#45) --- tests/testthat/test-admm_MADMMplasso_cpp.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-admm_MADMMplasso_cpp.R b/tests/testthat/test-admm_MADMMplasso_cpp.R index b87c5e5..d8150f7 100644 --- a/tests/testthat/test-admm_MADMMplasso_cpp.R +++ b/tests/testthat/test-admm_MADMMplasso_cpp.R @@ -1,5 +1,4 @@ # Auxiliary funcions =========================================================== -# TODO: ask why these are not in the package? model <- function(beta0, theta0, beta, theta, X, Z) { N <- nrow(X) intercepts <- (matrix(1, N)) %*% beta0 + Z %*% ((theta0)) From 71e477ef38bd2bb804ea75e9b8eb3a1c92957168 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 11:46:25 +0200 Subject: [PATCH 4/9] Replaced `dim()[]` with `nrow()`/`ncol()` (#45) --- R/MADMMplasso.R | 22 ++++---- R/admm_MADMMplasso.R | 66 +++++++++++----------- R/conv_H2T.R | 2 +- R/count_nonzero_a.R | 4 +- R/cv_MADMMplasso.R | 6 +- R/fast_corr.R | 2 +- R/objective.R | 4 +- R/predict.MADMMplasso.R | 2 +- R/tree_parms.R | 2 +- inst/examples/MADMMplasso_example.R | 2 +- man/MADMMplasso.Rd | 2 +- tests/testthat/test-MADMMplasso.R | 4 +- tests/testthat/test-admm_MADMMplasso_cpp.R | 16 +++--- tests/testthat/test-parallel.R | 2 +- 14 files changed, 68 insertions(+), 68 deletions(-) diff --git a/R/MADMMplasso.R b/R/MADMMplasso.R index 691e6bd..6c2ae86 100644 --- a/R/MADMMplasso.R +++ b/R/MADMMplasso.R @@ -57,7 +57,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma p <- ncol(X) K <- ncol(Z) - D <- dim(y)[2] + D <- ncol(y) TT <- tree @@ -98,7 +98,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma r <- y lammax <- lapply( - seq_len(dim(y)[2]), + seq_len(ncol(y)), function(g) { max(abs(t(X) %*% (r - colMeans(r))) / length(r[, 1])) / ((1 - alpha) + (max(gg[1, ]) * max(CW) + max(gg[2, ]))) } @@ -106,7 +106,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma big_lambda <- lammax lambda_i <- lapply( - seq_len(dim(y)[2]), + seq_len(ncol(y)), function(g) { exp(seq(log(big_lambda[[g]]), log(big_lambda[[g]] * rat), length = maxgrid)) } @@ -131,20 +131,20 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma rho1 <- rho - D <- dim(y)[2] + D <- ncol(y) ### for response groups ############################################################### - input <- 1:(dim(y)[2] * nrow(C)) - multiple_of_D <- (input %% dim(y)[2]) == 0 + input <- 1:(ncol(y) * nrow(C)) + multiple_of_D <- (input %% ncol(y)) == 0 - I <- matrix(0, nrow = nrow(C) * dim(y)[2], ncol = dim(y)[2]) + I <- matrix(0, nrow = nrow(C) * ncol(y), ncol = ncol(y)) II <- input[multiple_of_D] - diag(I[1:dim(y)[2], ]) <- C[1, ] * (CW[1]) + diag(I[1:ncol(y), ]) <- C[1, ] * (CW[1]) c_count <- 2 for (e in II[-length(II)]) { - diag(I[c((e + 1):(c_count * dim(y)[2])), ]) <- C[c_count, ] * (CW[c_count]) + diag(I[c((e + 1):(c_count * ncol(y))), ]) <- C[c_count, ] * (CW[c_count]) c_count <- 1 + c_count } new_I <- diag(t(I) %*% I) @@ -171,8 +171,8 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma theta <- (array(0, c(p, K, D))) if (is.null(my_lambda)) { - lam <- matrix(0, nlambda, dim(y)[2]) - for (i in 1:dim(y)[2]) { + lam <- matrix(0, nlambda, ncol(y)) + for (i in 1:ncol(y)) { lam[, i] <- lambda_i[[i]] } } else { diff --git a/R/admm_MADMMplasso.R b/R/admm_MADMMplasso.R index fbcc149..680f4fd 100644 --- a/R/admm_MADMMplasso.R +++ b/R/admm_MADMMplasso.R @@ -39,32 +39,32 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m CW <- TT$Tw svd.w$tu <- t(svd.w$u) svd.w$tv <- t(svd.w$v) - D <- dim(y)[2] - p <- dim(X)[2] - K <- dim(Z)[2] + D <- ncol(y) + p <- ncol(X) + K <- ncol(Z) V <- (array(0, c(p, 2 * (1 + K), D))) O <- (array(0, c(p, 2 * (1 + K), D))) - E <- (matrix(0, dim(y)[2] * nrow(C), (p + p * K))) # response auxiliary + E <- (matrix(0, ncol(y) * nrow(C), (p + p * K))) # response auxiliary EE <- (array(0, c(p, (1 + K), D))) Q <- (array(0, c(p, (1 + K), D))) P <- (array(0, c(p, (1 + K), D))) - H <- (matrix(0, dim(y)[2] * nrow(C), (p + p * K))) # response multiplier + H <- (matrix(0, ncol(y) * nrow(C), (p + p * K))) # response multiplier HH <- (array(0, c(p, (1 + K), D))) ### for response groups ############################################################### - input <- 1:(dim(y)[2] * nrow(C)) - multiple_of_D <- (input %% dim(y)[2]) == 0 + input <- 1:(ncol(y) * nrow(C)) + multiple_of_D <- (input %% ncol(y)) == 0 - I <- matrix(0, nrow = nrow(C) * dim(y)[2], ncol = dim(y)[2]) + I <- matrix(0, nrow = nrow(C) * ncol(y), ncol = ncol(y)) II <- input[multiple_of_D] - diag(I[1:dim(y)[2], ]) <- C[1, ] * (CW[1]) + diag(I[1:ncol(y), ]) <- C[1, ] * (CW[1]) c_count <- 2 for (e in II[-length(II)]) { - diag(I[c((e + 1):(c_count * dim(y)[2])), ]) <- C[c_count, ] * (CW[c_count]) + diag(I[c((e + 1):(c_count * ncol(y))), ]) <- C[c_count, ] * (CW[c_count]) c_count <- 1 + c_count } @@ -197,21 +197,21 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m b_hat_response <- alph * Big_beta_respone + (1 - alph) * E new.mat <- b_hat_response + H - new.mat_group <- (array(NA, c(p + p * K, dim(y)[2], dim(C)[1]))) - beta.group <- (array(NA, c(p + p * K, dim(y)[2], dim(C)[1]))) + new.mat_group <- (array(NA, c(p + p * K, ncol(y), nrow(C)))) + beta.group <- (array(NA, c(p + p * K, ncol(y), nrow(C)))) N_E <- list() II <- input[multiple_of_D] - new.mat_group[, , 1] <- t((new.mat[1:dim(y)[2], ])) - beta.group[, , 1] <- t((Big_beta_respone[1:dim(y)[2], ])) + new.mat_group[, , 1] <- t((new.mat[1:ncol(y), ])) + beta.group[, , 1] <- t((Big_beta_respone[1:ncol(y), ])) - beta_transform <- matrix(0, p, (K + 1) * dim(y)[2]) + beta_transform <- matrix(0, p, (K + 1) * ncol(y)) beta_transform[, 1:(1 + K)] <- matrix(new.mat_group[, 1, 1], ncol = (K + 1), nrow = p) - input2 <- 1:(dim(y)[2] * (1 + K)) + input2 <- 1:(ncol(y) * (1 + K)) multiple_of_K <- (input2 %% (K + 1)) == 0 II2 <- input2[multiple_of_K] e2 <- II2[-length(II2)][1] - for (c_count2 in 2:dim(y)[2]) { + for (c_count2 in 2:ncol(y)) { beta_transform[, c((e2 + 1):(c_count2 * (1 + K)))] <- matrix(new.mat_group[, c_count2, 1], ncol = (K + 1), nrow = p) e2 <- II2[c_count2] } @@ -222,15 +222,15 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m N_E1 <- scale(t(beta_transform), center = FALSE, scale = 1 / coef.term1) N_E1 <- t(N_E1) - beta_transform1 <- matrix(0, p + p * K, dim(y)[2]) + beta_transform1 <- matrix(0, p + p * K, ncol(y)) beta_transform1[, 1] <- as.vector(N_E1[, 1:(K + 1)]) - input3 <- 1:(dim(y)[2] * (1 + K)) + input3 <- 1:(ncol(y) * (1 + K)) multiple_of_K <- (input3 %% (K + 1)) == 0 II3 <- input3[multiple_of_K] e3 <- II3[-length(II3)][1] - for (c_count3 in 2:dim(y)[2]) { + for (c_count3 in 2:ncol(y)) { beta_transform1[, c_count3] <- as.vector(N_E1[, c((e3 + 1):((K + 1) * c_count3))]) e3 <- II3[c_count3] } @@ -238,18 +238,18 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m N_E[[1]] <- (t(beta_transform1)) e <- II[-length(II)][1] - for (c_count in 2:dim(C)[1]) { - new.mat_group[, , c_count] <- t((new.mat[c((e + 1):(c_count * dim(y)[2])), ])) - beta.group[, , c_count] <- t(Big_beta_respone[c((e + 1):(c_count * dim(y)[2])), ]) + for (c_count in 2:nrow(C)) { + new.mat_group[, , c_count] <- t((new.mat[c((e + 1):(c_count * ncol(y))), ])) + beta.group[, , c_count] <- t(Big_beta_respone[c((e + 1):(c_count * ncol(y))), ]) - beta_transform <- matrix(0, p, (K + 1) * dim(y)[2]) + beta_transform <- matrix(0, p, (K + 1) * ncol(y)) beta_transform[, 1:(1 + K)] <- matrix(new.mat_group[, 1, c_count], ncol = (K + 1), nrow = p) - input2 <- 1:(dim(y)[2] * (1 + K)) + input2 <- 1:(ncol(y) * (1 + K)) multiple_of_K <- (input2 %% (K + 1)) == 0 II2 <- input2[multiple_of_K] e2 <- II2[-length(II2)][1] - for (c_count2 in 2:dim(y)[2]) { + for (c_count2 in 2:ncol(y)) { beta_transform[, c((e2 + 1):(c_count2 * (1 + K)))] <- matrix(new.mat_group[, c_count2, c_count], ncol = (K + 1), nrow = p) e2 <- II2[c_count2] } @@ -260,15 +260,15 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m N_E1 <- scale(t(beta_transform), center = FALSE, scale = 1 / coef.term1) N_E1 <- t(N_E1) - beta_transform1 <- matrix(0, p + p * K, dim(y)[2]) + beta_transform1 <- matrix(0, p + p * K, ncol(y)) beta_transform1[, 1] <- as.vector(N_E1[, 1:(K + 1)]) - input3 <- 1:(dim(y)[2] * (1 + K)) + input3 <- 1:(ncol(y) * (1 + K)) multiple_of_K <- (input3 %% (K + 1)) == 0 II3 <- input3[multiple_of_K] e3 <- II3[-length(II3)][1] - for (c_count3 in 2:dim(y)[2]) { + for (c_count3 in 2:ncol(y)) { beta_transform1[, c_count3] <- as.vector(N_E1[, c((e3 + 1):((K + 1) * c_count3))]) e3 <- II3[c_count3] } @@ -278,12 +278,12 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m e <- II[c_count] } - E[1:dim(C)[2], ] <- N_E[[1]] + E[1:ncol(C), ] <- N_E[[1]] c_count <- 2 e <- II[-length(II)][1] - for (c_count in 2:dim(C)[1]) { - E[c((e + 1):(c_count * dim(y)[2])), ] <- N_E[[c_count]] + for (c_count in 2:nrow(C)) { + E[c((e + 1):(c_count * ncol(y))), ] <- N_E[[c_count]] e <- II[c_count] } @@ -338,7 +338,7 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m } ### iteration res_val <- t(I) %*% (E) - for (jj in 1:dim(y)[2]) { + for (jj in 1:ncol(y)) { group <- (t(G) %*% t((V[, , jj]))) group1 <- group[1, ] diff --git a/R/conv_H2T.R b/R/conv_H2T.R index c4aee83..6c14a96 100644 --- a/R/conv_H2T.R +++ b/R/conv_H2T.R @@ -1,5 +1,5 @@ conv_H2T <- function(H, w_max) { - K <- dim(H)[1] + 1 + K <- nrow(H) + 1 Nd <- cbind(rep((K + 1):(2 * K - 1), each = 2), as.vector(t(H[, 1:2]))) W_norm <- H[, 3] / max(H[, 3]) conv0 <- conv_Nd2T(Nd, W_norm, w_max) diff --git a/R/count_nonzero_a.R b/R/count_nonzero_a.R index e6f9b1b..01752b4 100644 --- a/R/count_nonzero_a.R +++ b/R/count_nonzero_a.R @@ -7,8 +7,8 @@ count_nonzero_a <- function(x) { } n <- max(count1) } else { - count1 <- matrix(0, dim(x)[2]) - for (ww in 1:dim(x)[2]) { + count1 <- matrix(0, ncol(x)) + for (ww in 1:ncol(x)) { n <- sum(x[, ww] != 0) count1[ww] <- n } diff --git a/R/cv_MADMMplasso.R b/R/cv_MADMMplasso.R index f46202e..4f25b22 100644 --- a/R/cv_MADMMplasso.R +++ b/R/cv_MADMMplasso.R @@ -16,7 +16,7 @@ cv_MADMMplasso <- function(fit, nfolds, X, Z, y, alpha = 0.5, lambda = fit$Lambd no <- nrow(X) ggg <- vector("list", nfolds) - yhat <- array(NA, c(no, dim(y)[2], length(lambda[, 1]))) + yhat <- array(NA, c(no, ncol(y), length(lambda[, 1]))) if (is.null(foldid)) { foldid <- sample(rep(1:nfolds, ceiling(no / nfolds)), no, replace = FALSE) @@ -48,9 +48,9 @@ cv_MADMMplasso <- function(fit, nfolds, X, Z, y, alpha = 0.5, lambda = fit$Lambd non_zero <- c(fit$path$nzero) - cvm <- (apply(err, 2, mean, na.rm = TRUE)) / dim(y)[2] + cvm <- (apply(err, 2, mean, na.rm = TRUE)) / ncol(y) nn <- apply(!is.na(err), 2, sum, na.rm = TRUE) - cvsd <- sqrt(apply(err, 2, var, na.rm = TRUE) / (dim(y)[2] * nn)) + cvsd <- sqrt(apply(err, 2, var, na.rm = TRUE) / (ncol(y) * nn)) cvm.nz <- cvm cvm.nz[non_zero == 0] <- BIG diff --git a/R/fast_corr.R b/R/fast_corr.R index 463200f..17b56df 100644 --- a/R/fast_corr.R +++ b/R/fast_corr.R @@ -1,4 +1,4 @@ fast_corr <- function(A) { - C <- crossprod(scale(A)) / (dim(A)[1] - 1) + C <- crossprod(scale(A)) / (nrow(A) - 1) return(C) } diff --git a/R/objective.R b/R/objective.R index 86038f0..8f9e4f1 100644 --- a/R/objective.R +++ b/R/objective.R @@ -3,8 +3,8 @@ objective <- function(beta0, theta0, beta, theta, X, Z, y, alpha, lambda, p, N, mse <- (1 / (2 * N)) * loss l_1 <- sum(abs(beta)) - pliable_norm <- matrix(0, dim(y)[2]) - for (ee in 1:dim(y)[2]) { + pliable_norm <- matrix(0, ncol(y)) + for (ee in 1:ncol(y)) { beta11 <- beta[, ee] theta11 <- theta[, , ee] norm_1_l <- lapply( diff --git a/R/predict.MADMMplasso.R b/R/predict.MADMMplasso.R index 46fb99d..a61b55a 100644 --- a/R/predict.MADMMplasso.R +++ b/R/predict.MADMMplasso.R @@ -28,7 +28,7 @@ predict.MADMMplasso <- function(object, X, Z, y, lambda = NULL, ...) { p <- ncol(X) K <- ncol(as.matrix(Z)) - D <- dim(y)[2] + D <- ncol(y) my_W_hat <- generate_my_w(X = X, Z = Z) yh <- array(0, c(N, D, length(isel))) diff --git a/R/tree_parms.R b/R/tree_parms.R index d09e571..3fd4012 100644 --- a/R/tree_parms.R +++ b/R/tree_parms.R @@ -10,7 +10,7 @@ #' @export tree_parms <- function(y = y, h = 0.7) { - m <- dim(y)[2] + m <- ncol(y) myDist0 <- 1 - abs(fast_corr(y)) myDist <- myDist0[lower.tri(myDist0)] a0 <- dist(t(y)) diff --git a/inst/examples/MADMMplasso_example.R b/inst/examples/MADMMplasso_example.R index fcc82ca..38b7d03 100644 --- a/inst/examples/MADMMplasso_example.R +++ b/inst/examples/MADMMplasso_example.R @@ -81,7 +81,7 @@ alpha <- 0.2 tol <- 1E-3 fit <- MADMMplasso( X, Z, y, - alpha = alpha, my_lambda = matrix(rep(0.2, dim(y)[2]), 1), + 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, parallel = FALSE, pal = TRUE, gg = gg1, tol = tol, cl = 6 diff --git a/man/MADMMplasso.Rd b/man/MADMMplasso.Rd index b30a406..49d28bc 100644 --- a/man/MADMMplasso.Rd +++ b/man/MADMMplasso.Rd @@ -187,7 +187,7 @@ alpha <- 0.2 tol <- 1E-3 fit <- MADMMplasso( X, Z, y, - alpha = alpha, my_lambda = matrix(rep(0.2, dim(y)[2]), 1), + 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, parallel = FALSE, pal = TRUE, gg = gg1, tol = tol, cl = 6 diff --git a/tests/testthat/test-MADMMplasso.R b/tests/testthat/test-MADMMplasso.R index 33df6ba..daa5f7b 100644 --- a/tests/testthat/test-MADMMplasso.R +++ b/tests/testthat/test-MADMMplasso.R @@ -82,7 +82,7 @@ tol <- 1E-3 set.seed(9356219) fit_C <- MADMMplasso( X, Z, y, - alpha = alpha, my_lambda = matrix(rep(0.2, dim(y)[2]), 1), + 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 = 1, parallel = FALSE, pal = TRUE, gg = gg1, tol = tol, cl = 6 @@ -92,7 +92,7 @@ fit_R <- suppressWarnings( suppressMessages( MADMMplasso( X, Z, y, - alpha = alpha, my_lambda = matrix(rep(0.2, dim(y)[2]), 1), + 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 = 1, parallel = FALSE, pal = TRUE, gg = gg1, tol = tol, cl = 6, legacy = TRUE diff --git a/tests/testthat/test-admm_MADMMplasso_cpp.R b/tests/testthat/test-admm_MADMMplasso_cpp.R index d8150f7..318a9a1 100644 --- a/tests/testthat/test-admm_MADMMplasso_cpp.R +++ b/tests/testthat/test-admm_MADMMplasso_cpp.R @@ -94,7 +94,7 @@ CW <- TT$Tw N <- nrow(X) p <- ncol(X) K <- ncol(Z) -D <- dim(y)[2] +D <- ncol(y) lambda <- rep(0.5, 6) alpha <- 0.5 e.abs <- 1E-4 @@ -109,14 +109,14 @@ my_W_hat <- generate_my_w(X = X, Z = Z) svd.w <- svd(my_W_hat) svd.w$tu <- t(svd.w$u) svd.w$tv <- t(svd.w$v) -input <- 1:(dim(y)[2] * nrow(C)) -multiple_of_D <- (input %% dim(y)[2]) == 0 -I <- matrix(0, nrow = nrow(C) * dim(y)[2], ncol = dim(y)[2]) +input <- 1:(ncol(y) * nrow(C)) +multiple_of_D <- (input %% ncol(y)) == 0 +I <- matrix(0, nrow = nrow(C) * ncol(y), ncol = ncol(y)) II <- input[multiple_of_D] -diag(I[1:dim(y)[2], ]) <- C[1, ] * (CW[1]) +diag(I[1:ncol(y), ]) <- C[1, ] * (CW[1]) c_count <- 2 for (e in II[-length(II)]) { - diag(I[c((e + 1):(c_count * dim(y)[2])), ]) <- C[c_count, ] * (CW[c_count]) + diag(I[c((e + 1):(c_count * ncol(y))), ]) <- C[c_count, ] * (CW[c_count]) c_count <- 1 + c_count } new_I <- diag(t(I) %*% I) @@ -137,14 +137,14 @@ beta <- (matrix(0, p, D)) beta_hat <- (matrix(0, p + p * (K), D)) V <- (array(0, c(p, 2 * (1 + K), D))) O <- (array(0, c(p, 2 * (1 + K), D))) -E <- (matrix(0, dim(y)[2] * nrow(C), (p + p * K))) # response auxiliary +E <- (matrix(0, ncol(y) * nrow(C), (p + p * K))) # response auxiliary EE <- (array(0, c(p, (1 + K), D))) # auxiliary variables for the L1 norm#### theta <- (array(0, c(p, K, D))) Q <- (array(0, c(p, (1 + K), D))) P <- (array(0, c(p, (1 + K), D))) -H <- (matrix(0, dim(y)[2] * nrow(C), (p + p * K))) # response multiplier +H <- (matrix(0, ncol(y) * nrow(C), (p + p * K))) # response multiplier HH <- (array(0, c(p, (1 + K), D))) r_current <- y b <- reg_temp(r_current, Z) # Analytic solution how no sample lower bound (Z.T @ Z + cI)^-1 @ (Z.T @ r) diff --git a/tests/testthat/test-parallel.R b/tests/testthat/test-parallel.R index 7decb79..9597485 100644 --- a/tests/testthat/test-parallel.R +++ b/tests/testthat/test-parallel.R @@ -78,7 +78,7 @@ mad_wrap <- function(seed = 3398, ...) { suppressMessages( MADMMplasso( X, Z, y, - alpha = 0.2, my_lambda = matrix(rep(0.2, dim(y)[2]), 1), + alpha = 0.2, my_lambda = matrix(rep(0.2, ncol(y)), 1), lambda_min = 0.001, max_it = 5000, e.abs = 1e-4, e.rel = 1e-2, maxgrid = 1L, nlambda = 1L, rho = 5, tree = TT, my_print = FALSE, alph = 1, gg = gg1, tol = 1e-3, cl = 2, ... From fc5685d3d8ad4ec899dc886d9db895175966c419 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 11:51:51 +0200 Subject: [PATCH 5/9] Replace `1:` with `seq_len()` (#45) Avoids bugs when iterating over a value of 0. --- R/MADMMplasso.R | 4 ++-- R/admm_MADMMplasso.R | 10 +++++----- R/count_nonzero_a.R | 2 +- R/objective.R | 2 +- tests/testthat/test-admm_MADMMplasso_cpp.R | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/R/MADMMplasso.R b/R/MADMMplasso.R index 6c2ae86..7607917 100644 --- a/R/MADMMplasso.R +++ b/R/MADMMplasso.R @@ -140,7 +140,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma I <- matrix(0, nrow = nrow(C) * ncol(y), ncol = ncol(y)) II <- input[multiple_of_D] - diag(I[1:ncol(y), ]) <- C[1, ] * (CW[1]) + diag(I[seq_len(ncol(y)), ]) <- C[1, ] * (CW[1]) c_count <- 2 for (e in II[-length(II)]) { @@ -172,7 +172,7 @@ MADMMplasso <- function(X, Z, y, alpha, my_lambda = NULL, lambda_min = 0.001, ma if (is.null(my_lambda)) { lam <- matrix(0, nlambda, ncol(y)) - for (i in 1:ncol(y)) { + for (i in seq_len(ncol(y))) { lam[, i] <- lambda_i[[i]] } } else { diff --git a/R/admm_MADMMplasso.R b/R/admm_MADMMplasso.R index 680f4fd..32d3300 100644 --- a/R/admm_MADMMplasso.R +++ b/R/admm_MADMMplasso.R @@ -60,7 +60,7 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m I <- matrix(0, nrow = nrow(C) * ncol(y), ncol = ncol(y)) II <- input[multiple_of_D] - diag(I[1:ncol(y), ]) <- C[1, ] * (CW[1]) + diag(I[seq_len(ncol(y)), ]) <- C[1, ] * (CW[1]) c_count <- 2 for (e in II[-length(II)]) { @@ -201,8 +201,8 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m beta.group <- (array(NA, c(p + p * K, ncol(y), nrow(C)))) N_E <- list() II <- input[multiple_of_D] - new.mat_group[, , 1] <- t((new.mat[1:ncol(y), ])) - beta.group[, , 1] <- t((Big_beta_respone[1:ncol(y), ])) + new.mat_group[, , 1] <- t((new.mat[seq_len(ncol(y)), ])) + beta.group[, , 1] <- t((Big_beta_respone[seq_len(ncol(y)), ])) beta_transform <- matrix(0, p, (K + 1) * ncol(y)) beta_transform[, 1:(1 + K)] <- matrix(new.mat_group[, 1, 1], ncol = (K + 1), nrow = p) @@ -278,7 +278,7 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m e <- II[c_count] } - E[1:ncol(C), ] <- N_E[[1]] + E[seq_len(ncol(C)), ] <- N_E[[1]] c_count <- 2 e <- II[-length(II)][1] @@ -338,7 +338,7 @@ admm_MADMMplasso <- function(beta0, theta0, beta, beta_hat, theta, rho1, X, Z, m } ### iteration res_val <- t(I) %*% (E) - for (jj in 1:ncol(y)) { + for (jj in seq_len(ncol(y))) { group <- (t(G) %*% t((V[, , jj]))) group1 <- group[1, ] diff --git a/R/count_nonzero_a.R b/R/count_nonzero_a.R index 01752b4..8920e30 100644 --- a/R/count_nonzero_a.R +++ b/R/count_nonzero_a.R @@ -8,7 +8,7 @@ count_nonzero_a <- function(x) { n <- max(count1) } else { count1 <- matrix(0, ncol(x)) - for (ww in 1:ncol(x)) { + for (ww in seq_len(ncol(x))) { n <- sum(x[, ww] != 0) count1[ww] <- n } diff --git a/R/objective.R b/R/objective.R index 8f9e4f1..bbe69aa 100644 --- a/R/objective.R +++ b/R/objective.R @@ -4,7 +4,7 @@ objective <- function(beta0, theta0, beta, theta, X, Z, y, alpha, lambda, p, N, l_1 <- sum(abs(beta)) pliable_norm <- matrix(0, ncol(y)) - for (ee in 1:ncol(y)) { + for (ee in seq_len(ncol(y))) { beta11 <- beta[, ee] theta11 <- theta[, , ee] norm_1_l <- lapply( diff --git a/tests/testthat/test-admm_MADMMplasso_cpp.R b/tests/testthat/test-admm_MADMMplasso_cpp.R index 318a9a1..8b42bb3 100644 --- a/tests/testthat/test-admm_MADMMplasso_cpp.R +++ b/tests/testthat/test-admm_MADMMplasso_cpp.R @@ -10,7 +10,7 @@ reg_temp <- function(r, Z) { K <- ncol(Z) beta01 <- matrix(0, 1, ncol(r)) theta01 <- matrix(0, ncol(Z), ncol(r)) - for (e in 1:ncol(r)) { + for (e in seq_len(ncol(r))) { my_one <- matrix(1, nrow(Z)) my_w <- data.frame(Z, my_one) my_w <- as.matrix(my_w) @@ -113,7 +113,7 @@ input <- 1:(ncol(y) * nrow(C)) multiple_of_D <- (input %% ncol(y)) == 0 I <- matrix(0, nrow = nrow(C) * ncol(y), ncol = ncol(y)) II <- input[multiple_of_D] -diag(I[1:ncol(y), ]) <- C[1, ] * (CW[1]) +diag(I[seq_len(ncol(y)), ]) <- C[1, ] * (CW[1]) c_count <- 2 for (e in II[-length(II)]) { diag(I[c((e + 1):(c_count * ncol(y))), ]) <- C[c_count, ] * (CW[c_count]) From 548bc09b5e86a07e5f1803ed5d5f896730d9f9fb Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 11:53:22 +0200 Subject: [PATCH 6/9] Replace `1:length()` with `seq_along()` (#45) --- R/conv_Nd2T.R | 2 +- R/plot_coeff.R | 2 +- R/predict.MADMMplasso.R | 4 ++-- R/tree_parms.R | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/conv_Nd2T.R b/R/conv_Nd2T.R index b074530..7910e82 100644 --- a/R/conv_Nd2T.R +++ b/R/conv_Nd2T.R @@ -10,7 +10,7 @@ conv_Nd2T <- function(Nd, w, w_max) { # =========================== find_leaves <- function(Nd, ch, K, Jt, w, Tw) { - for (ii in 1:length(ch)) { + for (ii in seq_along(ch)) { if (Nd[ch[ii], 2] > K) { leaves0 <- find_leaves(Nd, which(Nd[, 1] == Nd[ch[ii], 2]), K, Jt, w, Tw) Jt <- leaves0$Jt diff --git a/R/plot_coeff.R b/R/plot_coeff.R index 25a60c3..d89e205 100644 --- a/R/plot_coeff.R +++ b/R/plot_coeff.R @@ -36,7 +36,7 @@ plot_coeff <- function(beta, theta, error, nz, p, K, D, nlambda, Lambda) { index <- b sbeta <- (my_beta) for (j in act) { - for (i in 1:length(index)) { + for (i in seq_along(index)) { if (ntheta[j, i] > 0) text(index[i], sbeta[j, i], label = "x", cex = 0.7) } } diff --git a/R/predict.MADMMplasso.R b/R/predict.MADMMplasso.R index a61b55a..80e7a35 100644 --- a/R/predict.MADMMplasso.R +++ b/R/predict.MADMMplasso.R @@ -17,11 +17,11 @@ predict.MADMMplasso <- function(object, X, Z, y, lambda = NULL, ...) { lambda.arg <- lambda if (is.null(lambda.arg)) { lambda <- object$Lambdas[, 1] - isel <- 1:length(lambda) + isel <- seq_along(lambda) } if (!is.null(lambda.arg)) { - isel <- as.numeric(knn1(matrix(object$Lambdas[, 1], ncol = 1), matrix(lambda.arg, ncol = 1), 1:length(object$Lambdas[, 1]))) + isel <- as.numeric(knn1(matrix(object$Lambdas[, 1], ncol = 1), matrix(lambda.arg, ncol = 1), seq_along(object$Lambdas[, 1]))) } N <- nrow(X) diff --git a/R/tree_parms.R b/R/tree_parms.R index 3fd4012..e95f589 100644 --- a/R/tree_parms.R +++ b/R/tree_parms.R @@ -14,7 +14,7 @@ tree_parms <- function(y = y, h = 0.7) { myDist0 <- 1 - abs(fast_corr(y)) myDist <- myDist0[lower.tri(myDist0)] a0 <- dist(t(y)) - a0[1:length(a0)] <- myDist + a0[seq_along(a0)] <- myDist # hierarchical clustering for multivariate responses myCluster_0 <- hclust(a0, method = "complete") myCluster <- cbind(ifelse(myCluster_0$merge < 0, -myCluster_0$merge, myCluster_0$merge + m), myCluster_0$height) From 44886145df9f13bb8d7f0eafd2018b4db5d4b4f1 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 11:57:28 +0200 Subject: [PATCH 7/9] Increment version number to 0.0.0.9018 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 16a81af..53ae0e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: MADMMplasso Title: Multi Variate Multi Response 'ADMM' with Interaction Effects -Version: 0.0.0.9017 +Version: 0.0.0.9018 Authors@R: c( person( From dbc0791e3ad7b22bf4f08a689ef4340c93b70431 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 12:20:41 +0200 Subject: [PATCH 8/9] squash! Using implicit `return()` (#45) --- R/S_func.R | 2 +- R/conv_H2T.R | 4 +--- R/conv_Nd2T.R | 2 +- R/count_nonzero_a.R | 3 +-- R/fast_corr.R | 3 +-- R/post_process_cpp.R | 4 ++-- tests/testthat/test-admm_MADMMplasso_cpp.R | 2 +- 7 files changed, 8 insertions(+), 12 deletions(-) diff --git a/R/S_func.R b/R/S_func.R index cbec01f..3d47b2b 100644 --- a/R/S_func.R +++ b/R/S_func.R @@ -1,3 +1,3 @@ S_func <- function(x, a) { # Soft Thresholding Operator - return(pmax(abs(x) - a, 0) * sign(x)) + pmax(abs(x) - a, 0) * sign(x) } diff --git a/R/conv_H2T.R b/R/conv_H2T.R index 6c14a96..08635dd 100644 --- a/R/conv_H2T.R +++ b/R/conv_H2T.R @@ -2,7 +2,5 @@ conv_H2T <- function(H, w_max) { K <- nrow(H) + 1 Nd <- cbind(rep((K + 1):(2 * K - 1), each = 2), as.vector(t(H[, 1:2]))) W_norm <- H[, 3] / max(H[, 3]) - conv0 <- conv_Nd2T(Nd, W_norm, w_max) - - return(conv0) + conv_Nd2T(Nd, W_norm, w_max) } diff --git a/R/conv_Nd2T.R b/R/conv_Nd2T.R index 7910e82..09c5627 100644 --- a/R/conv_Nd2T.R +++ b/R/conv_Nd2T.R @@ -56,5 +56,5 @@ conv_Nd2T <- function(Nd, w, w_max) { Tree <- sparseMatrix(i = I, j = J, x = rep(1, length(I)), dims = c(V, K)) - return(list(Tree = Tree, Tw = Tw)) + list(Tree = Tree, Tw = Tw) } diff --git a/R/count_nonzero_a.R b/R/count_nonzero_a.R index 8920e30..1ff961c 100644 --- a/R/count_nonzero_a.R +++ b/R/count_nonzero_a.R @@ -14,6 +14,5 @@ count_nonzero_a <- function(x) { } n <- max(count1) } - - return(n) + n } diff --git a/R/fast_corr.R b/R/fast_corr.R index 17b56df..c215280 100644 --- a/R/fast_corr.R +++ b/R/fast_corr.R @@ -1,4 +1,3 @@ fast_corr <- function(A) { - C <- crossprod(scale(A)) / (nrow(A) - 1) - return(C) + crossprod(scale(A)) / (nrow(A) - 1) } diff --git a/R/post_process_cpp.R b/R/post_process_cpp.R index 84ce1fa..cb63406 100644 --- a/R/post_process_cpp.R +++ b/R/post_process_cpp.R @@ -1,11 +1,11 @@ post_process_cpp <- function(lst) { array2list <- function(ra) { - return(apply(ra, 3, function(x) x, simplify = FALSE)) + apply(ra, 3, function(x) x, simplify = FALSE) } lst$BETA0 <- array2list(lst$BETA0) lst$THETA0 <- array2list(lst$THETA0) lst$BETA <- array2list(lst$BETA) lst$BETA_hat <- array2list(lst$BETA_hat) lst$Y_HAT <- array2list(lst$Y_HAT) - return(lst) + lst } diff --git a/tests/testthat/test-admm_MADMMplasso_cpp.R b/tests/testthat/test-admm_MADMMplasso_cpp.R index 8b42bb3..438e03b 100644 --- a/tests/testthat/test-admm_MADMMplasso_cpp.R +++ b/tests/testthat/test-admm_MADMMplasso_cpp.R @@ -19,7 +19,7 @@ reg_temp <- function(r, Z) { beta01[e] <- matrix(my_res[(K + 1)]) theta01[, e] <- matrix(my_res[1:K]) } - return(list(beta0 = beta01, theta0 = theta01)) + list(beta0 = beta01, theta0 = theta01) } # Generate the data ============================================================ From fc412992cdf27609477c2c9942a4495dbf68377c Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Jul 2024 12:23:58 +0200 Subject: [PATCH 9/9] squash! Replace `1:` with `seq_len()` (#45) --- R/count_nonzero_a.R | 2 +- inst/examples/MADMMplasso_example.R | 2 +- man/MADMMplasso.Rd | 2 +- tests/testthat/test-admm_MADMMplasso_cpp.R | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/count_nonzero_a.R b/R/count_nonzero_a.R index 1ff961c..db43eb9 100644 --- a/R/count_nonzero_a.R +++ b/R/count_nonzero_a.R @@ -1,7 +1,7 @@ count_nonzero_a <- function(x) { if (length(dim(x)) == 3) { count1 <- matrix(0, dim(x)[3]) - for (ww in 1:dim(x)[3]) { + for (ww in seq_len(dim(x)[3])) { n <- sum(x[, , ww] != 0) count1[ww] <- n } diff --git a/inst/examples/MADMMplasso_example.R b/inst/examples/MADMMplasso_example.R index 38b7d03..8b7c3c6 100644 --- a/inst/examples/MADMMplasso_example.R +++ b/inst/examples/MADMMplasso_example.R @@ -67,7 +67,7 @@ e <- MASS::mvrnorm(N, mu = rep(0, 6), Sigma = esd) y_train <- X %*% Beta + pliable + e y <- y_train -colnames(y) <- c(paste0("y", 1:(ncol(y)))) +colnames(y) <- c(paste0("y", seq_len(ncol(y)))) TT <- tree_parms(y) plot(TT$h_clust) gg1 <- matrix(0, 2, 2) diff --git a/man/MADMMplasso.Rd b/man/MADMMplasso.Rd index 49d28bc..fdc31b8 100644 --- a/man/MADMMplasso.Rd +++ b/man/MADMMplasso.Rd @@ -173,7 +173,7 @@ e <- MASS::mvrnorm(N, mu = rep(0, 6), Sigma = esd) y_train <- X \%*\% Beta + pliable + e y <- y_train -colnames(y) <- c(paste0("y", 1:(ncol(y)))) +colnames(y) <- c(paste0("y", seq_len(ncol(y)))) TT <- tree_parms(y) plot(TT$h_clust) gg1 <- matrix(0, 2, 2) diff --git a/tests/testthat/test-admm_MADMMplasso_cpp.R b/tests/testthat/test-admm_MADMMplasso_cpp.R index 438e03b..04cbbba 100644 --- a/tests/testthat/test-admm_MADMMplasso_cpp.R +++ b/tests/testthat/test-admm_MADMMplasso_cpp.R @@ -87,7 +87,7 @@ e <- mvrnorm(N, mu = rep(0, 6), Sigma = esd) y_train <- X %*% Beta + pliable + e y <- y_train colnames(y) <- 1:6 -colnames(y) <- c(paste0("y", 1:(ncol(y)))) +colnames(y) <- c(paste0("y", seq_len(ncol(y)))) TT <- tree_parms(y) C <- TT$Tree CW <- TT$Tw