rm niter

Carol-seven · Nov 11, 2024 · 847ed28 · 847ed28
1 parent def115a
commit 847ed28
Show file tree

Hide file tree

Showing 24 changed files with 258 additions and 722 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -37,12 +37,9 @@ Imports:
     rags2ridges,
     RBGL,
     Rdpack
-Suggests: 
-    roxyglobals
-RdMacros: 
-    Rdpack
-Remotes: 
-    TobiasRuckstuhl/GLassoElnetFast
+Suggests: roxyglobals
+RdMacros: Rdpack
+Remotes: TobiasRuckstuhl/GLassoElnetFast
 biocViews: RBGL, graph
 Config/roxyglobals/filename: globals.R
 Config/roxyglobals/unique: FALSE

diff --git a/R/fcstat.R b/R/fcstat.R
@@ -148,13 +148,11 @@
 #' \item{hatOmega_opt}{The estimated precision matrix.}
 #' \item{lambda_opt}{The optimal regularization parameter.}
 #' \item{gamma_opt}{The optimal hyperparameter.}
-#' \item{niter_opt}{The number of iterations.}
 #' \item{loss_opt}{The optimal k-fold loss.}
 #' \item{hatOmega}{A list of estimated precision matrices for \code{lambda} grid and
 #' \code{gamma} grid.}
 #' \item{lambda}{The actual lambda grid used in the program, corresponding to \code{hatOmega}.}
 #' \item{gamma}{The actual gamma grid used in the program, corresponding to \code{hatOmega}.}
-#' \item{niter}{The number of iterations, corresponding to \code{hatOmega}.}
 #' \item{loss.mean}{The mean of k-fold loss for each parameter grid value.}
 #' \item{loss.sd}{The standard deviation of k-fold loss for each parameter grid value.}
 #' }
@@ -163,13 +161,11 @@
 #' \item{hatOmega_opt}{The estimated precision matrix.}
 #' \item{lambda_opt}{The optimal regularization parameter.}
 #' \item{gamma_opt}{The optimal hyperparameter.}
-#' \item{niter_opt}{The number of iterations.}
 #' \item{score_opt}{The optimal information criterion score.}
 #' \item{hatOmega}{A list of estimated precision matrices for \code{lambda} grid and
 #' \code{gamma} grid.}
 #' \item{lambda}{The actual lambda grid used in the program, corresponding to \code{hatOmega}.}
 #' \item{gamma}{The actual gamma grid used in the program, corresponding to \code{hatOmega}.}
-#' \item{niter}{The number of iterations, corresponding to \code{hatOmega}.}
 #' \item{score}{The information criterion score for each parameter grid value.}
 #' }
 #' }
@@ -203,7 +199,6 @@ fcstat <- function(
     lambda <- est.obj$lambda
     gamma <- est.obj$gamma
     hatOmega <- est.obj$hatOmega
-    niter <- est.obj$niter
 
     if (crit == "CV") {
 
@@ -258,12 +253,10 @@ fcstat <- function(
       result <- list(hatOmega_opt = hatOmega[[index]],
                      lambda_opt = lambda[index],
                      gamma_opt = gamma[index],
-                     niter_opt = niter[index],
                      loss_opt = loss.mean[index],
                      hatOmega = hatOmega,
                      lambda = lambda,
                      gamma = gamma,
-                     niter = niter,
                      loss.mean = loss.mean,
                      loss.sd = loss.sd)
 
@@ -291,12 +284,10 @@ fcstat <- function(
       result <- list(hatOmega_opt = hatOmega[[index]],
                      lambda_opt = lambda[index],
                      gamma_opt = gamma[index],
-                     niter_opt = niter[index],
                      score_opt = score[index],
                      hatOmega = hatOmega,
                      lambda = lambda,
                      gamma = gamma,
-                     niter = niter,
                      score = score)
     }
 

diff --git a/R/fcstat.est.R b/R/fcstat.est.R
@@ -139,7 +139,6 @@
 #' \code{gamma} grid.}
 #' \item{lambda}{The actual lambda grid used in the program, corresponding to \code{hatOmega}.}
 #' \item{gamma}{The actual gamma grid used in the program, corresponding to \code{hatOmega}.}
-#' \item{niter}{The number of iterations, corresponding to \code{hatOmega}.}
 #' \item{X}{The n-by-p data matrix used in the program.}
 #' \item{S}{The p-by-p calculation base matrix used in the program.}
 #' }
@@ -228,8 +227,8 @@ fcstat.est <- function(
 
     ## compute the precision matrix estimator hatOmega along the parameter grid
     if (method %in% c("glasso", "ridge", "elnet", "clime", "tiger")) {
-      reslist <- foreach(k = 1:npara, .packages = "fcstat",
-                         .export = c("fcstat_method")) %dopar% {
+      hatOmega <- foreach(k = 1:npara, .packages = "fcstat",
+                          .export = c("fcstat_method")) %dopar% {
         fcstat_method(method = method, X = X, S = S,
                       lambda = parameter$lambda[k], gamma = parameter$gamma[k],
                       pkgopt = pkgopt)
@@ -241,19 +240,16 @@ fcstat.est <- function(
                       lambda = parameter$lambda[k], gamma = parameter$gamma[k])
       })
       if (pkgopt == "glasso") {
-        reslist <- foreach(k = 1:npara) %dopar% {
-          res <- glasso::glasso(s = S, rho = lambda_mat[[k]], penalize.diagonal = TRUE, start = "cold")
-          return(list(hatOmega = res$wi, niter = res$niter))
+        hatOmega <- foreach(k = 1:npara) %dopar% {
+          glasso::glasso(s = S, rho = lambda_mat[[k]], penalize.diagonal = TRUE, start = "cold")$wi
         }
       } else if (pkgopt == "GLassoElnetFast") {
-        reslist <- foreach(k = 1:npara) %dopar% {
-          res <- GLassoElnetFast::gelnet(S = S, lambda = lambda_mat[[k]], alpha = 1, penalize.diagonal = TRUE)
-          return(list(hatOmega = res$Theta, niter = res$niter))
+        hatOmega <- foreach(k = 1:npara) %dopar% {
+          GLassoElnetFast::gelnet(S = S, lambda = lambda_mat[[k]], alpha = 1, penalize.diagonal = TRUE)$Theta
         }
       } else if (pkgopt == "glassoFast") {
-        reslist <- foreach(k = 1:npara) %dopar% {
-          res <- glassoFast::glassoFast(S = S, rho = lambda_mat[[k]], start = "cold")
-          return(list(hatOmega = res$wi, niter = res$niter))
+        hatOmega <- foreach(k = 1:npara) %dopar% {
+          glassoFast::glassoFast(S = S, rho = lambda_mat[[k]], start = "cold")$wi
         }
       }
     }
@@ -264,7 +260,7 @@ fcstat.est <- function(
 
     ## compute the precision matrix estimator hatOmega along the parameter grid
     if (method %in% c("glasso", "ridge", "elnet", "clime", "tiger")) {
-      reslist <- lapply(1:npara, function(k) {
+      hatOmega <- lapply(1:npara, function(k) {
         fcstat_method(method = method, X = X, S = S,
                       lambda = parameter$lambda[k], gamma = parameter$gamma[k],
                       pkgopt = pkgopt)
@@ -276,28 +272,24 @@ fcstat.est <- function(
                       lambda = parameter$lambda[k], gamma = parameter$gamma[k])
       })
       if (pkgopt == "glasso") {
-        reslist <- lapply(1:npara, function(k) {
-          res <- glasso::glasso(s = S, rho = lambda_mat[[k]], penalize.diagonal = TRUE, start = "cold")
-          return(list(hatOmega = res$wi, niter = res$niter))
+        hatOmega <- lapply(1:npara, function(k) {
+          glasso::glasso(s = S, rho = lambda_mat[[k]], penalize.diagonal = TRUE, start = "cold")$wi
         })
       } else if (pkgopt == "GLassoElnetFast") {
-        reslist <- lapply(1:npara, function(k) {
-          res <- GLassoElnetFast::gelnet(S = S, lambda = lambda_mat[[k]], alpha = 1, penalize.diagonal = TRUE)
-          return(list(hatOmega = res$Theta, niter = res$niter))
+        hatOmega <- lapply(1:npara, function(k) {
+          GLassoElnetFast::gelnet(S = S, lambda = lambda_mat[[k]], alpha = 1, penalize.diagonal = TRUE)$Theta
         })
       } else if (pkgopt == "glassoFast") {
-        reslist <- lapply(1:npara, function(k) {
-          res <- glassoFast::glassoFast(S = S, rho = lambda_mat[[k]], start = "cold")
-          return(list(hatOmega = res$wi, niter = res$niter))
+        hatOmega <- lapply(1:npara, function(k) {
+          glassoFast::glassoFast(S = S, rho = lambda_mat[[k]], start = "cold")$wi
         })
       }
     }
   }
 
-  result <- list(hatOmega = lapply(reslist, function(x) x$hatOmega),
+  result <- list(hatOmega = hatOmega,
                  lambda = parameter$lambda,
                  gamma = parameter$gamma,
-                 niter = sapply(reslist, function(x) x$niter),
                  X = X,
                  S = S)
   class(result) <- c("fcstat.est")

diff --git a/R/fcstat_method.R b/R/fcstat_method.R
@@ -76,10 +76,7 @@
 #' @importFrom huge huge.tiger
 #' @importFrom Rdpack reprompt
 #'
-#' @return A list with the following: \describe{
-#' \item{hatOmega}{The estimated precision matrix.}
-#' \item{niter}{Number of iterations.}
-#' }
+#' @return Estimated precision matrix.
 #'
 #' @noRd
 
@@ -88,69 +85,51 @@ fcstat_method <- function(method, X = NULL, S = NULL,
                           pkgopt = NULL) {
   if (method == "glasso") {
     if (pkgopt == "ADMMsigma") {
-      res <- ADMMsigma::ADMMsigma(S = S, lam = lambda, alpha = 1, diagonal = TRUE)
-      result <- list(hatOmega = res$Z, niter = res$Iterations)
+      hatOmega <- ADMMsigma::ADMMsigma(S = S, lam = lambda, alpha = 1, diagonal = TRUE)$Z
     } else if (pkgopt == "CovTools") {
-      res <- CovTools::PreEst.glasso(X = X, method = list(type = "fixed", param = lambda))
-      result <- list(hatOmega = res$C, niter = NULL)
+      hatOmega <- CovTools::PreEst.glasso(X = X, method = list(type = "fixed", param = lambda))$C
     } else if (pkgopt == "CVglasso") {
-      res <- CVglasso::CVglasso(S = S, lam = lambda, diagonal = TRUE)
-      result <- list(hatOmega = res$Omega, niter = res$Iterations)
+      hatOmega <- CVglasso::CVglasso(S = S, lam = lambda, diagonal = TRUE)$Omega
     } else if (pkgopt == "Glarmadillo") {
-      res <- Glarmadillo::glarma(s = S, rho = lambda)
-      result <- list(hatOmega = res$Theta, niter = res$iter)
+      hatOmega <- Glarmadillo::glarma(s = S, rho = lambda)$Theta
     } else if (pkgopt == "glasso") {
-      res <- glasso::glasso(s = S, rho = lambda, penalize.diagonal = TRUE, start = "cold")
-      result <- list(hatOmega = res$wi, niter = res$niter)
+      hatOmega <- glasso::glasso(s = S, rho = lambda, penalize.diagonal = TRUE, start = "cold")$wi
     } else if (pkgopt == "GLassoElnetFast") {
-      res <- GLassoElnetFast::gelnet(S = S, lambda = lambda, alpha = 1, penalize.diagonal = TRUE)
-      result <- list(hatOmega = res$Theta, niter = res$niter)
+      hatOmega <- GLassoElnetFast::gelnet(S = S, lambda = lambda, alpha = 1, penalize.diagonal = TRUE)$Theta
     } else if (pkgopt == "glassoFast") {
-      res <- glassoFast::glassoFast(S = S, rho = lambda, start = "cold")
-      result <- list(hatOmega = res$wi, niter = res$niter)
+      hatOmega <- glassoFast::glassoFast(S = S, rho = lambda, start = "cold")$wi
     } else if (pkgopt == "huge") {
-      res <- huge::huge.glasso(x = S, lambda = lambda, verbose = FALSE)
-      result <- list(hatOmega = res$icov[[1]], niter = NULL)
+      hatOmega <- huge::huge.glasso(x = S, lambda = lambda, verbose = FALSE)$icov[[1]]
     }
   } else if (method == "ridge") {
     if (pkgopt == "ADMMsigma") {
-      res <- ADMMsigma::RIDGEsigma(S = S, lam = lambda)
-      result <- list(hatOmega = res$Omega, niter = NULL)
+      hatOmega <- ADMMsigma::RIDGEsigma(S = S, lam = lambda)$Omega
     } else if (pkgopt == "GLassoElnetFast") {
-      res <- GLassoElnetFast::gelnet(S = S, lambda = lambda, alpha = 0)
-      result <- list(hatOmega = res$Theta, niter = res$niter)
+      hatOmega <- GLassoElnetFast::gelnet(S = S, lambda = lambda, alpha = 0)$Theta
     } else if (pkgopt == "porridge") {
-      res <- porridge::ridgePgen(S = S, lambda = matrix(lambda, ncol(S), ncol(S)), target = matrix(0, ncol(S), ncol(S)))
-      result <- list(hatOmega = res, niter = NULL)
+      hatOmega <- porridge::ridgePgen(S = S, lambda = matrix(lambda, ncol(S), ncol(S)), target = matrix(0, ncol(S), ncol(S)))
     } else if (pkgopt == "rags2ridges") {
-      res <- rags2ridges::ridgeP(S = S, lambda = lambda, target = matrix(0, ncol(S), ncol(S)))
-      result <- list(hatOmega = res, niter = NULL)
+      hatOmega <- rags2ridges::ridgeP(S = S, lambda = lambda, target = matrix(0, ncol(S), ncol(S)))
     }
   } else if (method == "elnet") {
     if (pkgopt == "ADMMsigma") {
-      res <- ADMMsigma::ADMMsigma(S = S, lam = lambda, alpha = gamma)
-      result <- list(hatOmega = res$Z, niter = res$Iterations)
+      hatOmega <- ADMMsigma::ADMMsigma(S = S, lam = lambda, alpha = gamma)$Z
     } else if (pkgopt == "GLassoElnetFast") {
-      res <- GLassoElnetFast::gelnet(S = S, lambda = lambda, alpha = gamma)
-      result <- list(hatOmega = res$Theta, niter = res$niter)
+      hatOmega <- GLassoElnetFast::gelnet(S = S, lambda = lambda, alpha = gamma)$Theta
     }
   } else if (method == "clime") {
     if (pkgopt == "clime") {
-      res <- clime::clime(x = S, lambda = lambda, sigma = TRUE, standardize = FALSE, linsolver = "simplex")
-      result <- list(hatOmega = res$Omegalist[[1]], niter = NULL)
+      hatOmega <- clime::clime(x = S, lambda = lambda, sigma = TRUE, standardize = FALSE, linsolver = "simplex")$Omegalist[[1]]
     } else if (pkgopt == "flare") {
-      res <- flare::sugm(data = S, lambda = lambda, method = "clime", verbose = FALSE)
-      result <- list(hatOmega = res$icov[[1]], niter = res$ite)
+      hatOmega <- flare::sugm(data = S, lambda = lambda, method = "clime", verbose = FALSE)$icov[[1]]
     }
   } else if (method == "tiger") {
     if (pkgopt == "flare") {
-      res <- flare::sugm(data = X, lambda = lambda, method = "tiger", verbose = FALSE)
-      result <- list(hatOmega = res$icov[[1]], niter = res$ite)
+      hatOmega <- flare::sugm(data = X, lambda = lambda, method = "tiger", verbose = FALSE)$icov[[1]]
     } else if (pkgopt == "huge") {
-      res <- huge::huge.tiger(x = X, lambda = lambda, verbose = FALSE)
-      result <- list(hatOmega = res$icov[[1]], niter = NULL)
+      hatOmega <- huge::huge.tiger(x = X, lambda = lambda, verbose = FALSE)$icov[[1]]
     }
   }
-  return(result)
+  return(hatOmega)
 }
 
diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/LICENSE.html b/docs/LICENSE.html
diff --git a/docs/authors.html b/docs/authors.html
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/pkgdown.js b/docs/pkgdown.js
@@ -152,11 +152,3 @@ async function searchFuse(query, callback) {
   });
   });
 })(window.jQuery || window.$)
-
-document.addEventListener('keydown', function(event) {
-  // Check if the pressed key is '/'
-  if (event.key === '/') {
-    event.preventDefault();  // Prevent any default action associated with the '/' key
-    document.getElementById('search-input').focus();  // Set focus to the search input
-  }
-});
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -1,8 +1,8 @@
 pandoc: '3.4'
-pkgdown: 2.1.1
+pkgdown: 2.1.0
 pkgdown_sha: ~
 articles: {}
-last_built: 2024-11-02T06:36Z
+last_built: 2024-11-11T20:18Z
 urls:
   reference: https://github.com/Carol-seven/fcstat/reference
   article: https://github.com/Carol-seven/fcstat/articles
diff --git a/docs/reference/criterion.html b/docs/reference/criterion.html