Nothing
#' @templateVar class glht
#' @template title_desc_tidy
#'
#' @param x A `glht` object returned by [multcomp::glht()].
#' @template param_confint
#' @param ... Additional arguments passed to [summary()] and
#' [tidy.summary.glht()].
#'
#' @evalRd return_tidy("contrast", "null.value", "estimate")
#'
#' @examplesIf rlang::is_installed(c("multcomp", "ggplot2"))
#'
#' # load libraries for models and data
#' library(multcomp)
#' library(ggplot2)
#'
#' amod <- aov(breaks ~ wool + tension, data = warpbreaks)
#' wht <- glht(amod, linfct = mcp(tension = "Tukey"))
#'
#' tidy(wht)
#'
#' ggplot(wht, aes(lhs, estimate)) +
#' geom_point()
#'
#' CI <- confint(wht)
#'
#' tidy(CI)
#'
#' ggplot(CI, aes(lhs, estimate, ymin = lwr, ymax = upr)) +
#' geom_pointrange()
#'
#' tidy(summary(wht))
#' ggplot(mapping = aes(lhs, estimate)) +
#' geom_linerange(aes(ymin = lwr, ymax = upr), data = CI) +
#' geom_point(aes(size = p), data = summary(wht)) +
#' scale_size(trans = "reverse")
#'
#' cld <- cld(wht)
#' tidy(cld)
#'
#' @aliases multcomp_tidiers
#' @export
#' @family multcomp tidiers
#' @seealso [tidy()], [multcomp::glht()]
#'
tidy.glht <- function(x, conf.int = FALSE, conf.level = .95, ...) {
check_ellipses("exponentiate", "tidy", "glht", ...)
glht_summary <- summary(x, ...)
tidy_glht_summary <- tidy.summary.glht(glht_summary, ...)
if (conf.int) {
tidy_glht_confint <- tidy.confint.glht(confint(x, level = conf.level, ...))
by_cols <- c("contrast", "estimate")
if ("term" %in% colnames(tidy_glht_summary)) {
by_cols <- c("term", by_cols)
}
tidy_glht_summary <- dplyr::select(tidy_glht_summary, -std.error) %>%
dplyr::left_join(tidy_glht_confint, by = by_cols) %>%
dplyr::select(
dplyr::contains("term"), contrast, null.value, estimate,
conf.low, conf.high, dplyr::everything()
)
return(tidy_glht_summary)
}
tidy_glht_summary
}
#' @templateVar class confint.glht
#' @template title_desc_tidy
#'
#' @param x A `confint.glht` object created by calling
#' [multcomp::confint.glht()] on a `glht` object created with
#' [multcomp::glht()].
#' @template param_unused_dots
#'
#' @inherit tidy.glht examples
#' @evalRd return_tidy("contrast", "estimate", "conf.low", "conf.high")
#'
#' @export
#' @family multcomp tidiers
#' @seealso [tidy()], [multcomp::confint.glht()], [multcomp::glht()]
tidy.confint.glht <- function(x, ...) {
lhs_rhs <- glht_lhr_rhs_tibble(x)
coef <- as_tibble(x$confint)
colnames(coef) <- c("estimate", "conf.low", "conf.high")
coef$estimate <- as.vector(coef$estimate) # Remove attributes
bind_cols(glht_term_column(x), lhs_rhs[, "contrast", drop = FALSE], coef)
}
#' @templateVar class summary.glht
#' @template title_desc_tidy
#'
#' @param x A `summary.glht` object created by calling
#' [multcomp::summary.glht()] on a `glht` object created with
#' [multcomp::glht()].
#' @template param_unused_dots
#'
#' @inherit tidy.glht examples
#' @evalRd return_tidy(
#' "contrast",
#' "null.value",
#' "estimate",
#' "std.error",
#' "statistic",
#' "p.value"
#' )
#'
#' @export
#' @family multcomp tidiers
#' @seealso [tidy()], [multcomp::summary.glht()], [multcomp::glht()]
tidy.summary.glht <- function(x, ...) {
lhs_rhs <- glht_lhr_rhs_tibble(x)
coef <- as_tibble(
x$test[c("coefficients", "sigma", "tstat", "pvalues")]
)
if (x$test$type != "none") {
pvalue_colname <- "adj.p.value"
} else {
pvalue_colname <- "p.value"
}
names(coef) <- c("estimate", "std.error", "statistic", pvalue_colname)
bind_cols(glht_term_column(x), lhs_rhs, coef)
}
glht_lhr_rhs_tibble <- function(x) {
tibble(
contrast = stringr::str_replace(rownames(x$linfct), "^.+: ", ""),
null.value = x$rhs
)
}
glht_term_column <- function(x) {
if (!is.null(x$focus) && length(x$focus) == 1) {
tibble(term = rep(x$focus, nrow(x$linfct)))
} else if (!is.null(x$focus) && length(x$focus) > 1) {
term <- stringr::str_extract(rownames(x$linfct), "(^.+): .")
term <- stringr::str_replace(term, ": .$", "")
tibble(term = term)
}
}
#' @templateVar class cld
#' @template title_desc_tidy
#'
#' @param x A `cld` object created by calling [multcomp::cld()] on a
#' `glht`, `confint.glht()` or `summary.glht()` object.
#' @template param_unused_dots
#'
#' @inherit tidy.glht examples
#' @evalRd return_tidy("contrast", "letters")
#'
#' @export
#' @family multcomp tidiers
#' @seealso [tidy()], [multcomp::cld()], [multcomp::summary.glht()],
#' [multcomp::confint.glht()], [multcomp::glht()]
tidy.cld <- function(x, ...) {
vec <- x$mcletters$Letters
tidy_cld <- tibble(names(vec), vec)
colnames(tidy_cld) <- c(x$xname, "letters")
tidy_cld
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.