Move compute_intervals() to bottom of file with other internal helpers

Author: utkarshpawade

R/mcmc-intervals.R

@@ -608,64 +608,6 @@ mcmc_intervals_data <- function(x,
   compute_intervals(data_long, prob, prob_outer, point_est, rhat)
 }
 
-# Internal helper shared by mcmc_intervals_data() and mcmc_areas_data()
-compute_intervals <- function(data_long, prob, prob_outer,
-                              point_est = c("median", "mean", "none"),
-                              rhat = numeric()) {
-
-  probs <- c(0.5 - prob_outer / 2,
-             0.5 - prob / 2,
-             0.5 + prob / 2,
-             0.5 + prob_outer / 2)
-
-  point_est <- match.arg(point_est)
-  m_func <- if (point_est == "mean") mean else median
-
-  data <- data_long %>%
-    group_by(.data$parameter) %>%
-    summarise(
-      outer_width = prob_outer,
-      inner_width = prob,
-      point_est = point_est,
-      ll = unname(quantile(.data$value, probs[1])),
-      l  = unname(quantile(.data$value, probs[2])),
-      m  = m_func(.data$value),
-      h  = unname(quantile(.data$value, probs[3])),
-      hh = unname(quantile(.data$value, probs[4]))
-    )
-
-  if (point_est == "none") {
-    data$m <- NULL
-  }
-
-  color_by_rhat <- isTRUE(length(rhat) > 0)
-
-  if (color_by_rhat) {
-    rhat <- drop_NAs_and_warn(new_rhat(rhat))
-
-    if (length(rhat) != nrow(data)) {
-      abort(paste(
-        "'rhat' has length", length(rhat),
-        "but 'x' has", nrow(data), "parameters."
-      ))
-    }
-
-    rhat <- set_names(rhat, data$parameter)
-
-    rhat_tbl <- rhat %>%
-      mcmc_rhat_data() %>%
-      select(all_of("parameter"),
-             rhat_value = "value",
-             rhat_rating = "rating",
-             rhat_description = "description") %>%
-      mutate(parameter = factor(.data$parameter, levels(data$parameter)))
-
-    data <- dplyr::inner_join(data, rhat_tbl, by = "parameter")
-  }
-
-  data
-}
-
 
 # Don't import `filter`: otherwise, you get a warning when using
 # `devtools::load_all(".")` because stats also has a `filter` function
@@ -908,3 +850,61 @@ check_interval_widths <- function(prob, prob_outer) {
   }
   sort(c(prob, prob_outer))
 }
+
+# Internal helper shared by mcmc_intervals_data() and mcmc_areas_data()
+compute_intervals <- function(data_long, prob, prob_outer,
+                              point_est = c("median", "mean", "none"),
+                              rhat = numeric()) {
+
+  probs <- c(0.5 - prob_outer / 2,
+             0.5 - prob / 2,
+             0.5 + prob / 2,
+             0.5 + prob_outer / 2)
+
+  point_est <- match.arg(point_est)
+  m_func <- if (point_est == "mean") mean else median
+
+  data <- data_long %>%
+    group_by(.data$parameter) %>%
+    summarise(
+      outer_width = prob_outer,
+      inner_width = prob,
+      point_est = point_est,
+      ll = unname(quantile(.data$value, probs[1])),
+      l  = unname(quantile(.data$value, probs[2])),
+      m  = m_func(.data$value),
+      h  = unname(quantile(.data$value, probs[3])),
+      hh = unname(quantile(.data$value, probs[4]))
+    )
+
+  if (point_est == "none") {
+    data$m <- NULL
+  }
+
+  color_by_rhat <- isTRUE(length(rhat) > 0)
+
+  if (color_by_rhat) {
+    rhat <- drop_NAs_and_warn(new_rhat(rhat))
+
+    if (length(rhat) != nrow(data)) {
+      abort(paste(
+        "'rhat' has length", length(rhat),
+        "but 'x' has", nrow(data), "parameters."
+      ))
+    }
+
+    rhat <- set_names(rhat, data$parameter)
+
+    rhat_tbl <- rhat %>%
+      mcmc_rhat_data() %>%
+      select(all_of("parameter"),
+             rhat_value = "value",
+             rhat_rating = "rating",
+             rhat_description = "description") %>%
+      mutate(parameter = factor(.data$parameter, levels(data$parameter)))
+
+    data <- dplyr::inner_join(data, rhat_tbl, by = "parameter")
+  }
+
+  data
+}