|
1
|
|
#' Generalised Information Criterion
|
|
2
|
|
#'
|
|
3
|
|
#' @description Calculates the generalised information criterion for each value
|
|
4
|
|
#' of the tuning parameter lambda
|
|
5
|
|
#'
|
|
6
|
|
#' @seealso \code{\link{ggmix}}
|
|
7
|
|
#' @param ggmix_fit An object of class \code{ggmix_fit} which is outputted by
|
|
8
|
|
#' the \code{\link{ggmix}} function
|
|
9
|
|
#' @param ... other parameters. currently ignored.
|
|
10
|
|
#' @details the generalised information criterion used for gaussian response is
|
|
11
|
|
#' given by \deqn{-2 * loglikelihood(\hat{\Theta}) + an * df} where df is the
|
|
12
|
|
#' number of non-zero estimated parameters, including variance components
|
|
13
|
|
#' @references Fan Y, Tang CY. Tuning parameter selection in high dimensional
|
|
14
|
|
#' penalized likelihood. Journal of the Royal Statistical Society: Series B
|
|
15
|
|
#' (Statistical Methodology). 2013 Jun 1;75(3):531-52.
|
|
16
|
|
#'
|
|
17
|
|
#' Nishii R. Asymptotic properties of criteria for selection of variables in
|
|
18
|
|
#' multiple regression. The Annals of Statistics. 1984;12(2):758-65.
|
|
19
|
|
#' @return an object with S3 class \code{"ggmix_gic"}, \code{"ggmix_fit"},
|
|
20
|
|
#' \code{"*"} and \code{"**"} where \code{"*"} is "lasso" or "gglasso" and
|
|
21
|
|
#' \code{"**"} is fullrank or lowrank. Results are provided for converged
|
|
22
|
|
#' values of lambda only. \describe{\item{ggmix_fit}{the ggmix_fit
|
|
23
|
|
#' object}\item{lambda}{the sequence of converged tuning parameters}
|
|
24
|
|
#' \item{nzero}{the number of non-zero estimated coefficients including the 2
|
|
25
|
|
#' variance parameters which are not penalized and therefore always
|
|
26
|
|
#' included}\item{gic}{gic value. a numeric vector with length equal to
|
|
27
|
|
#' \code{length(lambda)}} \item{lambda.min.name}{a character corresponding to
|
|
28
|
|
#' the name of the tuning parameter lambda which minimizes the
|
|
29
|
|
#' gic}\item{lambda.min}{the value of lambda which minimizes the gic}}
|
|
30
|
|
#' @export
|
|
31
|
4
|
gic <- function(ggmix_fit, ...) UseMethod("gic")
|
|
32
|
|
|
|
33
|
|
#' @rdname gic
|
|
34
|
|
#' @export
|
|
35
|
|
gic.default <- function(ggmix_fit, ...) {
|
|
36
|
0
|
stop(strwrap("This function should be used with an object of class
|
|
37
|
0
|
ggmix_fit"))
|
|
38
|
|
}
|
|
39
|
|
|
|
40
|
|
|
|
41
|
|
#' @param an numeric, the penalty per parameter to be used; the default is an =
|
|
42
|
|
#' log(log(n))*log(p) where n is the number of subjects and p is the number of
|
|
43
|
|
#' parameters
|
|
44
|
|
#' @rdname gic
|
|
45
|
|
#' @export
|
|
46
|
|
gic.ggmix_fit <- function(ggmix_fit,
|
|
47
|
|
...,
|
|
48
|
|
an = log(log(n)) * log(p)) {
|
|
49
|
4
|
n <- ggmix_fit[["n_design"]]
|
|
50
|
4
|
p <- ggmix_fit[["p_design"]]
|
|
51
|
4
|
df <- ggmix_fit$result[, "Df"]
|
|
52
|
4
|
model_loglik <- ggmix_fit$result[, "loglik"]
|
|
53
|
|
|
|
54
|
4
|
model_gic <- -2 * model_loglik + an * df
|
|
55
|
|
|
|
56
|
4
|
out <- list(
|
|
57
|
4
|
ggmix_fit = ggmix_fit, # used in predict.ggmix_gic function
|
|
58
|
4
|
lambda = ggmix_fit[["lambda"]],
|
|
59
|
4
|
nzero = df,
|
|
60
|
4
|
gic = model_gic,
|
|
61
|
4
|
lambda.min.name = names(which.min(model_gic)),
|
|
62
|
4
|
lambda.min = ggmix_fit$result[names(which.min(model_gic)), "Lambda"]
|
|
63
|
|
)
|
|
64
|
4
|
obj <- c(out)
|
|
65
|
4
|
class(obj) <- c("ggmix_gic", attr(ggmix_fit, "class"))
|
|
66
|
4
|
return(obj)
|
|
67
|
|
}
|
sahirbhatnagar