R/get_statistic.R

Defines functions get_statistic.lm_robust get_statistic.bfsl get_statistic.coeftest get_statistic.mediate get_statistic.bife get_statistic.metaplus get_statistic.rma get_statistic.orm get_statistic.lrm get_statistic.glimML get_statistic.DirichletRegModel get_statistic.betareg get_statistic.svyglm get_statistic.svyglm.nb get_statistic.epi.2by2 get_statistic.logistf get_statistic.complmrob get_statistic.gee get_statistic.glmx get_statistic.fixest get_statistic.crch get_statistic.LORgee get_statistic.biglm get_statistic.bigglm get_statistic.systemfit get_statistic.rqss get_statistic.crq get_statistic.rqs get_statistic.rq get_statistic.MANOVA get_statistic.maov get_statistic.manova get_statistic.zcpglm get_statistic.cpglm get_statistic.sem get_statistic.cpglmm get_statistic.wbm get_statistic.Arima get_statistic.bayesx get_statistic.averaging get_statistic.hglm get_statistic.robmixglm get_statistic.ggcomparisons get_statistic.emm_list get_statistic.emmGrid get_statistic.glht get_statistic.mle2 get_statistic.mira get_statistic.mipo get_statistic.lqmm get_statistic.margins get_statistic.marginaleffects get_statistic.marginaleffects.summary get_statistic.HLfit get_statistic.ivprobit get_statistic.lmodel2 get_statistic.ridgelm get_statistic.btergm get_statistic.ergm get_statistic.garch get_statistic.Rchoice get_statistic.mjoint get_statistic.Sarlm get_statistic.model_fit get_statistic.lavaan get_statistic.selection get_statistic.pgmm get_statistic.nestedLogit get_statistic.logitor get_statistic.logitmfx get_statistic.betaor get_statistic.betamfx get_statistic.mblogit get_statistic.mclogit get_statistic.mlogit get_statistic.deltaMethod get_statistic.bracl get_statistic.multinom get_statistic.mixor get_statistic.glmm get_statistic.mvord get_statistic.clm2 get_statistic.aareg get_statistic.flexsurvreg get_statistic.BBmm get_statistic.survreg get_statistic.riskRegression get_statistic.coxme get_statistic.coxr get_statistic.svy_vglm get_statistic.coxph get_statistic.cgam get_statistic.vgam get_statistic.vglm get_statistic.gamlss get_statistic.list get_statistic.gamm get_statistic.SemiParBIV get_statistic.gam get_statistic.Gam get_statistic.MixMod get_statistic.zeroinfl get_statistic.glmmTMB get_statistic.mhurdle get_statistic.anova.rms get_statistic.afex_aov get_statistic.merModList get_statistic.mmrm get_statistic.lme get_statistic.mlm get_statistic.summary.lm get_statistic.htest get_statistic.default get_statistic

Documented in get_statistic get_statistic.default get_statistic.emmGrid get_statistic.gee get_statistic.glmmTMB

#' @title Get statistic associated with estimates
#' @description Returns the statistic (*t*, `z`, ...) for model
#'   estimates. In most cases, this is the related column from
#'   `coef(summary())`.
#' @name get_statistic
#'
#' @param x A model.
#' @param column_index For model objects that have no defined
#'   `get_statistic()` method yet, the default method is called. This
#'   method tries to extract the statistic column from `coef(summary())`,
#'   where the index of the column that is being pulled is `column_index`.
#'   Defaults to 3, which is the default statistic column for most models'
#'   summary-output.
#' @param component String, indicating the model component for which parameters
#'   should be returned. The default for all models is `"all"`, which returns
#'   the requested information for all available model components. Furthermore,
#'   there are specific options depending on the model class. `component` then
#'   may be one of:
#'
#'   - For zero-inflated models (`gmmTMB`, `hurdle`, `zeroinfl`, ...) can also
#'     be `"conditional"` or `"zero-inflated"`. Note that the *conditional*
#'     component is also called *count* or *mean* component, depending on the
#'     model. `glmmTMB` also has a `"dispersion"` component.
#'   - For models with smooth terms, `component = "smooth_terms"` returns the
#'     test statistic for the smooth terms.
#'   - For models of class `mhurdle`, may also be one of  `"conditional"`,
#'     `"zero_inflated"`, `"infrequent_purchase"` or `"auxiliary"`.
#'   - For models of class `clm2` or `clmm2`, may also be `"scale"`.
#'   - For models of class `betareg`, `betaor` or `betamfx`, may also be
#'     `"precision"`. For other `*mfx` models (`logitmfx`, `betamfx`, ...),
#'     may also be `"marginal"`.
#'   - For models of class `mvord`, may also be `"thresholds"` or
#'     `"correlation"`.
#'   - For models of class `selection`, may also be `"selection"`, `"outcome"`
#'     or `"auxiliary"`.
#'   - For models of class `glmx`, may also be `"extra"`.
#'   - For models of class `averaging`, may also be `"full"`.
#' @param robust Logical, if `TRUE`, test statistic based on robust
#'   standard errors is returned.
#' @param adjust Character value naming the method used to adjust p-values or
#'   confidence intervals. See `?emmeans::summary.emmGrid` for details.
#' @param ci Confidence Interval (CI) level. Default to `0.95` (`95%`).
#'   Currently only applies to objects of class `emmGrid`.
#' @param ... Currently not used.
#' @inheritParams get_parameters
#' @inheritParams get_parameters.emmGrid
#'
#' @return A data frame with the model's parameter names and the related test
#'   statistic.
#'
#' @examples
#' data(mtcars)
#' m <- lm(mpg ~ wt + cyl + vs, data = mtcars)
#' get_statistic(m)
#' @export
get_statistic <- function(x, ...) {
  UseMethod("get_statistic")
}



# Default models ----------------------------------------------------------


#' @rdname get_statistic
#' @export
get_statistic.default <- function(x, column_index = 3, verbose = TRUE, ...) {
  cs <- suppressWarnings(stats::coef(summary(x)))

  if (column_index > ncol(cs)) {
    if (isTRUE(verbose)) {
      format_warning("Could not access test statistic of model parameters.")
    }
    return(NULL)
  }

  # edge cases: check for NULL
  params <- rownames(cs)
  if (is.null(params)) {
    params <- paste(seq_len(nrow(cs)))
  }

  out <- data.frame(
    Parameter = params,
    Statistic = as.vector(cs[, column_index]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.htest <- function(x, ...) {
  if (x$method == "Fisher's Exact Test for Count Data") {
    out <- data.frame(
      Parameter = x$data.name,
      Statistic = x$p.value,
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  } else {
    out <- data.frame(
      Parameter = x$data.name,
      Statistic = x$statistic,
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  }

  out <- text_remove_backticks(out)
  attr(out, "method") <- x$method[1]
  attr(out, "statistic") <- find_statistic(x)

  out
}


#' @export
get_statistic.summary.lm <- function(x, ...) {
  cs <- stats::coef(x)

  out <- data.frame(
    Parameter = rownames(cs),
    Statistic = as.vector(cs[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.mlm <- function(x, ...) {
  cs <- stats::coef(summary(x))

  out <- lapply(names(cs), function(i) {
    params <- cs[[i]]
    data.frame(
      Parameter = rownames(params),
      Statistic = as.vector(params[, 3]),
      Response = gsub("^Response (.*)", "\\1", i),
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  })

  out <- text_remove_backticks(do.call(rbind, out))
  attr(out, "statistic") <- find_statistic(x)

  out
}


#' @export
get_statistic.lme <- function(x, ...) {
  get_statistic.default(x, column_index = 4)
}

#' @export
get_statistic.lmerModLmerTest <- get_statistic.lme


#' @export
get_statistic.mmrm <- function(x, ...) {
  get_statistic.default(x, column_index = 4)
}

#' @export
get_statistic.mmrm_fit <- get_statistic.mmrm

#' @export
get_statistic.mmrm_tmb <- get_statistic.mmrm


#' @export
get_statistic.merModList <- function(x, ...) {
  s <- suppressWarnings(summary(x))
  out <- data.frame(
    Parameter = s$fe$term,
    Statistic = s$fe$statistic,
    stringsAsFactors = FALSE
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.afex_aov <- function(x, ...) {
  out <- data.frame(
    Parameter = rownames(x$anova_table),
    Statistic = x$anova_table[["F"]],
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.anova.rms <- function(x, ...) {
  out <- data.frame(
    Parameter = rownames(x),
    Statistic = as.vector(x[, "Chi-Square"]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.plm <- get_statistic.default

#' @export
get_statistic.maxLik <- get_statistic.default

#' @export
get_statistic.glmmadmb <- get_statistic.default

#' @export
get_statistic.lm_robust <- get_statistic.default

#' @export
get_statistic.geeglm <- get_statistic.default

#' @export
get_statistic.truncreg <- get_statistic.default

#' @export
get_statistic.tobit <- get_statistic.default

#' @export
get_statistic.censReg <- get_statistic.default

#' @export
get_statistic.negbin <- get_statistic.default

#' @export
get_statistic.feis <- get_statistic.default



# Models with zero-inflation component --------------------------------------


#' @export
get_statistic.mhurdle <- function(x, component = "all", ...) {
  component <- match.arg(
    component,
    choices = c(
      "all", "conditional", "zi", "zero_inflated", "infrequent_purchase",
      "ip", "auxiliary"
    )
  )

  s <- summary(x)
  params <- get_parameters(x, component = "all")

  stats <- data.frame(
    Parameter = rownames(s$coefficients),
    Statistic = as.vector(s$coefficients[, 3]),
    Component = NA,
    stringsAsFactors = FALSE
  )

  cond_pars <- which(startsWith(rownames(s$coefficients), "h2."))
  zi_pars <- which(startsWith(rownames(s$coefficients), "h1."))
  ip_pars <- which(startsWith(rownames(s$coefficients), "h3."))
  aux_pars <- (seq_along(rownames(s$coefficients)))[-c(cond_pars, zi_pars, ip_pars)]

  stats$Component[cond_pars] <- "conditional"
  stats$Component[zi_pars] <- "zero_inflated"
  stats$Component[ip_pars] <- "infrequent_purchase"
  stats$Component[aux_pars] <- "auxiliary"

  params <- merge(params, stats, sort = FALSE)
  params <- .filter_component(params, component)[intersect(c("Parameter", "Statistic", "Component"), colnames(params))]
  params <- text_remove_backticks(params)
  attr(params, "statistic") <- find_statistic(x)

  params
}


#' @rdname get_statistic
#' @export
get_statistic.glmmTMB <- function(x, component = "all", ...) {
  component <- match.arg(
    component,
    choices = c("all", "conditional", "zi", "zero_inflated", "dispersion")
  )

  cs <- compact_list(stats::coef(summary(x)))
  out <- lapply(names(cs), function(i) {
    data.frame(
      Parameter = find_parameters(x, effects = "fixed", component = i, flatten = TRUE),
      Statistic = as.vector(cs[[i]][, 3]),
      Component = i,
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  })

  stat <- do.call(rbind, out)
  stat$Component <- .rename_values(stat$Component, "cond", "conditional")
  stat$Component <- .rename_values(stat$Component, "zi", "zero_inflated")
  stat$Component <- .rename_values(stat$Component, "disp", "dispersion")

  stat <- .filter_component(stat, component)
  stat <- text_remove_backticks(stat)
  attr(stat, "statistic") <- find_statistic(x)

  stat
}


#' @export
get_statistic.zeroinfl <- function(x, component = "all", ...) {
  component <- match.arg(
    component,
    choices = c("all", "conditional", "zi", "zero_inflated")
  )

  cs <- compact_list(stats::coef(summary(x)))
  out <- lapply(names(cs), function(i) {
    comp <- ifelse(i == "count", "conditional", "zi")
    stats <- cs[[i]]

    # remove log(theta)
    theta <- grepl("Log(theta)", rownames(stats), fixed = TRUE)
    if (any(theta)) {
      stats <- stats[!theta, ]
    }

    data.frame(
      Parameter = find_parameters(x,
        effects = "fixed",
        component = comp,
        flatten = TRUE
      ),
      Statistic = as.vector(stats[, 3]),
      Component = comp,
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  })

  stat <- do.call(rbind, out)
  stat$Component <- .rename_values(stat$Component, "cond", "conditional")
  stat$Component <- .rename_values(stat$Component, "zi", "zero_inflated")

  stat <- .filter_component(stat, component)
  stat <- text_remove_backticks(stat)
  attr(stat, "statistic") <- find_statistic(x)

  stat
}

#' @export
get_statistic.hurdle <- get_statistic.zeroinfl

#' @export
get_statistic.zerocount <- get_statistic.zeroinfl


#' @export
get_statistic.MixMod <- function(x, component = "all", ...) {
  component <- match.arg(
    component,
    choices = c("all", "conditional", "zi", "zero_inflated")
  )

  s <- summary(x)
  cs <- list(s$coef_table, s$coef_table_zi)
  names(cs) <- c("conditional", "zero_inflated")
  cs <- compact_list(cs)

  out <- lapply(names(cs), function(i) {
    data.frame(
      Parameter = find_parameters(x,
        effects = "fixed",
        component = i,
        flatten = TRUE
      ),
      Statistic = as.vector(cs[[i]][, 3]),
      Component = i,
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  })

  stat <- .filter_component(do.call(rbind, out), component)
  stat <- text_remove_backticks(stat)
  attr(stat, "statistic") <- find_statistic(x)

  stat
}


# gam models --------------------------------------------------------------


#' @export
get_statistic.Gam <- function(x, ...) {
  p.aov <- stats::na.omit(summary(x)$parametric.anova)

  out <- data.frame(
    Parameter = rownames(p.aov),
    Statistic = as.vector(p.aov[, 4]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.gam <- function(x, ...) {
  p.table <- summary(x)$p.table
  s.table <- summary(x)$s.table

  d1 <- d2 <- NULL

  if (!is.null(p.table)) {
    d1 <- data.frame(
      Parameter = rownames(p.table),
      Statistic = as.vector(p.table[, 3]),
      Component = "conditional",
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  }

  if (!is.null(s.table)) {
    d2 <- data.frame(
      Parameter = rownames(s.table),
      Statistic = as.vector(s.table[, 3]),
      Component = "smooth_terms",
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  }

  out <- text_remove_backticks(rbind(d1, d2))
  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.scam <- get_statistic.gam


#' @export
get_statistic.SemiParBIV <- function(x, ...) {
  s <- summary(x)
  s <- compact_list(s[startsWith(names(s), "tableP")])

  params <- do.call(rbind, lapply(seq_along(s), function(i) {
    out <- as.data.frame(s[[i]])
    out$Parameter <- rownames(out)
    out$Component <- paste0("Equation", i)
    out
  }))

  colnames(params)[3] <- "Statistic"
  rownames(params) <- NULL
  out <- text_remove_backticks(params[c("Parameter", "Statistic", "Component")])

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.gamm <- function(x, ...) {
  x <- x$gam
  class(x) <- c("gam", "lm", "glm")
  get_statistic.gam(x, ...)
}


#' @export
get_statistic.list <- function(x, ...) {
  if ("gam" %in% names(x)) {
    x <- x$gam
    class(x) <- c("gam", "lm", "glm")
    get_statistic.gam(x, ...)
  }
}


#' @export
get_statistic.gamlss <- function(x, ...) {
  parms <- get_parameters(x)
  utils::capture.output({
    cs <- summary(x)
  })

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = as.vector(cs[, 3]),
    Component = parms$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.vglm <- function(x, ...) {
  check_if_installed("VGAM")
  cs <- VGAM::coef(VGAM::summary(x))

  out <- data.frame(
    Parameter = rownames(cs),
    Statistic = as.vector(cs[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.vgam <- function(x, ...) {
  params <- get_parameters(x)
  out <- data.frame(
    Parameter = names(x@nl.chisq),
    Statistic = x@nl.chisq,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- merge(params, out, all.x = TRUE)
  out <- out[order(out$Parameter, params$Parameter), ]

  out <- text_remove_backticks(out[c("Parameter", "Statistic", "Component")])
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.cgam <- function(x, component = "all", ...) {
  component <- match.arg(
    component,
    choices = c("all", "conditional", "smooth_terms")
  )

  sc <- summary(x)
  stat <- as.vector(sc$coefficients[, 3])
  if (!is.null(sc$coefficients2)) stat <- c(stat, rep(NA, nrow(sc$coefficients2)))

  params <- get_parameters(x, component = "all")

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = stat,
    Component = params$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}



# Survival models ------------------------------------------


#' @export
get_statistic.coxph <- function(x, ...) {
  # z is not always in the same column
  # not sure t is possible, but it is cheap to include it in the regex
  # avoid calling default method which would be computationally wasteful, since
  # we need summary() here.
  cs <- suppressWarnings(stats::coef(summary(x)))
  column_index <- grep("^z$|^t$|Chisq", colnames(cs))
  out <- data.frame(
    Parameter = row.names(cs),
    Statistic = cs[, column_index, drop = TRUE],
    stringsAsFactors = FALSE,
    row.names = NULL
  )
  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.svy_vglm <- function(x, verbose = TRUE, ...) {
  cs <- summary(x)$coeftable
  out <- data.frame(
    Parameter = find_parameters(x, flatten = TRUE),
    Statistic = as.vector(cs[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.coxr <- function(x, ...) {
  parms <- get_parameters(x)
  vc <- get_varcov(x)
  se <- sqrt(diag(vc))

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = parms$Estimate / se,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.crr <- get_statistic.coxr


#' @export
get_statistic.coxme <- function(x, ...) {
  beta <- x$coefficients
  out <- NULL

  if (length(beta) > 0) {
    out <- data.frame(
      Parameter = names(beta),
      Statistic = as.vector(beta / sqrt(diag(stats::vcov(x)))),
      stringsAsFactors = FALSE,
      row.names = NULL
    )

    out <- text_remove_backticks(out)
    attr(out, "statistic") <- find_statistic(x)
  }

  out
}


#' @export
get_statistic.riskRegression <- function(x, ...) {
  junk <- utils::capture.output(cs <- stats::coef(x)) # nolint

  out <- data.frame(
    Parameter = as.vector(cs[, 1]),
    Statistic = as.numeric(cs[, "z"]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.survreg <- function(x, ...) {
  parms <- get_parameters(x)
  s <- summary(x)

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = s$table[, 3],
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.BBmm <- function(x, ...) {
  parms <- get_parameters(x)
  s <- summary(x)

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = s$fixed.coefficients[, 3],
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.flexsurvreg <- function(x, ...) {
  parms <- get_parameters(x)
  se <- x$res[, "se"]

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = parms$Estimate / se,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.aareg <- function(x, ...) {
  sc <- summary(x)
  parms <- get_parameters(x)

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = unname(sc$test.statistic),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}



# Ordinal models --------------------------------------------------


#' @export
get_statistic.clm2 <- function(x, component = "all", ...) {
  component <- match.arg(component, choices = c("all", "conditional", "scale"))

  stats <- stats::coef(summary(x))
  n_intercepts <- length(x$xi)
  n_location <- length(x$beta)
  n_scale <- length(x$zeta)

  out <- data.frame(
    Parameter = rownames(stats),
    Statistic = unname(stats[, "z value"]),
    Component = c(rep("conditional", times = n_intercepts + n_location), rep("scale", times = n_scale)),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.clmm2 <- get_statistic.clm2


#' @export
get_statistic.mvord <- function(x, component = "all", ...) {
  component <- match.arg(
    component,
    choices = c("all", "conditional", "thresholds", "correlation")
  )
  junk <- utils::capture.output({
    s <- summary(x)
  })
  # intercepts thresholds
  thresholds <- as.data.frame(s$thresholds)
  thresholds$Parameter <- rownames(thresholds)
  thresholds$Response <- gsub("(.*)\\s(.*)", "\\1", thresholds$Parameter)
  # coefficients
  coefficients <- as.data.frame(s$coefficients)
  coefficients$Parameter <- rownames(coefficients)
  coefficients$Response <- gsub("(.*)\\s(.*)", "\\2", coefficients$Parameter)

  if (!all(coefficients$Response %in% thresholds$Response)) {
    resp <- unique(thresholds$Response)
    for (i in coefficients$Response) {
      coefficients$Response[coefficients$Response == i] <- resp[grepl(paste0(i, "$"), resp)]
    }
  }

  params <- data.frame(
    Parameter = c(thresholds$Parameter, coefficients$Parameter),
    Statistic = c(unname(thresholds[, "z value"]), unname(coefficients[, "z value"])),
    Component = c(rep("thresholds", nrow(thresholds)), rep("conditional", nrow(coefficients))),
    Response = c(thresholds$Response, coefficients$Response),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  params_error <- data.frame(
    Parameter = rownames(s$error.structure),
    Statistic = unname(s$error.structure[, "z value"]),
    Component = "correlation",
    Response = NA,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  params <- rbind(params, params_error)

  if (n_unique(params$Response) == 1) {
    params$Response <- NULL
  }

  if (component != "all") {
    params <- params[params$Component == component, , drop = FALSE]
  }

  attr(params, "statistic") <- find_statistic(x)
  text_remove_backticks(params)
}


#' @export
get_statistic.glmm <- function(x, effects = "all", ...) {
  effects <- match.arg(effects, choices = c("all", "fixed", "random"))
  s <- summary(x)

  out <- get_parameters(x, effects = "all")
  out$Statistic <- c(s$coefmat[, 3], s$nucoefmat[, 3])
  out <- out[, c("Parameter", "Statistic", "Effects")]

  if (effects != "all") {
    out <- out[out$Effects == effects, , drop = FALSE]
    out$Effects <- NULL
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.mixor <- function(x, effects = "all", ...) {
  stats <- x$Model[, "z value"]
  effects <- match.arg(effects, choices = c("all", "fixed", "random"))

  parms <- get_parameters(x, effects = effects)

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = stats[parms$Parameter],
    Effects = parms$Effects,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.multinom <- function(x, ...) {
  parms <- get_parameters(x)
  stderr <- summary(x)$standard.errors

  if (is.matrix(stderr)) {
    se <- NULL
    for (i in seq_len(nrow(stderr))) {
      se <- c(se, as.vector(stderr[i, ]))
    }
  } else {
    se <- as.vector(stderr)
  }

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = parms$Estimate / se,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if ("Response" %in% colnames(parms)) {
    out$Response <- parms$Response
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.brmultinom <- get_statistic.multinom


#' @export
get_statistic.bracl <- function(x, ...) {
  parms <- get_parameters(x)

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = stats::coef(summary(x))[, "z value"],
    Response = parms$Response,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.deltaMethod <- function(x, ...) {
  stat <- standardize_names(x)

  if (is.null(stat$Statistic)) {
    s <- stat$Coefficient / stat$SE
  } else {
    s <- stat[["Statistic"]]
  }

  out <- data.frame(
    Parameter = rownames(stat),
    Statistic = s,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.mlogit <- function(x, ...) {
  if (requireNamespace("mlogit", quietly = TRUE)) {
    cs <- stats::coef(summary(x))

    out <- data.frame(
      Parameter = rownames(cs),
      Statistic = as.vector(cs[, 3]),
      stringsAsFactors = FALSE,
      row.names = NULL
    )

    out <- text_remove_backticks(out)
    attr(out, "statistic") <- find_statistic(x)
    out
  } else {
    NULL
  }
}


#' @export
get_statistic.mclogit <- function(x, ...) {
  if (requireNamespace("mclogit", quietly = TRUE)) {
    cs <- stats::coef(summary(x))

    out <- data.frame(
      Parameter = rownames(cs),
      Statistic = as.vector(cs[, 3]),
      stringsAsFactors = FALSE,
      row.names = NULL
    )

    out <- text_remove_backticks(out)
    attr(out, "statistic") <- find_statistic(x)
    out
  } else {
    NULL
  }
}


#' @export
get_statistic.mblogit <- function(x, ...) {
  if (requireNamespace("mclogit", quietly = TRUE)) {
    cs <- stats::coef(summary(x))

    out <- data.frame(
      Parameter = gsub("(.*)~(.*)", "\\2", rownames(cs)),
      Statistic = as.vector(cs[, 3]),
      Response = gsub("(.*)~(.*)", "\\1", rownames(cs)),
      stringsAsFactors = FALSE,
      row.names = NULL
    )

    out <- text_remove_backticks(out)
    attr(out, "statistic") <- find_statistic(x)
    out
  } else {
    NULL
  }
}



# mfx models -------------------------------------------------------

#' @export
get_statistic.betamfx <- function(x, component = "all", ...) {
  component <- match.arg(
    component,
    choices = c("all", "conditional", "precision", "marginal")
  )
  parms <- get_parameters(x, component = "all", ...)
  cs <- do.call(rbind, stats::coef(summary(x$fit)))
  stat <- c(as.vector(x$mfxest[, 3]), as.vector(cs[, 3]))

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = stat,
    Component = parms$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.betaor <- function(x, component = "all", ...) {
  component <- match.arg(component, choices = c("all", "conditional", "precision"))
  parms <- get_parameters(x, component = "all", ...)
  cs <- do.call(rbind, stats::coef(summary(x$fit)))

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = as.vector(cs[, 3]),
    Component = parms$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.logitmfx <- function(x, component = "all", ...) {
  component <- match.arg(component, choices = c("all", "conditional", "marginal"))
  parms <- get_parameters(x, component = "all", ...)
  cs <- stats::coef(summary(x$fit))
  stat <- c(as.vector(x$mfxest[, 3]), as.vector(cs[, 3]))

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = stat,
    Component = parms$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.poissonmfx <- get_statistic.logitmfx

#' @export
get_statistic.negbinmfx <- get_statistic.logitmfx

#' @export
get_statistic.probitmfx <- get_statistic.logitmfx

#' @export
get_statistic.logitor <- function(x, ...) {
  get_statistic.default(x$fit)
}

#' @export
get_statistic.poissonirr <- get_statistic.logitor

#' @export
get_statistic.negbinirr <- get_statistic.logitor


# Other models -------------------------------------------------------


#' @export
get_statistic.nestedLogit <- function(x, component = "all", verbose = TRUE, ...) {
  cf <- as.data.frame(stats::coef(x))
  out <- as.data.frame(do.call(rbind, lapply(x$models, function(i) stats::coef(summary(i)))))
  colnames(out)[3] <- "Statistic"
  response_levels <- unlist(lapply(x$dichotomies, function(i) {
    paste0("{", toString(i[[1]]), "} vs. {", toString(i[[2]]), "}")
  }))
  out$Response <- rep(response_levels, each = nrow(cf))
  out$Component <- rep(names(x$models), each = nrow(cf))
  out$Parameter <- rep(row.names(cf), times = ncol(cf))

  if (!is.null(component) && !identical(component, "all")) {
    comp <- intersect(names(x$models), component)
    if (!length(comp) && verbose) {
      format_alert(
        paste0(
          "No matching model found. Possible values for `component` are ",
          toString(paste0("\"", names(x$models), "\"")),
          "."
        )
      )
    } else {
      out <- out[out$Component %in% component, ]
    }
  }

  out <- text_remove_backticks(out[c("Parameter", "Statistic", "Response", "Component")])
  row.names(out) <- NULL
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.pgmm <- function(x, component = "conditional", verbose = TRUE, ...) {
  component <- match.arg(component, choices = c("conditional", "all"))
  cs <- stats::coef(summary(x, time.dummies = TRUE, robust = FALSE))

  out <- data.frame(
    Parameter = row.names(cs),
    Statistic = as.vector(cs[, 3]),
    Component = "conditional",
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out$Component[out$Parameter %in% x$args$namest] <- "time_dummies"

  if (component == "conditional") {
    out <- out[out$Component == "conditional", ]
    out <- .remove_column(out, "Component")
  }

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.selection <- function(x, component = "all", ...) {
  component <- match.arg(
    component,
    choices = c("all", "selection", "outcome", "auxiliary")
  )
  s <- summary(x)
  rn <- row.names(s$estimate)
  estimates <- as.data.frame(s$estimate, row.names = FALSE)
  params <- data.frame(
    Parameter = rn,
    Statistic = estimates[[3]],
    Component = "auxiliary",
    stringsAsFactors = FALSE,
    row.names = NULL
  )
  params$Component[s$param$index$betaS] <- "selection"
  params$Component[s$param$index$betaO] <- "outcome"

  if (component != "all") {
    params <- params[params$Component == component, , drop = FALSE]
  }

  params <- text_remove_backticks(params)
  attr(params, "statistic") <- find_statistic(x)
  params
}


#' @export
get_statistic.lavaan <- function(x, ...) {
  # installed?
  check_if_installed("lavaan")

  params <- lavaan::parameterEstimates(x)

  params$parameter <- paste0(params$lhs, params$op, params$rhs)
  params$comp <- NA

  params$comp[params$op == "~"] <- "regression"
  params$comp[params$op == "=~"] <- "latent"
  params$comp[params$op == "~~"] <- "residual"
  params$comp[params$op == "~1"] <- "intercept"

  params <- data.frame(
    Parameter = params$parameter,
    Statistic = params$z,
    Component = params$comp,
    stringsAsFactors = FALSE
  )

  params <- text_remove_backticks(params)
  attr(params, "statistic") <- find_statistic(x)
  params
}


#' @export
get_statistic.model_fit <- function(x, ...) {
  get_statistic(x$fit, ...)
}


#' @export
get_statistic.Sarlm <- function(x, ...) {
  s <- summary(x)
  # add rho, if present
  if (is.null(s$rho)) {
    rho <- NULL
  } else {
    rho <- as.numeric(s$rho) / as.numeric(s$rho.se)
  }
  stat <- data.frame(
    Parameter = find_parameters(x, flatten = TRUE),
    Statistic = c(rho, as.vector(s$Coef[, 3])),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  stat <- text_remove_backticks(stat)
  attr(stat, "statistic") <- find_statistic(x)

  stat
}


#' @export
get_statistic.mjoint <- function(x, component = "all", ...) {
  component <- match.arg(component, choices = c("all", "conditional", "survival"))
  s <- summary(x)

  params <- rbind(
    data.frame(
      Parameter = rownames(s$coefs.long),
      Statistic = unname(s$coefs.long[, 3]),
      Component = "conditional",
      stringsAsFactors = FALSE,
      row.names = NULL
    ),
    data.frame(
      Parameter = rownames(s$coefs.surv),
      Statistic = unname(s$coefs.surv[, 3]),
      Component = "survival",
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  )

  if (component != "all") {
    params <- params[params$Component == component, , drop = FALSE]
  }

  attr(params, "statistic") <- find_statistic(x)
  params
}


#' @export
get_statistic.Rchoice <- function(x, verbose = TRUE, ...) {
  cs <- summary(x)$CoefTable
  out <- data.frame(
    Parameter = find_parameters(x, flatten = TRUE),
    Statistic = as.vector(cs[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.garch <- function(x, verbose = TRUE, ...) {
  cs <- summary(x)$coef
  out <- data.frame(
    Parameter = find_parameters(x, flatten = TRUE),
    Statistic = as.vector(cs[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.ergm <- function(x, verbose = TRUE, ...) {
  get_statistic.default(x = x, column_index = 4, verbose = verbose, ...)
}


#' @export
get_statistic.btergm <- function(x, verbose = TRUE, ...) {
  params <- x@coef
  bootstraps <- x@boot$t

  # standard error
  sdev <- vapply(seq_len(ncol(bootstraps)), function(i) {
    cur <- (bootstraps[, i] - params[i])^2
    sqrt(sum(cur) / length(cur))
  }, numeric(1))
  stat <- (0 - colMeans(bootstraps)) / sdev

  out <- data.frame(
    Parameter = names(stat),
    Statistic = stat,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.ridgelm <- function(x, ...) {
  NULL
}


#' @export
get_statistic.lmodel2 <- function(x, ...) {
  NULL
}


#' @export
get_statistic.ivFixed <- get_statistic.coxr


#' @export
get_statistic.ivprobit <- function(x, ...) {
  out <- data.frame(
    Parameter = x$names,
    Statistic = as.vector(x$tval),
    stringsAsFactors = FALSE
  )
  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.HLfit <- function(x, ...) {
  utils::capture.output(s <- summary(x)) # nolint

  out <- data.frame(
    Parameter = rownames(s$beta_table),
    Statistic = as.vector(s$beta_table[, "t-value"]),
    stringsAsFactors = FALSE
  )
  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.marginaleffects.summary <- function(x, ...) {
  out <- data.frame(
    Parameter = x$term,
    Statistic = x$statistic,
    stringsAsFactors = FALSE
  )
  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.marginaleffects <- function(x, ...) {
  get_statistic(summary(x))
}


#' @export
get_statistic.margins <- function(x, ...) {
  out <- data.frame(
    Parameter = get_parameters(x)$Parameter,
    Statistic = as.vector(summary(x)$z),
    stringsAsFactors = FALSE
  )
  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.lqmm <- function(x, ...) {
  cs <- summary(x, ...)
  params <- get_parameters(x)

  if (is.list(cs$tTable)) {
    stats <- do.call(rbind, cs$tTable)
    params$Statistic <- params$Estimate / stats[, 2]
    params <- params[c("Parameter", "Statistic", "Component")]
  } else {
    params$Statistic <- params$Estimate / cs$tTable[, 2]
    params <- params[c("Parameter", "Statistic")]
  }

  out <- text_remove_backticks(params)
  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.lqm <- get_statistic.lqmm


#' @export
get_statistic.mipo <- function(x, ...) {
  s <- summary(x)
  params <- data.frame(
    Parameter = as.vector(s$term),
    Statistic = as.vector(s$statistic),
    stringsAsFactors = FALSE
  )
  # check for ordinal-alike models
  if ("y.level" %in% colnames(s)) {
    params$Response <- as.vector(s$y.level)
  }
  out <- text_remove_backticks(params)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.mira <- function(x, ...) {
  get_statistic(x$analyses[[1]], ...)
}


#' @export
get_statistic.mle2 <- function(x, ...) {
  check_if_installed("bbmle", reason = "to extract test statistic")
  s <- bbmle::summary(x)

  params <- data.frame(
    Parameter = names(s@coef[, 3]),
    Statistic = unname(s@coef[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(params)
  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.mle <- get_statistic.mle2


#' @export
get_statistic.glht <- function(x, ...) {
  s <- summary(x)
  alt <- switch(x$alternative,
    two.sided = "==",
    less = ">=",
    greater = "<="
  )
  out <- data.frame(
    Parameter = paste(names(s$test$coefficients), alt, x$rhs),
    Statistic = unname(s$test$tstat),
    stringsAsFactors = FALSE
  )
  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @rdname get_statistic
#' @export
get_statistic.emmGrid <- function(x, ci = 0.95, adjust = "none", merge_parameters = FALSE, ...) {
  s <- summary(x, level = ci, adjust = adjust, infer = TRUE)

  stat <- s[["t.ratio"]]

  # 2nd try
  if (is_empty_object(stat)) {
    stat <- s[["z.ratio"]]
  }

  # quit
  if (is_empty_object(stat)) {
    return(NULL)
  }

  estimate_pos <- which(colnames(s) == attr(s, "estName"))
  if (isTRUE(merge_parameters)) {
    params <- get_parameters(x, merge_parameters = TRUE)["Parameter"]
  } else {
    params <- s[, seq_len(estimate_pos - 1), drop = FALSE]
  }

  out <- data.frame(
    params,
    Statistic = as.vector(stat),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.emm_list <- function(x, ci = 0.95, adjust = "none", ...) {
  params <- get_parameters(x)
  s <- summary(x, level = ci, adjust = adjust, infer = TRUE)

  stat <- lapply(s, "[[", "t.ratio")

  # 2nd try
  if (is_empty_object(stat)) {
    stat <- lapply(s, "[[", "z.ratio")
  }

  # quit
  if (is_empty_object(stat)) {
    return(NULL)
  }

  stat <- unlist(stat, use.names = FALSE)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = stat,
    Component = params$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.ggcomparisons <- function(x, merge_parameters = FALSE, ...) {
  estimate_pos <- which(colnames(x) == attr(x, "estimate_name"))
  if (isTRUE(merge_parameters)) {
    params <- get_parameters(x, merge_parameters = TRUE)["Parameter"]
  } else {
    params <- x[, seq_len(estimate_pos - 1), drop = FALSE]
  }

  stat <- .safe(x[[estimate_pos]] / attributes(x)$standard_error)
  if (is.null(stat)) {
    return(NULL)
  }

  out <- data.frame(
    params,
    Statistic = as.vector(stat),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.robmixglm <- function(x, ...) {
  cs <- stats::coef(summary(x))

  out <- data.frame(
    Parameter = rownames(cs),
    Statistic = as.vector(cs[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- out[!is.na(out$Statistic), ]
  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.hglm <- function(x, ...) {
  s <- summary(x)$FixCoefMat

  out <- data.frame(
    Parameter = rownames(s),
    Statistic = as.vector(s[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- out[!is.na(out$Statistic), ]
  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.averaging <- function(x, component = "conditional", ...) {
  component <- match.arg(component, choices = c("conditional", "full"))
  params <- get_parameters(x, component = component)
  if (component == "full") {
    s <- summary(x)$coefmat.full
  } else {
    s <- summary(x)$coefmat.subset
  }

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = s[, 4],
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.bayesx <- function(x, ...) {
  out <- data.frame(
    Parameter = find_parameters(x, component = "conditional", flatten = TRUE),
    Statistic = x$fixed.effects[, 3],
    stringsAsFactors = FALSE
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.Arima <- function(x, ...) {
  params <- get_parameters(x)
  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = as.vector(params$Estimate / sqrt(diag(get_varcov(x)))),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.wbm <- function(x, ...) {
  s <- summary(x)

  statistic_column <- if ("t val." %in% c(
    colnames(s$within_table),
    colnames(s$between_table),
    colnames(s$ints_table)
  )) {
    "t val."
  } else {
    "z val."
  }

  stat <- c(
    s$within_table[, statistic_column],
    s$between_table[, statistic_column],
    s$ints_table[, statistic_column]
  )

  params <- get_parameters(x)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = as.vector(stat),
    Component = params$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.wbgee <- get_statistic.wbm



#' @export
get_statistic.cpglmm <- function(x, ...) {
  # installed?
  check_if_installed("cplm")

  stats <- cplm::summary(x)$coefs
  params <- get_parameters(x)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = as.vector(stats[, "t value"]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.sem <- function(x, ...) {
  if (!.is_semLme(x)) {
    return(NULL)
  }

  params <- get_parameters(x, effects = "fixed")

  if (is.null(x$se)) {
    format_warning("Model has no standard errors. Please fit model again with bootstrapped standard errors.")
    return(NULL)
  }

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = as.vector(x$coef / x$se),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.cpglm <- function(x, ...) {
  # installed?
  check_if_installed("cplm")

  junk <- utils::capture.output(stats <- cplm::summary(x)$coefficients) # nolint
  params <- get_parameters(x)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = as.vector(stats[, "t value"]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.zcpglm <- function(x, component = "all", ...) {
  # installed?
  check_if_installed("cplm")

  component <- match.arg(component, choices = c("all", "conditional", "zi", "zero_inflated"))
  junk <- utils::capture.output(stats <- cplm::summary(x)$coefficients) # nolint
  params <- get_parameters(x)

  tweedie <- data.frame(
    Parameter = params$Parameter[params$Component == "conditional"],
    Statistic = as.vector(stats$tweedie[, "z value"]),
    Component = "conditional",
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  zero <- data.frame(
    Parameter = params$Parameter[params$Component == "zero_inflated"],
    Statistic = as.vector(stats$zero[, "z value"]),
    Component = "zero_inflated",
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- .filter_component(rbind(tweedie, zero), component)
  out <- text_remove_backticks(out)

  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.manova <- function(x, ...) {
  stats <- as.data.frame(summary(x)$stats)

  out <- data.frame(
    Parameter = rownames(stats),
    Statistic = as.vector(stats[["approx F"]]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.maov <- function(x, ...) {
  s <- summary(x)
  out <- do.call(rbind, lapply(names(s), function(i) {
    stats <- s[[i]]
    missing <- is.na(stats[["F value"]])
    data.frame(
      Parameter = rownames(stats)[!missing],
      Statistic = as.vector(stats[["F value"]][!missing]),
      Response = gsub("\\s*Response ", "", i),
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  }))

  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.MANOVA <- function(x, ...) {
  stats <- as.data.frame(x$WTS)

  out <- data.frame(
    Parameter = rownames(stats),
    Statistic = as.vector(stats[[1]]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.RM <- get_statistic.MANOVA



#' @export
get_statistic.rq <- function(x, ...) {
  stat <- tryCatch(
    {
      cs <- stats::coef(summary(x))
      cs[, "t value"]
    },
    error = function(e) {
      cs <- stats::coef(summary(x, covariance = TRUE))
      cs[, "t value"]
    }
  )

  params <- get_parameters(x)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = stat,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.rqs <- function(x, ...) {
  stat <- .safe({
    s <- suppressWarnings(summary(x, covariance = TRUE))
    cs <- do.call(rbind, lapply(s, stats::coef))
    cs[, "t value"]
  })

  params <- get_parameters(x)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = stat,
    Component = params$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.crq <- function(x, ...) {
  sc <- summary(x)
  params <- get_parameters(x)

  if (all(unlist(lapply(sc, is.list)))) {
    list_sc <- lapply(sc, function(i) {
      .x <- as.data.frame(i)
      .x$Parameter <- rownames(.x)
      .x
    })
    out <- do.call(rbind, list_sc)
    out <- data.frame(
      Parameter = params$Parameter,
      Statistic = out$coefficients.T.Value,
      Component = params$Component,
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  } else {
    out <- data.frame(
      Parameter = params$Parameter,
      Statistic = unname(sc$coefficients[, 5]),
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.crqs <- get_statistic.crq

#' @export
get_statistic.nlrq <- get_statistic.rq



#' @export
get_statistic.rqss <- function(x,
                               component = c("all", "conditional", "smooth_terms"),
                               ...) {
  component <- match.arg(component)

  cs <- summary(x)
  stat <- c(as.vector(cs$coef[, "t value"]), as.vector(cs$qsstab[, "F value"]))

  params <- get_parameters(x)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = unname(stat),
    Component = params$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.systemfit <- function(x, ...) {
  cf <- stats::coef(summary(x))
  f <- find_formula(x)

  system_names <- names(f)
  parameter_names <- row.names(cf)

  out <- lapply(system_names, function(i) {
    pattern <- paste0("^", i, "_(.*)")
    params <- grepl(pattern, parameter_names)
    data.frame(
      Parameter = gsub(pattern, "\\1", parameter_names[params]),
      Statistic = as.vector(cf[params, 3]),
      Component = i,
      stringsAsFactors = FALSE
    )
  })

  out <- do.call(rbind, out)

  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.bigglm <- function(x, ...) {
  parms <- get_parameters(x)
  cs <- summary(x)$mat
  se <- as.vector(cs[, 4])

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = parms$Estimate / se,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}



#' @export
get_statistic.biglm <- function(x, ...) {
  parms <- get_parameters(x)
  cs <- summary(x)$mat
  se <- as.vector(cs[, 4])

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = parms$Estimate / se,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.LORgee <- function(x, ...) {
  out <- get_statistic.default(x)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.crch <- function(x, ...) {
  cs <- do.call(rbind, stats::coef(summary(x), model = "full"))
  params <- get_parameters(x)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = as.vector(cs[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.fixest <- function(x, ...) {
  cs <- summary(x)$coeftable
  params <- get_parameters(x)

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = as.vector(cs[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.glmx <- function(x, component = "all", ...) {
  component <- match.arg(component, choices = c("all", "conditional", "extra"))
  cf <- stats::coef(summary(x))
  parms <- get_parameters(x)

  out <- rbind(
    data.frame(
      Parameter = parms$Parameter[parms$Component == "conditional"],
      Statistic = unname(cf$glm[, 3]),
      Component = "conditional",
      stringsAsFactors = FALSE,
      row.names = NULL
    ),
    data.frame(
      Parameter = parms$Parameter[parms$Component == "extra"],
      Statistic = cf$extra[, 3],
      Component = "extra",
      stringsAsFactors = FALSE,
      row.names = NULL
    )
  )

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @rdname get_statistic
#' @export
get_statistic.gee <- function(x, robust = FALSE, ...) {
  parms <- get_parameters(x)
  cs <- stats::coef(summary(x))

  if (isTRUE(robust)) {
    stats <- as.vector(cs[, "Robust z"])
  } else {
    stats <- as.vector(cs[, "Naive z"])
  }

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = stats,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.complmrob <- function(x, ...) {
  parms <- get_parameters(x)
  stat <- summary(x)$stats

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = as.vector(stat[, "t value"]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.logistf <- function(x, ...) {
  parms <- get_parameters(x)
  utils::capture.output(s <- summary(x)) # nolint

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = as.vector(stats::qchisq(1 - s$prob, df = 1)),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.flac <- get_statistic.logistf

#' @export
get_statistic.flic <- get_statistic.logistf


#' @export
get_statistic.epi.2by2 <- function(x, ...) {
  stat <- x$massoc.detail$chi2.strata.uncor
  out <- data.frame(
    Parameter = "Chi2",
    Statistic = stat$test.statistic,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.svyglm.nb <- function(x, ...) {
  if (!isNamespaceLoaded("survey")) {
    requireNamespace("survey", quietly = TRUE)
  }

  parms <- get_parameters(x)
  se <- sqrt(diag(stats::vcov(x, stderr = "robust")))

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = parms$Estimate / se,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.svyglm.zip <- get_statistic.svyglm.nb


#' @export
get_statistic.svyglm <- function(x, ...) {
  parms <- get_parameters(x)
  vc <- get_varcov(x)
  se <- sqrt(diag(vc))

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = parms$Estimate / se,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.svyolr <- get_statistic.svyglm


#' @export
get_statistic.betareg <- function(x, component = "all", ...) {
  component <- match.arg(component, choices = c("all", "conditional", "precision"))
  parms <- get_parameters(x)
  cs <- do.call(rbind, stats::coef(summary(x)))
  se <- as.vector(cs[, 2])

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = parms$Estimate / se,
    Component = parms$Component,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.DirichletRegModel <- function(x, component = "all", ...) {
  component <- match.arg(component, choices = c("all", "conditional", "precision"))
  parms <- get_parameters(x)
  junk <- utils::capture.output(cs <- summary(x)$coef.mat) # nolint

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = unname(cs[, "z value"]),
    Response = parms$Response,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  if (is.null(parms$Component)) {
    component <- "all"
  } else {
    out$Component <- parms$Component
  }

  if (component != "all") {
    out <- out[out$Component == component, , drop = FALSE]
  }

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.glimML <- function(x, ...) {
  # installed?
  check_if_installed("aod")

  parms <- get_parameters(x)
  s <- methods::slot(aod::summary(x), "Coef")

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = s[, 3],
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.lrm <- function(x, ...) {
  parms <- get_parameters(x)
  stat <- stats::coef(x) / sqrt(diag(stats::vcov(x)))

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = as.vector(stat),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}

#' @export
get_statistic.ols <- get_statistic.lrm

#' @export
get_statistic.rms <- get_statistic.lrm

#' @export
get_statistic.psm <- get_statistic.lrm

#' @export
get_statistic.orm <- function(x, ...) {
  parms <- get_parameters(x)
  vc <- stats::vcov(x)
  parms <- parms[parms$Parameter %in% dimnames(vc)[[1]], ]
  stat <- parms$Estimate / sqrt(diag(vc))

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = as.vector(stat),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.rma <- function(x, ...) {
  parms <- get_parameters(x)
  stat <- x$zval

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = as.vector(stat),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.metaplus <- function(x, ...) {
  params <- get_parameters(x)

  ci_low <- as.vector(x$results[, "95% ci.lb"])
  ci_high <- as.vector(x$results[, "95% ci.ub"])
  cis <- apply(cbind(ci_low, ci_high), MARGIN = 1, diff)
  se <- cis / (2 * stats::qnorm(0.975))

  out <- data.frame(
    Parameter = params$Parameter,
    Statistic = as.vector(params$Estimate / se),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.bife <- function(x, ...) {
  parms <- get_parameters(x)
  cs <- summary(x)

  out <- data.frame(
    Parameter = parms$Parameter,
    Statistic = as.vector(cs$cm[, 3]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.mediate <- function(x, ...) {
  NULL
}


#' @export
get_statistic.coeftest <- function(x, ...) {
  out <- data.frame(
    Parameter = row.names(x),
    Statistic = x[, 3],
    stringsAsFactors = FALSE,
    row.names = NULL
  )
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.bfsl <- function(x, ...) {
  cs <- stats::coef(x)

  out <- data.frame(
    Parameter = rownames(cs),
    Statistic = as.vector(cs[, "Estimate"] / cs[, "Std. Error"]),
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  out <- text_remove_backticks(out)
  attr(out, "statistic") <- find_statistic(x)
  out
}


#' @export
get_statistic.lm_robust <- function(x, ...) {
  if (is_multivariate(x)) {
    get_statistic.mlm(x, ...)
  } else {
    get_statistic.default(x, ...)
  }
}

Try the insight package in your browser

Any scripts or data that you put into this service are public.

insight documentation built on Nov. 26, 2023, 5:08 p.m.