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 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
|
# classes: .mlm
#################### .mlm
#' Parameters from multinomial or cumulative link models
#'
#' Parameters from multinomial or cumulative link models
#'
#' @param model A model with multinomial or categorical response value.
#' @inheritParams model_parameters.default
#' @inheritParams simulate_model
#'
#' @details Multinomial or cumulative link models, i.e. models where the
#' response value (dependent variable) is categorical and has more than two
#' levels, usually return coefficients for each response level. Hence, the
#' output from \code{model_parameters()} will split the coefficient tables
#' by the different levels of the model's response.
#'
#' @seealso \code{\link[insight:standardize_names]{standardize_names()}} to rename
#' columns into a consistent, standardized naming scheme.
#'
#' @examples
#' library(parameters)
#' if (require("brglm2")) {
#' data("stemcell")
#' model <- bracl(
#' research ~ as.numeric(religion) + gender,
#' weights = frequency,
#' data = stemcell,
#' type = "ML"
#' )
#' model_parameters(model)
#' }
#' @return A data frame of indices related to the model's parameters.
#' @inheritParams simulate_model
#' @importFrom insight get_response
#' @export
model_parameters.mlm <- function(model,
ci = .95,
bootstrap = FALSE,
iterations = 1000,
standardize = NULL,
exponentiate = FALSE,
p_adjust = NULL,
verbose = TRUE,
...) {
out <- .model_parameters_generic(
model = model,
ci = ci,
bootstrap = bootstrap,
iterations = iterations,
merge_by = c("Parameter", "Response"),
standardize = standardize,
exponentiate = exponentiate,
robust = FALSE,
p_adjust = p_adjust,
...
)
attr(out, "object_name") <- deparse(substitute(model), width.cutoff = 500)
out
}
#' @export
standard_error.mlm <- function(model, ...) {
cs <- stats::coef(summary(model))
se <- lapply(names(cs), function(x) {
params <- cs[[x]]
.data_frame(
Parameter = rownames(params),
SE = params[, "Std. Error"],
Response = gsub("^Response (.*)", "\\1", x)
)
})
.remove_backticks_from_parameter_names(do.call(rbind, se))
}
#' @export
p_value.mlm <- function(model, ...) {
cs <- stats::coef(summary(model))
p <- lapply(names(cs), function(x) {
params <- cs[[x]]
.data_frame(
Parameter = rownames(params),
p = params[, "Pr(>|t|)"],
Response = gsub("^Response (.*)", "\\1", x)
)
})
.remove_backticks_from_parameter_names(do.call(rbind, p))
}
#' @export
ci.mlm <- function(x, ci = .95, ...) {
if (is.null(insight::find_weights(x))) {
out <- lapply(ci, function(i) {
.ci <- stats::confint(x, level = i, ...)
rn <- rownames(.ci)
.data_frame(
Parameter = gsub("^(.*):(.*)", "\\2", rn),
CI = i,
CI_low = .ci[, 1],
CI_high = .ci[, 2],
Response = gsub("^(.*):(.*)", "\\1", rn)
)
})
out <- .remove_backticks_from_parameter_names(do.call(rbind, out))
} else {
out <- .data_frame(ci_wald(x, ci = ci, ...), Response = insight::get_parameters(x)$Response)
}
out
}
#' @importFrom insight find_response
#' @export
simulate_model.mlm <- function(model, iterations = 1000, ...) {
responses <- insight::find_response(model, combine = FALSE)
out <- .simulate_model(model, iterations, component = "conditional", effects = "fixed")
cn <- paste0(colnames(out), rep(responses, each = length(colnames(out)) / length(responses)))
colnames(out) <- cn
class(out) <- c("parameters_simulate_model", class(out))
attr(out, "object_name") <- .safe_deparse(substitute(model))
out
}
#' @export
simulate_parameters.mlm <- function(model,
iterations = 1000,
centrality = "median",
ci = .95,
ci_method = "quantile",
test = "p-value",
...) {
data <- simulate_model(model, iterations = iterations, ...)
out <-
.summary_bootstrap(
data = data,
test = test,
centrality = centrality,
ci = ci,
ci_method = ci_method,
...
)
out$Response <- NA
responses <- insight::find_response(model, combine = FALSE)
for (i in responses) {
out$Response[grepl(paste0(i, "$"), out$Parameter)] <- i
out$Parameter <- gsub(paste0(i, "$"), "", out$Parameter)
}
class(out) <- c("parameters_simulate", "see_parameters_simulate", class(out))
attr(out, "object_name") <- deparse(substitute(model), width.cutoff = 500)
attr(out, "object_class") <- class(model)
attr(out, "iterations") <- iterations
attr(out, "ci") <- ci
out
}
|