From b25558f48fafe08aaa744872415adca08ccd1e62 Mon Sep 17 00:00:00 2001
From: "Pavel N. Krivitsky"
Date: Mon, 18 Dec 2023 18:34:18 +1100
Subject: [PATCH] Moved sginv() and xTAx_seigen() into statnet.common and
bumped the required version.
---
DESCRIPTION | 4 +---
NAMESPACE | 2 --
R/ergm.utility.R | 56 ------------------------------------------------
R/zzz.R | 2 --
4 files changed, 1 insertion(+), 63 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 9e09bb04e..dec1c66b3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -25,10 +25,8 @@ Imports:
robustbase (>= 0.93.7),
coda (>= 0.19.4),
trust (>= 0.1.8),
- Matrix (>= 1.3.2),
lpSolveAPI (>= 5.5.2.0.17.7),
- MASS (>= 7.3.53.1),
- statnet.common (>= 4.9.0),
+ statnet.common (>= 4.10.0),
rle (>= 0.9.2),
purrr (>= 0.3.4),
rlang (>= 0.4.10),
diff --git a/NAMESPACE b/NAMESPACE
index dd878bf98..39199b5bd 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -279,8 +279,6 @@ import(purrr)
import(rle)
import(statnet.common)
import(stats)
-importFrom(MASS,ginv)
-importFrom(Matrix,nearPD)
importFrom(Rdpack,reprompt)
importFrom(coda,mcmc)
importFrom(graphics,abline)
diff --git a/R/ergm.utility.R b/R/ergm.utility.R
index a6edb2091..bed968a5e 100644
--- a/R/ergm.utility.R
+++ b/R/ergm.utility.R
@@ -264,59 +264,3 @@ trim_env_const_formula <- function(x, keep=NULL){
if(needs_env) x else trim_env(x, keep)
}
-
-### A patched version of statnet.common::sginv() that uses
-### eigendecomposition rather than the SVD for the case when symmetric
-### non-negative-definite (snnd) is TRUE.
-###
-### TODO: Delete after incorporation into statnet.common.
-sginv <- function(X, tol = sqrt(.Machine$double.eps), ..., snnd = TRUE){
- if(!snnd) statnet.common::sginv(X, ..., snnd)
-
- d <- diag(as.matrix(X))
- d <- ifelse(d==0, 1, 1/d)
-
- d <- sqrt(d)
- if(anyNA(d)) stop("Matrix a has negative elements on the diagonal, and snnd=TRUE.")
- dd <- rep(d, each = length(d)) * d
- X <- X * dd
-
- ## Perform inverse via eigendecomposition, removing too-small eigenvalues.
- e <- eigen(X, symmetric=TRUE)
- keep <- e$values > max(tol * e$values[1L], 0)
- e$vectors[, keep, drop=FALSE] %*% ((1/e$values[keep]) * t(e$vectors[, keep, drop=FALSE])) * dd
-}
-
-#' Evaluate a quadratic form with a possibly singular matrix using
-#' eigendecomposition after scaling to correlation.
-#'
-#' Let \eqn{A} be the matrix of interest, and let \eqn{D} is a
-#' diagonal matrix whose diagonal is same as that of \eqn{A}.
-#'
-#' Let \eqn{R = D^{-1/2} A D^{-1/2}}. Then \eqn{A = D^{1/2} R D^{1/2}} and
-#' \eqn{A^{-1} = D^{-1/2} R^{-1} D^{-1/2}}.
-#'
-#' Decompose \eqn{R = P L P'} for \eqn{L} diagonal matrix of eigenvalues
-#' and \eqn{P} orthogonal. Then \eqn{R^{-1} = P L^{-1} P'}.
-#'
-#' Substituting,
-#' \deqn{x' A^{-1} x = x' D^{-1/2} P L^{-1} P' D^{-1/2} x = h' L^{-1} h}
-#' for \eqn{h = P' D^{-1/2} x}.
-#'
-#' @noRd
-xTAx_seigen <- function(x, A, tol=sqrt(.Machine$double.eps), ...) {
- d <- diag(as.matrix(A))
- d <- ifelse(d<=0, 0, 1/d)
-
- d <- sqrt(d)
- dd <- rep(d, each = length(d)) * d
- A <- A * dd
-
- e <- eigen(A)
-
- keep <- e$values > max(tol * e$values[1L], 0)
-
- h <- drop(crossprod(x*d, e$vectors[,keep,drop=FALSE]))
-
- structure(sum(h*h/e$values[keep]), rank = sum(keep), nullity = sum(!keep))
-}
diff --git a/R/zzz.R b/R/zzz.R
index ec0492bf1..0a3b66443 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -8,8 +8,6 @@
# Copyright 2003-2023 Statnet Commons
################################################################################
#' @importFrom Rdpack reprompt
-#' @importFrom MASS ginv
-#' @importFrom Matrix nearPD
.onAttach <- function(libname, pkgname){
#' @importFrom statnet.common statnetStartupMessage
sm <- statnetStartupMessage("ergm", c("statnet","ergm.count","tergm"), TRUE)