Commit 42577ab9 authored by Corson N. Areshenkoff's avatar Corson N. Areshenkoff

Fix estimate glasso

parent 15040eca
......@@ -6,7 +6,7 @@ Author: Corson N. Areshenkoff
Maintainer: Corson N. Areshenkoff <areshenk@protonmail.com>
Description: Means, differencing, and centering for symmetric positive-definite matrices.
Depends: R (>= 3.0.2),
Imports: expm, huge, nlshrink, kernlab
Imports: expm, huge, nlshrink, kernlab, lattice
License: GPL-3
Encoding: UTF-8
LazyData: true
......
......@@ -11,7 +11,6 @@ export(spddot)
export(spd.whiten)
export(spd.correlation)
export(spd.transport)
export(spd.heatmap)
importFrom(expm,expm)
importFrom(expm,logm)
......
......@@ -13,12 +13,22 @@ spd.estimate.nlshrink <- function(x, ...){
spd.estimate.glasso <- function(x, ...){
pars <- list(...)
pars.huge <- pars[grepl(pattern = 'huge.', names(pars), fixed = T)]
pars.huge$huge.method <- 'glasso'
pars.huge$huge.cov.output <- TRUE
pars.select <- pars[grepl(pattern = 'select.', names(pars), fixed = T)]
names(pars.huge) <- unlist(strsplit(names(pars.huge), split = '.', fixed = T))[2]
names(pars.select) <- unlist(strsplit(names(pars.select), split = '.', fixed = T))[2]
pars.select$verbose <- FALSE
names(pars.huge) <- sapply(names(pars.huge), function(i) {
gsub('huge.', '', i, fixed = T)
})
names(pars.select) <- sapply(names(pars.select), function(i) {
gsub('select.', '', i, fixed = T)
})
huge.fit <- do.call(huge, c(list(x = x, method = 'glasso', cov.output = T), pars.huge))
huge.fit <- do.call(huge, c(list(x = x), pars.huge))
S <- as.matrix(do.call(huge.select, c(list(huge.fit), pars.select))$opt.cov)
return(S)
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment