/
glances.R
82 lines (78 loc) · 3.05 KB
/
glances.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
#' Glance at many fitted model objects
#'
#' @description \code{glances()} repeatedly calls \code{glance()} on several
#' fitted model objects and binds the output together, sorted by a column of interest.
#'
#' @param object A fitted model object from [splm()], [spautor()], [spglm()], or [spgautor()].
#' @param ... Additional fitted model objects. Ignored
#' if \code{object} has class \code{splm_list}, \code{spautor_list}, \code{spglm_list}, or \code{spgautor_list}.
#' @param sort_by Sort by a \code{glance} statistic (i.e., the name of a column
#' output from \code{glance()} or the order of model input (\code{sort_by = "order"}).
#' The default is \code{"AICc"}.
#' @param decreasing Should \code{sort_by} be decreasing or not? The default is \code{FALSE}.
#'
#' @return A tibble where each row represents the output of \code{glance()} for
#' each fitted model object.
#'
#' @order 1
#' @export
#'
#' @examples
#' lmod <- splm(z ~ water + tarp,
#' data = caribou,
#' spcov_type = "none"
#' )
#' spmod <- splm(z ~ water + tarp,
#' data = caribou,
#' spcov_type = "exponential", xcoord = x, ycoord = y
#' )
#' glances(lmod, spmod)
#' glances(lmod, spmod, sort_by = "logLik", decreasing = TRUE)
glances <- function(object, ..., sort_by = "AICc", decreasing = FALSE) {
UseMethod("glances", object)
}
#' @rdname glances
#' @method glances splm
#' @order 2
#' @export
glances.splm <- function(object, ..., sort_by = "AICc", decreasing = FALSE) {
model_list <- c(list(object), list(...))
if (any(!(vapply(model_list, function(x) class(x), character(1)) %in% c("splm", "spautor")))) {
stop("All models must be of class splm or spautor", call. = FALSE)
}
model_list_names <- c(as.character(as.list(substitute(list(object)))[-1]), as.character(as.list(substitute(list(...)))[-1]))
model_glance <- lapply(model_list, function(x) glance(x))
model_bind <- do.call(rbind, model_glance)
model_bind <- cbind(data.frame(model = model_list_names), model_bind)
if (sort_by == "order") {
model_bind <- model_bind[order(seq_len(NROW(model_bind)), decreasing = decreasing), , drop = FALSE]
} else {
model_bind <- model_bind[order(model_bind[[substitute(sort_by)]], decreasing = decreasing), , drop = FALSE]
}
tibble::as_tibble(model_bind)
}
#' @rdname glances
#' @method glances spautor
#' @order 3
#' @export
glances.spautor <- glances.splm
#' @rdname glances
#' @method glances splm_list
#' @order 4
#' @export
glances.splm_list <- function(object, ..., sort_by = "AICc", decreasing = FALSE) {
model_glance <- lapply(object, function(x) glance(x))
model_bind <- do.call(rbind, model_glance)
model_bind <- cbind(data.frame(model = names(model_glance), model_bind))
if (sort_by == "order") {
model_bind <- model_bind[order(seq_len(NROW(model_bind)), decreasing = decreasing), , drop = FALSE]
} else {
model_bind <- model_bind[order(model_bind[[substitute(sort_by)]], decreasing = decreasing), , drop = FALSE]
}
tibble::as_tibble(model_bind)
}
#' @rdname glances
#' @method glances spautor_list
#' @order 5
#' @export
glances.spautor_list <- glances.splm_list