estimate | R Documentation |
The main function for the generalized score-matching estimator for graphical models.
estimate(
x,
setting,
domain,
elts = NULL,
centered = TRUE,
symmetric = "symmetric",
scale = "",
lambda1s = NULL,
lambda_length = NULL,
lambda_ratio = Inf,
mode = NULL,
param1 = NULL,
param2 = NULL,
h_hp = NULL,
unif_dist = NULL,
verbose = TRUE,
verbosetext = "",
tol = 1e-06,
maxit = 1000,
BIC_refit = TRUE,
warmstart = TRUE,
diagonal_multiplier = NULL,
eBIC_gammas = c(0, 0.5, 1),
cv_fold = NULL,
cv_fold_seed = NULL,
return_raw = FALSE,
return_elts = FALSE
)
x |
An |
setting |
A string that indicates the distribution type, must be one of |
domain |
A list returned from |
elts |
A list (optional), elements necessary for calculations returned by get_elts(). |
centered |
A boolean, whether in the centered setting (assume |
symmetric |
A string. If equals |
scale |
A string indicating the scaling method. If contains |
lambda1s |
A vector of lambdas, the penalty parameter for K. |
lambda_length |
An integer >= 2, the number of lambda1s. Ignored if |
lambda_ratio |
A positive number, the fixed ratio between |
mode |
A string, the class of the |
param1 |
A number, the first parameter to the |
param2 |
A number, the second parameter (may be optional depending on |
h_hp |
A function that returns a list containing |
unif_dist |
Optional, defaults to |
verbose |
Optional. A boolean, whether to output intermediate results. |
verbosetext |
Optional. A string, text to be added to the end of each printout if |
tol |
Optional. A number, the tolerance parameter. Default to |
maxit |
Optional. A positive integer, the maximum number of iterations for each fit. Default to |
BIC_refit |
A boolean, whether to get the BIC scores by refitting an unpenalized model restricted to the estimated edges, with |
warmstart |
Optional. A boolean, whether to use the results from a previous (larger) lambda as a warm start for each new lambda. Default to |
diagonal_multiplier |
A number >= 1, the diagonal multiplier. Optional and ignored if elts is provided. If |
eBIC_gammas |
Optional. A number of a vector of numbers. The |
cv_fold |
Optional. An integer larger than 1 if provided. The number of folds used for cross validation. If provided, losses will be calculated on each fold with model fitted on the other folds, and a |
cv_fold_seed |
Optional. Seed for generating folds for cross validation. |
return_raw |
A boolean, whether to return the raw estimates of |
return_elts |
A boolean, whether to return the |
edgess |
A list of vectors of integers: indices of the non-zero edges. |
BICs |
A |
lambda1s |
A vector of numbers of length |
converged |
A vector of booleans of length |
iters |
A vector of integers of length |
In addition,
if centered == FALSE
,
etas |
A |
if centered == FALSE
and non-profiled,
lambda2s |
A vector of numbers of length |
if return_raw == TRUE
,
raw_estimate |
A list that contains |
if BIC_refit == TRUE
,
BIC_refits |
A |
if cv_fold
is not NULL
,
cv_losses |
A |
if return_elts == TRUE
,
elts |
A list of elements returned from |
# Examples are shown for Gaussian truncated to R+^p only. For other distributions
# on other types of domains, please refer to \code{gen()} or \code{get_elts()},
# as the way to call this function (\code{estimate()}) is exactly the same in those cases.
n <- 30
p <- 20
domain <- make_domain("R+", p=p)
mu <- rep(0, p)
K <- diag(p)
lambda1s <- c(0.01,0.1,0.2,0.3,0.4,0.5)
dm <- 1 + (1-1/(1+4*exp(1)*max(6*log(p)/n, sqrt(6*log(p)/n))))
x <- tmvtnorm::rtmvnorm(n, mean = mu, sigma = solve(K),
lower = rep(0, p), upper = rep(Inf, p), algorithm = "gibbs",
burn.in.samples = 100, thinning = 10)
## Centered estimates, no elts or h provided, mode and params provided
est1 <- estimate(x, "gaussian", domain=domain, elts=NULL, centered=TRUE,
symmetric="symmetric", lambda1s=lambda1s, mode="min_pow",
param1=1, param2=3, diag=dm, return_raw=TRUE, verbose=FALSE)
h_hp <- get_h_hp("min_pow", 1, 3)
## Centered estimates, no elts provided, h provided; equivalent to est1
est2 <- estimate(x, "gaussian", domain=domain, elts=NULL, centered=TRUE,
symmetric="symmetric", lambda1s=lambda1s, h_hp=h_hp, diag=dm,
return_raw=TRUE, verbose=FALSE)
compare_two_results(est1, est2) ## Should be almost all 0
elts_gauss_c <- get_elts(h_hp, x, setting="gaussian", domain=domain,
centered=TRUE, diag=dm)
## Centered estimates, elts provided; equivalent to est1 and est2
## Here diagonal_multiplier will be set to the default value, equal to dm above
est3 <- estimate(x, "gaussian", domain=domain, elts=elts_gauss_c,
symmetric="symmetric", lambda1s=lambda1s, diag=NULL,
return_raw=TRUE, verbose=FALSE)
compare_two_results(est1, est3) ## Should be almost all 0
## Non-centered estimates with Inf penalty on eta; equivalent to est1~3
est4 <- estimate(x, "gaussian", domain=domain, elts=NULL, centered=FALSE,
lambda_ratio=0, symmetric="symmetric", lambda1s=lambda1s,
h=h_hp, diag=dm, return_raw=TRUE, verbose=FALSE)
sum(abs(est4$etas)) ## Should be 0 since non-centered with lambda ratio 0 is equivalent to centered
est4$etas <- NULL ## But different from est1 in that the zero etas are returned in est4
compare_two_results(est1, est4) ## Should be almost all 0
## Profiled estimates, no elts or h provided, mode and params provided
est5 <- estimate(x, "gaussian", domain=domain, elts=NULL, centered=FALSE,
lambda_ratio=Inf, symmetric="or", lambda1s=lambda1s, mode="min_pow",
param1=1, param2=3, diag=dm, return_raw=TRUE, verbose=FALSE)
## Profiled estimates, no elts provided, h provided; equivalent to est5
est6 <- estimate(x, "gaussian", domain=domain, elts=NULL, centered=FALSE,
lambda_ratio=Inf, symmetric="or", lambda1s=lambda1s,
h_hp=h_hp, diag=dm, return_raw=TRUE, verbose=FALSE)
compare_two_results(est5, est6) ## Should be almost all 0
elts_gauss_p <- get_elts(h_hp, x, setting="gaussian", domain=domain,
centered=FALSE, profiled=TRUE, diag=dm)
## Profiled estimates, elts provided; equivalent to est5~6
est7 <- estimate(x, "gaussian", domain=domain, elts=elts_gauss_p, centered=FALSE,
lambda_ratio=Inf, symmetric="or", lambda1s=lambda1s,
diagonal_multiplier=NULL, return_raw=TRUE, verbose=FALSE)
compare_two_results(est5, est7) ## Should be almost all 0
## Non-centered estimates, no elts or h provided, mode and params provided
## Using 5-fold cross validation and no BIC refit
est8 <- estimate(x, "gaussian", domain=domain, elts=NULL, centered=FALSE,
lambda_ratio=2, symmetric="and", lambda_length=100,
mode="min_pow", param1=1, param2=3, diag=dm, return_raw=TRUE,
BIC_refit=FALSE, cv_fold=5, cv_fold_seed=2, verbose=FALSE)
## Non-centered estimates, no elts provided, h provided; equivalent to est5
## Using 5-fold cross validation and no BIC refit
est9 <- estimate(x, "gaussian", domain=domain, elts=NULL, centered=FALSE,
lambda_ratio=2, symmetric="and", lambda_length=100, h_hp=h_hp, diag=dm,
return_raw=TRUE, BIC_refit=FALSE, cv_fold=5, cv_fold_seed=2, verbose=FALSE)
compare_two_results(est8, est9) ## Should be almost all 0
elts_gauss_np <- get_elts(h_hp, x, setting="gaussian", domain=domain, centered=FALSE,
profiled=FALSE, diag=dm)
## Non-centered estimates, elts provided; equivalent to est8~9
## Using 5-fold cross validation and no BIC refit
est10 <- estimate(x, "gaussian", domain, elts=elts_gauss_np, centered=FALSE,
lambda_ratio=2, symmetric="and", lambda_length=100, diag=NULL,
return_raw=TRUE, BIC_refit=FALSE, cv_fold=5, cv_fold_seed=2, verbose=FALSE)
compare_two_results(est8, est10) ## Should be almost all 0
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.