#' Tidying methods for ordinal logistic regression models
#'
#' These methods tidy the coefficients of ordinal logistic regression
#' models generated by [ordinal::clm()] or [ordinal::clmm()]
#' of the `ordinal` package, [MASS::polr()] of the `MASS`
#' packge, or [survey::svyolr()] of the `survey` package.
#'
#' @param x a model of class `clm`, `clmm`, `polr` or `svyolr`
#' @param conf.int whether to include a confidence interval
#' @param conf.level confidence level of the interval, used only if
#' `conf.int=TRUE`
#' @param exponentiate whether to exponentiate the coefficient estimates
#' and confidence intervals (typical for ordinal logistic regression)
#' @param quick	whether to compute a smaller and faster version, containing only
#' the term, estimate and coefficient_type columns
#' @param conf.type the type of confidence interval
#' (see [ordinal::confint.clm()])
#' @param data original data, defaults to the extracting it from the model
#' @param newdata if provided, performs predictions on the new data
#' @param type.predict type of prediction to compute for a CLM; passed on to
#' [ordinal::predict.clm()] or `predict.polr`
#' @param ... extra arguments
#' @return
#' `tidy.clm`, `tidy.clmm`, `tidy.polr` and `tidy.svyolr`
#' return one row for each coefficient at each level of the response variable,
#' with six columns:
#'   \item{term}{term in the model}
#'   \item{estimate}{estimated coefficient}
#'   \item{std.error}{standard error}
#'   \item{statistic}{z-statistic}
#'   \item{p.value}{two-sided p-value}
#'   \item{coefficient_type}{type of coefficient, see [ordinal::clm()]}
#'
#' If `conf.int=TRUE`, it also includes columns for `conf.low` and
#'
#' `glance.clm`, `glance.clmm`, `glance.polr` and `glance.svyolr`
#' return a one-row data.frame with the columns:
#'   \item{edf}{the effective degrees of freedom}
#'   \item{logLik}{the data's log-likelihood under the model}
#'   \item{AIC}{the Akaike Information Criterion}
#'   \item{BIC}{the Bayesian Information Criterion}
#'   \item{df.residual}{residual degrees of freedom}
#'
#' `augment.clm` and `augment.polr` returns
#' one row for each observation, with additional columns added to
#' the original data:
#'   \item{.fitted}{fitted values of model}
#'   \item{.se.fit}{standard errors of fitted values}
#'
#' `augment` is not supportted for [ordinal::clmm()]
#' and [survey::svyolr()] models.
#'
#' All tidying methods return a `data.frame` without rownames.
#' The structure depends on the method chosen.
#'
#' @name ordinal_tidiers
#'
#' @examples
#' if (require(ordinal)){
#'   clm_mod <- clm(rating ~ temp * contact, data = wine)
#'   tidy(clm_mod)
#'   tidy(clm_mod, conf.int = TRUE)
#'   tidy(clm_mod, conf.int = TRUE, conf.type = "Wald", exponentiate = TRUE)
#'   glance(clm_mod)
#'   augment(clm_mod)
#'
#'   clm_mod2 <- clm(rating ~ temp, nominal = ~ contact, data = wine)
#'   tidy(clm_mod2)
#'
#'   clmm_mod <- clmm(rating ~ temp + contact + (1 | judge), data = wine)
#'   tidy(clmm_mod)
#'   glance(clmm_mod)
#' }
#' if (require(MASS)) {
#'   polr_mod <- polr(Sat ~ Infl + Type + Cont, weights = Freq, data = housing)
#'   tidy(polr_mod, exponentiate = TRUE, conf.int = TRUE)
#'   glance(polr_mod)
#'   augment(polr_mod, type.predict = "class")
#' }
NULL

#' @rdname ordinal_tidiers
#' @export
tidy.clm <- function(x, conf.int = FALSE, conf.level = .95,
                     exponentiate = FALSE, quick = FALSE,
                     conf.type = c("profile", "Wald"), ...) {
  if (quick) {
    co <- coef(x)
    ret <- data.frame(
      term = names(co), estimate = unname(co),
      stringsAsFactors = FALSE
    )
    return(process_clm(ret, x, conf.int = FALSE, exponentiate = exponentiate))
  }
  conf.type <- match.arg(conf.type)
  co <- coef(summary(x))
  nn <- c("estimate", "std.error", "statistic", "p.value")
  ret <- fix_data_frame(co, nn[seq_len(ncol(co))])
  process_clm(
    ret, x,
    conf.int = conf.int, conf.level = conf.level,
    exponentiate = exponentiate, conf.type = conf.type
  )
}


process_clm <- function(ret, x, conf.int = FALSE, conf.level = .95,
                        exponentiate = FALSE, conf.type = "profile") {
  if (exponentiate) {
    trans <- exp
  } else {
    trans <- identity
  }

  if (conf.int) {
    CI <- suppressMessages(
      trans(stats::confint(x, level = conf.level, type = conf.type))
    )
    colnames(CI) <- c("conf.low", "conf.high")
    CI <- as.data.frame(CI)
    CI$term <- rownames(CI)
    ret <- merge(ret, unrowname(CI), by = "term", all.x = TRUE)
  }

  ret$estimate <- trans(ret$estimate)
  ret$coefficient_type <- ""
  ret[ret$term %in% names(x$alpha), "coefficient_type"] <- "alpha"
  ret[ret$term %in% names(x$beta), "coefficient_type"] <- "beta"
  ret[ret$term %in% names(x$zeta), "coefficient_type"] <- "zeta"
  as_tibble(ret)
}

#' @rdname ordinal_tidiers
#' @export
tidy.clmm <- function(x, conf.int = FALSE, conf.level = .95,
                      exponentiate = FALSE, quick = FALSE,
                      conf.type = c("profile", "Wald"), ...) {
  tidy.clm(x, conf.int, conf.level, exponentiate, quick, ...)
}

#' @rdname ordinal_tidiers
#' @export
glance.clm <- function(x, ...) {
  ret <- with(
    x,
    tibble(
      edf = edf
    )
  )
  finish_glance(ret, x)
}

#' @rdname ordinal_tidiers
#' @export
glance.clmm <- glance.clm

#' @rdname ordinal_tidiers
#' @export
augment.clm <- function(x, data = stats::model.frame(x),
                        newdata, type.predict = c("prob", "class"), ...) {
  type.predict <- match.arg(type.predict)
  augment.lm(x, data, newdata, type.predict, ...)
}
