# 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
Run the code above in your browser using DataLab