merge pr #925: rename interval columns

DESCRIPTION

@@ -495,7 +495,11 @@ Authors@R:
 	    person(given = "R. Willem",
              family = "Vervoort",
              role = "ctb",
-             email = "Willemvervoort@gmail.com"))
+             email = "Willemvervoort@gmail.com"),
+         person(given = "Brenton M.",
+             family = "Wiernik",
+             role = "ctb",
+             email = "brenton@wiernik.org"))
 Description: Summarizes key information about statistical
     objects in tidy tibbles. This makes it easy to report results, create
     plots and consistently work with large numbers of models at once.

NEWS.md

@@ -24,6 +24,8 @@ in the overwriting of entries in the `curve` column (#914)
 * Fixed bug related to univariate zoo series in `tidy.zoo()` (#916 by @WillemVervoort)
 * Fixed a bug related to `tidy.prcomp()` assigning the wrong PC labels from "loadings" 
 and "scores" matrices (#910 by @tavareshugo)
+* Consistently label interval columns `.lower` and `.upper` in `augment()` 
+methods (#925 by @bwiernik)
 * Add `glance.coeftest()` method (#932 by @grantmcdermott)
 * Followed through with the planned deprecation of character vector tidiers
 * Several unsupported model objects that subclass `glm` and `lm` now error more 

R/drc-tidiers.R

@@ -81,8 +81,8 @@ glance.drc <- function(x, ...) {
 #' @template param_unused_dots
 #'
 #' @evalRd return_augment(
-#'   ".conf.low",
-#'   ".conf.high",
+#'   ".lower",
+#'   ".upper",
 #'   ".se.fit",
 #'   ".fitted",
 #'   ".resid",
@@ -123,8 +123,8 @@ augment.drc <- function(x, data = NULL, newdata = NULL,
         newdata = newdata, interval = "confidence",
         level = conf.level
       ))
-      ret[[".conf.low"]] <- preds[["Lower"]]
-      ret[[".conf.high"]] <- preds[["Upper"]]
+      ret[[".lower"]] <- preds[["Lower"]]
+      ret[[".upper"]] <- preds[["Upper"]]
     }
     if (se_fit) {
       preds <- data.frame(predict(x, newdata = newdata, se.fit = TRUE))

R/quantreg-rq-tidiers.R

@@ -99,7 +99,7 @@ glance.rq <- function(x, ...) {
 #'
 #' @details Depending on the arguments passed on to `predict.rq` via `...`,
 #'   a confidence interval is also calculated on the fitted values resulting in
-#'   columns `.conf.low` and `.conf.high`. Does not provide confidence
+#'   columns `.lower` and `.upper`. Does not provide confidence
 #'   intervals when data is specified via the `newdata` argument.
 #'
 #' @export
@@ -129,7 +129,7 @@ augment.rq <- function(x, data = model.frame(x), newdata = NULL, ...) {
     original[[".tau"]] <- x[["tau"]]
     return(as_tibble(original))
   } else {
-    colnames(pred) <- c(".fitted", ".conf.low", ".conf.high")
+    colnames(pred) <- c(".fitted", ".lower", ".upper")
     original[[".tau"]] <- x[["tau"]]
     return(as_tibble(cbind(original, pred)))
   }

R/rma-tidiers.R

@@ -186,15 +186,18 @@ glance.rma <- function(x, ...) {
 #' @template title_desc_augment
 #'
 #' @inheritParams tidy.rma
+#' @param interval For `rma.mv` models, should prediction intervals 
+#'    (`"prediction"`, default) or confidence intervals (`"confidence"`) 
+#'    intervals be returned? For `rma.uni` models, prediction intervals are 
+#'    always returned. For `rma.mh` and `rma.peto` models, confidence intervals
+#'    are always returned. 
 #'
 #' @evalRd return_augment(
 #'   .observed = "The observed values for the individual studies",
 #'   ".fitted",
 #'   ".se.fit",
-#'   ".conf.low",
-#'   ".conf.high",
-#'   ".cred.low",
-#'   ".cred.high",
+#'   ".lower",
+#'   ".upper",
 #'   ".resid",
 #'   ".moderator",
 #'   ".moderator.level"
@@ -219,7 +222,7 @@ glance.rma <- function(x, ...) {
 #' meta_analysis <- rma(yi, vi, data = df, method = "EB")
 #'
 #' augment(meta_analysis)
-augment.rma <- function(x, ...) {
+augment.rma <- function(x, interval = c("prediction", "confidence"), ...) {
   # metafor generally handles these for different models through the monolith
   # `rma` class; using `purrr::possibly` primarily helps discard unused
   # components but also helps get the right component for each model
@@ -235,9 +238,16 @@ augment.rma <- function(x, ...) {
   pred <- as.data.frame(pred)
 
   # fix names
-  names(pred)[1:4] <- c(".fitted", ".se.fit", ".conf.low", ".conf.high")
-  credible_intervals <- names(pred) %in% c("cr.lb", "cr.ub")
-  names(pred)[credible_intervals] <- c(".cred.low", ".cred.high")
+  interval <- match.arg(interval, c("prediction", "confidence"))
+  if (interval == "prediction" & any(names(pred) %in% c("cr.lb", "cr.ub", "pi.lb", "pi.ub"))) {
+    confidence_intervals <- names(pred) %in% c("ci.lb", "ci.ub")
+    pred <- pred[, !confidence_intervals]
+    names(pred)[1:4] <- c(".fitted", ".se.fit", ".lower", ".upper")
+  } else {
+    prediction_intervals <- names(pred) %in% c("cr.lb", "cr.ub", "pi.lb", "pi.ub")
+    pred <- pred[, !prediction_intervals]
+    names(pred)[1:4] <- c(".fitted", ".se.fit", ".lower", ".upper")
+  }
   moderator <- names(pred) == "X"
   names(pred)[moderator] <- ".moderator"
   moderator_level <- names(pred) == "tau2.level"

R/stats-lm-tidiers.R

@@ -45,7 +45,7 @@
 #' ggplot(au, aes(wt, mpg)) + 
 #'   geom_point() +
 #'   geom_line(aes(y = .fitted)) + 
-#'   geom_ribbon(aes(ymin = .conf.low, ymax = .conf.high), col = NA, alpha = 0.3)
+#'   geom_ribbon(aes(ymin = .lower, ymax = .upper), col = NA, alpha = 0.3)
 #' 
 #' # predict on new data without outcome variable. Output does not include .resid
 #' newdata <- newdata %>%
@@ -113,8 +113,8 @@ tidy.lm <- function(x, conf.int = FALSE, conf.level = 0.95, ...) {
 #'
 #' @evalRd return_augment(
 #'   ".hat",
-#'   ".conf.low",
-#'   ".conf.high", 
+#'   ".lower",
+#'   ".upper", 
 #'   ".sigma",
 #'   ".cooksd",
 #'   ".se.fit",

R/utilities.R

@@ -390,8 +390,8 @@ augment_newdata <- function(x, data, newdata, .se_fit, interval = NULL, ...) {
       df$.fitted <- pred_obj$fit %>% unname()
     } else {
       df$.fitted <- pred_obj$fit[, "fit"]
-      df$.conf.low <- pred_obj$fit[, "lwr"]
-      df$.conf.high <- pred_obj$fit[, "upr"]
+      df$.lower <- pred_obj$fit[, "lwr"]
+      df$.upper <- pred_obj$fit[, "upr"]
     }
 
     # a couple possible names for the standard error element of the list
@@ -403,17 +403,17 @@ augment_newdata <- function(x, data, newdata, .se_fit, interval = NULL, ...) {
   } else if (!is.null(interval) && interval!="none") {
     pred_obj <- predict(x, newdata = newdata, na.action = na.pass, se.fit = FALSE, interval = interval, ...)
     df$.fitted <- pred_obj[, "fit"]
-    df$.conf.low <- pred_obj[, "lwr"]
-    df$.conf.high <- pred_obj[, "upr"]
+    df$.lower <- pred_obj[, "lwr"]
+    df$.upper <- pred_obj[, "upr"]
   } else if (passed_newdata) {
     if (is.null(interval) || interval=="none") {
       df$.fitted <- predict(x, newdata = newdata, na.action = na.pass, ...) %>% 
         unname()
     } else {
       pred_obj <- predict(x, newdata = newdata, na.action = na.pass, interval = interval, ...)
       df$.fitted <- pred_obj$fit[, "fit"]
-      df$.conf.low <- pred_obj$fit[, "lwr"]
-      df$.conf.high <- pred_obj$fit[, "upr"]
+      df$.lower <- pred_obj$fit[, "lwr"]
+      df$.upper <- pred_obj$fit[, "upr"]
     }
   } else {
     if (is.null(interval) || interval=="none") {
@@ -422,8 +422,8 @@ augment_newdata <- function(x, data, newdata, .se_fit, interval = NULL, ...) {
     } else {
       pred_obj <- predict(x, newdata = newdata, na.action = na.pass, interval = interval, ...)
       df$.fitted <- pred_obj$fit[, "fit"]
-      df$.conf.low <- pred_obj$fit[, "lwr"]
-      df$.conf.high <- pred_obj$fit[, "upr"]
+      df$.lower <- pred_obj$fit[, "lwr"]
+      df$.upper <- pred_obj$fit[, "upr"]
     }
   }