Merge pull request #47 from ocbe-uio/issue-45

Fixed CodeFactor issues

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(
@@ -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

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,20 +98,17 @@ 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) {
-        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, ])))
       }
     )
 
     big_lambda <- lammax
     lambda_i <- lapply(
-      seq_len(dim(y)[2]),
+      seq_len(ncol(y)),
       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)
@@ -134,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[seq_len(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)
@@ -174,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 seq_len(ncol(y))) {
       lam[, i] <- lambda_i[[i]]
     }
   } else {

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)
 }

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[seq_len(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
   }
 
@@ -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]))
@@ -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[seq_len(ncol(y)), ]))
+    beta.group[, , 1] <- t((Big_beta_respone[seq_len(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,34 +222,34 @@ 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]
     }
 
     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[seq_len(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 seq_len(ncol(y))) {
     group <- (t(G) %*% t((V[, , jj])))
 
     group1 <- group[1, ]

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
 }

R/conv_H2T.R

@@ -1,8 +1,6 @@
 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)
-
-  return(conv0)
+  conv_Nd2T(Nd, W_norm, w_max)
 }

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
@@ -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)
   }
   # ===========================
 
@@ -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)
 }

R/count_nonzero_a.R

@@ -1,19 +1,18 @@
 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
     }
     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 seq_len(ncol(x))) {
       n <- sum(x[, ww] != 0)
       count1[ww] <- n
     }
     n <- max(count1)
   }
-
-  return(n)
+  n
 }

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

R/fast_corr.R

@@ -1,4 +1,3 @@
 fast_corr <- function(A) {
-  C <- crossprod(scale(A)) / (dim(A)[1] - 1)
-  return(C)
+  crossprod(scale(A)) / (nrow(A) - 1)
 }

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)
 }

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 seq_len(ncol(y))) {
     beta11 <- beta[, ee]
     theta11 <- theta[, , ee]
     norm_1_l <- lapply(
@@ -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)
 }

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)
       }
     }