From 0b4cf5d2ed83969a09374911bf0f0ef3867d3e7a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Fri, 13 Sep 2024 11:28:52 -0400
Subject: [PATCH 01/29] code from parsnip

---
 NAMESPACE                           |  17 +++
 R/hardhat-package.R                 |   2 +
 R/quantile-pred.R                   | 223 ++++++++++++++++++++++++++++
 man/quantile_pred.Rd                |  61 ++++++++
 man/reexports.Rd                    |  18 +++
 tests/testthat/helper-data.R        |  14 ++
 tests/testthat/test-quantile-pred.R |  59 ++++++++
 7 files changed, 394 insertions(+)
 create mode 100644 R/quantile-pred.R
 create mode 100644 man/quantile_pred.Rd
 create mode 100644 man/reexports.Rd
 create mode 100644 tests/testthat/helper-data.R
 create mode 100644 tests/testthat/test-quantile-pred.R

diff --git a/NAMESPACE b/NAMESPACE
index d9cf172b..a69acc29 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,16 +1,21 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as.matrix,quantile_pred)
+S3method(as_tibble,quantile_pred)
 S3method(forge,data.frame)
 S3method(forge,default)
 S3method(forge,matrix)
 S3method(format,formula_blueprint)
+S3method(format,quantile_pred)
 S3method(format,recipe_blueprint)
 S3method(format,xy_blueprint)
+S3method(median,quantile_pred)
 S3method(mold,data.frame)
 S3method(mold,default)
 S3method(mold,formula)
 S3method(mold,matrix)
 S3method(mold,recipe)
+S3method(obj_print_footer,quantile_pred)
 S3method(print,formula_blueprint)
 S3method(print,hardhat_blueprint)
 S3method(print,hardhat_model)
@@ -45,8 +50,10 @@ S3method(vec_ptype2,hardhat_frequency_weights.hardhat_frequency_weights)
 S3method(vec_ptype2,hardhat_importance_weights.hardhat_importance_weights)
 S3method(vec_ptype_abbr,hardhat_frequency_weights)
 S3method(vec_ptype_abbr,hardhat_importance_weights)
+S3method(vec_ptype_abbr,quantile_pred)
 S3method(vec_ptype_full,hardhat_frequency_weights)
 S3method(vec_ptype_full,hardhat_importance_weights)
+S3method(vec_ptype_full,quantile_pred)
 export(add_intercept_column)
 export(check_column_names)
 export(check_no_formula_duplication)
@@ -69,6 +76,7 @@ export(extract_parameter_dials)
 export(extract_parameter_set_dials)
 export(extract_postprocessor)
 export(extract_preprocessor)
+export(extract_quantile_levels)
 export(extract_recipe)
 export(extract_spec_parsnip)
 export(extract_workflow)
@@ -98,6 +106,8 @@ export(new_importance_weights)
 export(new_model)
 export(new_recipe_blueprint)
 export(new_xy_blueprint)
+export(obj_print_footer)
+export(quantile_pred)
 export(recompose)
 export(refresh_blueprint)
 export(run_forge)
@@ -123,13 +133,20 @@ export(validate_outcomes_are_numeric)
 export(validate_outcomes_are_univariate)
 export(validate_prediction_size)
 export(validate_predictors_are_numeric)
+export(vec_ptype_abbr)
+export(vec_ptype_full)
 export(weighted_table)
 import(rlang)
 import(vctrs)
 importFrom(glue,glue)
 importFrom(stats,delete.response)
 importFrom(stats,get_all_vars)
+importFrom(stats,median)
 importFrom(stats,model.frame)
 importFrom(stats,model.matrix)
 importFrom(stats,terms)
+importFrom(tibble,as_tibble)
 importFrom(tibble,tibble)
+importFrom(vctrs,obj_print_footer)
+importFrom(vctrs,vec_ptype_abbr)
+importFrom(vctrs,vec_ptype_full)
diff --git a/R/hardhat-package.R b/R/hardhat-package.R
index 41e1a01f..6eb515bd 100644
--- a/R/hardhat-package.R
+++ b/R/hardhat-package.R
@@ -7,11 +7,13 @@
 #' @import rlang
 #' @import vctrs
 #' @importFrom glue glue
+#' @importFrom tibble as_tibble
 #' @importFrom tibble tibble
 #' @importFrom stats model.frame
 #' @importFrom stats model.matrix
 #' @importFrom stats delete.response
 #' @importFrom stats get_all_vars
 #' @importFrom stats terms
+#' @importFrom stats median
 ## usethis namespace: end
 NULL
diff --git a/R/quantile-pred.R b/R/quantile-pred.R
new file mode 100644
index 00000000..cae29de0
--- /dev/null
+++ b/R/quantile-pred.R
@@ -0,0 +1,223 @@
+# Helpers for quantile regression models
+
+check_quantile_level <- function(x, object, call) {
+  if (object$mode != "quantile regression") {
+    return(invisible(TRUE))
+  } else {
+    if (is.null(x)) {
+      cli::cli_abort("In {.fn check_mode}, at least one value of
+      {.arg quantile_level} must be specified for quantile regression models.")
+    }
+  }
+  if (any(is.na(x))) {
+    cli::cli_abort("Missing values are not allowed in {.arg quantile_levels}.",
+                   call = call)
+  }
+  x <- sort(unique(x))
+  check_vector_probability(x, arg = "quantile_level", call = call)
+  x
+}
+
+
+# -------------------------------------------------------------------------
+# A column vector of quantiles with an attribute
+
+#' @importFrom vctrs vec_ptype_abbr
+#' @export
+vctrs::vec_ptype_abbr
+
+#' @importFrom vctrs vec_ptype_full
+#' @export
+vctrs::vec_ptype_full
+
+
+#' @export
+vec_ptype_abbr.quantile_pred <- function(x, ...) {
+  n_lvls <- length(attr(x, "quantile_levels"))
+  cli::format_inline("qtl{?s}({n_lvls})")
+}
+
+#' @export
+vec_ptype_full.quantile_pred <- function(x, ...) "quantiles"
+
+new_quantile_pred <- function(values = list(), quantile_levels = double()) {
+  quantile_levels <- vctrs::vec_cast(quantile_levels, double())
+  vctrs::new_vctr(
+    values, quantile_levels = quantile_levels, class = "quantile_pred"
+  )
+}
+
+#' Create a vector containing sets of quantiles
+#'
+#' [quantile_pred()] is a special vector class used to efficiently store
+#' predictions from a quantile regression model. It requires the same quantile
+#' levels for each row being predicted.
+#'
+#' @param values A matrix of values. Each column should correspond to one of
+#'   the quantile levels.
+#' @param quantile_levels A vector of probabilities corresponding to `values`.
+#' @param x An object produced by [quantile_pred()].
+#' @param .rows,.name_repair,rownames Arguments not used but required by the
+#' original S3 method.
+#' @param ... Not currently used.
+#'
+#' @export
+#' @return
+#'   * [quantile_pred()] returns a vector of values associated with the
+#' quantile levels.
+#'   * [extract_quantile_levels()] returns a numeric vector of levels.
+#'   * [as_tibble()] returns a tibble with rows `".pred_quantile"`,
+#'   `".quantile_levels"`, and `".row"`.
+#'   * [as.matrix()] returns an unnamed matrix with rows as sames, columns as
+#'   quantile levels, and entries are predictions.
+#' @examples
+#' .pred_quantile <- quantile_pred(matrix(rnorm(20), 5), c(.2, .4, .6, .8))
+#'
+#' unclass(.pred_quantile)
+#'
+#' # Access the underlying information
+#' extract_quantile_levels(.pred_quantile)
+#'
+#' # Matrix format
+#' as.matrix(.pred_quantile)
+#'
+#' # Tidy format
+#' library(tibble)
+#' as_tibble(.pred_quantile)
+quantile_pred <- function(values, quantile_levels = double()) {
+  check_quantile_pred_inputs(values, quantile_levels)
+
+  quantile_levels <- vctrs::vec_cast(quantile_levels, double())
+  num_lvls <- length(quantile_levels)
+
+  if (ncol(values) != num_lvls) {
+    cli::cli_abort(
+      "The number of columns in {.arg values} must be equal to the length of
+        {.arg quantile_levels}."
+    )
+  }
+  rownames(values) <- NULL
+  colnames(values) <- NULL
+  values <- lapply(vctrs::vec_chop(values), drop)
+  new_quantile_pred(values, quantile_levels)
+}
+
+check_quantile_pred_inputs <- function(values, levels, call = caller_env()) {
+  if (any(is.na(levels))) {
+    cli::cli_abort("Missing values are not allowed in {.arg quantile_levels}.",
+                   call = call)
+  }
+
+  if (!is.matrix(values)) {
+    cli::cli_abort(
+      "{.arg values} must be a {.cls matrix}, not {.obj_type_friendly {values}}.",
+      call = call
+    )
+  }
+  check_vector_probability(levels, arg = "quantile_levels", call = call)
+
+  if (is.unsorted(levels)) {
+    cli::cli_abort(
+      "{.arg quantile_levels} must be sorted in increasing order.",
+      call = call
+    )
+  }
+  invisible(NULL)
+}
+
+#' @export
+format.quantile_pred <- function(x, ...) {
+  quantile_levels <- attr(x, "quantile_levels")
+  if (length(quantile_levels) == 1L) {
+    x <- unlist(x)
+    out <- round(x, 3L)
+    out[is.na(x)] <- NA_real_
+  } else {
+    rng <- sapply(x, range, na.rm = TRUE)
+    out <- paste0("[", round(rng[1, ], 3L), ", ", round(rng[2, ], 3L), "]")
+    out[is.na(rng[1, ]) & is.na(rng[2, ])] <- NA_character_
+    m <- median(x)
+    out <- paste0("[", round(m, 3L), "]")
+  }
+  out
+}
+
+#' @importFrom vctrs obj_print_footer
+#' @export
+vctrs::obj_print_footer
+
+#' @export
+obj_print_footer.quantile_pred <- function(x, digits = 3, ...) {
+  lvls <- attr(x, "quantile_levels")
+  cat("# Quantile levels: ", format(lvls, digits = digits), "\n", sep = " ")
+}
+
+check_vector_probability <- function(x, ...,
+                                     allow_na = FALSE,
+                                     allow_null = FALSE,
+                                     arg = caller_arg(x),
+                                     call = caller_env()) {
+  for (d in x) {
+    check_number_decimal(
+      d, min = 0, max = 1,
+      arg = arg, call = call,
+      allow_na = allow_na,
+      allow_null = allow_null,
+      allow_infinite = FALSE
+    )
+  }
+}
+
+#' @export
+median.quantile_pred <- function(x, ...) {
+  lvls <- attr(x, "quantile_levels")
+  loc_median <- (abs(lvls - 0.5) < sqrt(.Machine$double.eps))
+  if (any(loc_median)) {
+    return(map_dbl(x, ~ .x[min(which(loc_median))]))
+  }
+  if (length(lvls) < 2 || min(lvls) > 0.5 || max(lvls) < 0.5) {
+    return(rep(NA, vctrs::vec_size(x)))
+  }
+  map_dbl(x, ~ stats::approx(lvls, .x, xout = 0.5)$y)
+}
+
+restructure_rq_pred <- function(x, object) {
+  if (!is.matrix(x)) {
+    x <- as.matrix(x)
+  }
+  rownames(x) <- NULL
+  n_pred_quantiles <- ncol(x)
+  quantile_level <- object$spec$quantile_level
+
+  tibble::new_tibble(x = list(.pred_quantile = quantile_pred(x, quantile_level)))
+}
+
+#' @export
+#' @rdname quantile_pred
+extract_quantile_levels <- function(x) {
+  if (!inherits(x, "quantile_pred")) {
+    cli::cli_abort("{.arg x} should have class {.val quantile_pred}.")
+  }
+  attr(x, "quantile_levels")
+}
+
+#' @export
+#' @rdname quantile_pred
+as_tibble.quantile_pred <-
+  function (x, ..., .rows = NULL, .name_repair = "minimal", rownames = NULL) {
+    lvls <- attr(x, "quantile_levels")
+    n_samp <- length(x)
+    n_quant <- length(lvls)
+    tibble::tibble(
+      .pred_quantile = unlist(x),
+      .quantile_levels = rep(lvls, n_samp),
+      .row = rep(1:n_samp, each = n_quant)
+    )
+  }
+
+#' @export
+#' @rdname quantile_pred
+as.matrix.quantile_pred <- function(x, ...) {
+  num_samp <- length(x)
+  matrix(unlist(x), nrow = num_samp)
+}
diff --git a/man/quantile_pred.Rd b/man/quantile_pred.Rd
new file mode 100644
index 00000000..d36b73e8
--- /dev/null
+++ b/man/quantile_pred.Rd
@@ -0,0 +1,61 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/quantile-pred.R
+\name{quantile_pred}
+\alias{quantile_pred}
+\alias{extract_quantile_levels}
+\alias{as_tibble.quantile_pred}
+\alias{as.matrix.quantile_pred}
+\title{Create a vector containing sets of quantiles}
+\usage{
+quantile_pred(values, quantile_levels = double())
+
+extract_quantile_levels(x)
+
+\method{as_tibble}{quantile_pred}(x, ..., .rows = NULL, .name_repair = "minimal", rownames = NULL)
+
+\method{as.matrix}{quantile_pred}(x, ...)
+}
+\arguments{
+\item{values}{A matrix of values. Each column should correspond to one of
+the quantile levels.}
+
+\item{quantile_levels}{A vector of probabilities corresponding to \code{values}.}
+
+\item{x}{An object produced by \code{\link[=quantile_pred]{quantile_pred()}}.}
+
+\item{...}{Not currently used.}
+
+\item{.rows, .name_repair, rownames}{Arguments not used but required by the
+original S3 method.}
+}
+\value{
+\itemize{
+\item \code{\link[=quantile_pred]{quantile_pred()}} returns a vector of values associated with the
+quantile levels.
+\item \code{\link[=extract_quantile_levels]{extract_quantile_levels()}} returns a numeric vector of levels.
+\item \code{\link[=as_tibble]{as_tibble()}} returns a tibble with rows \code{".pred_quantile"},
+\code{".quantile_levels"}, and \code{".row"}.
+\item \code{\link[=as.matrix]{as.matrix()}} returns an unnamed matrix with rows as sames, columns as
+quantile levels, and entries are predictions.
+}
+}
+\description{
+\code{\link[=quantile_pred]{quantile_pred()}} is a special vector class used to efficiently store
+predictions from a quantile regression model. It requires the same quantile
+levels for each row being predicted.
+}
+\examples{
+.pred_quantile <- quantile_pred(matrix(rnorm(20), 5), c(.2, .4, .6, .8))
+
+unclass(.pred_quantile)
+
+# Access the underlying information
+extract_quantile_levels(.pred_quantile)
+
+# Matrix format
+as.matrix(.pred_quantile)
+
+# Tidy format
+library(tibble)
+as_tibble(.pred_quantile)
+}
diff --git a/man/reexports.Rd b/man/reexports.Rd
new file mode 100644
index 00000000..b3f7c333
--- /dev/null
+++ b/man/reexports.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/quantile-pred.R
+\docType{import}
+\name{reexports}
+\alias{reexports}
+\alias{vec_ptype_abbr}
+\alias{vec_ptype_full}
+\alias{obj_print_footer}
+\title{Objects exported from other packages}
+\keyword{internal}
+\description{
+These objects are imported from other packages. Follow the links
+below to see their documentation.
+
+\describe{
+  \item{vctrs}{\code{\link[vctrs:obj_print]{obj_print_footer}}, \code{\link[vctrs:vec_ptype_full]{vec_ptype_abbr}}, \code{\link[vctrs]{vec_ptype_full}}}
+}}
+
diff --git a/tests/testthat/helper-data.R b/tests/testthat/helper-data.R
new file mode 100644
index 00000000..f38183ac
--- /dev/null
+++ b/tests/testthat/helper-data.R
@@ -0,0 +1,14 @@
+# ------------------------------------------------------------------------------
+# for quantile regression tests
+
+library(modeldata)
+
+data("Sacramento")
+
+cols <- c("price", "beds", "baths", "sqft", "latitude", "longitude")
+Sacramento_small <- modeldata::Sacramento
+Sacramento_small$price <- log10(Sacramento_small$price)
+Sacramento_small <- Sacramento_small[, cols]
+
+sac_train <- Sacramento_small[-(1:5), ]
+sac_test  <- Sacramento_small[  1:5 , ]
diff --git a/tests/testthat/test-quantile-pred.R b/tests/testthat/test-quantile-pred.R
new file mode 100644
index 00000000..cdf71aa7
--- /dev/null
+++ b/tests/testthat/test-quantile-pred.R
@@ -0,0 +1,59 @@
+test_that("quantile_pred error types", {
+  expect_snapshot(
+    error = TRUE,
+    quantile_pred(1:10, 1:4 / 5)
+  )
+  expect_snapshot(
+    error = TRUE,
+    quantile_pred(matrix(1:20, 5), -1:4 / 5)
+  )
+  expect_snapshot(
+    error = TRUE,
+    quantile_pred(matrix(1:20, 5), 1:5 / 6)
+  )
+  expect_snapshot(
+    error = TRUE,
+    quantile_pred(matrix(1:20, 5), 4:1 / 5)
+  )
+})
+
+test_that("quantile_pred outputs", {
+  v <- quantile_pred(matrix(1:20, 5), 1:4 / 5)
+  expect_s3_class(v, "quantile_pred")
+  expect_identical(attr(v, "quantile_levels"), 1:4 / 5)
+  expect_identical(
+    vctrs::vec_data(v),
+    lapply(vctrs::vec_chop(matrix(1:20, 5)), drop)
+  )
+})
+
+test_that("quantile_pred formatting", {
+  # multiple quantiles
+  v <- quantile_pred(matrix(1:20, 5), 1:4 / 5)
+  expect_snapshot(v)
+  expect_snapshot(quantile_pred(matrix(1:18, 9), c(1/3, 2/3)))
+  expect_snapshot(
+    quantile_pred(matrix(seq(0.01, 1 - 0.01, length.out = 6), 3), c(.2, .8))
+  )
+  expect_snapshot(tibble(qntls = v))
+  m <- matrix(1:20, 5)
+  m[2, 3] <- NA
+  m[4, 2] <- NA
+  expect_snapshot(quantile_pred(m, 1:4 / 5))
+
+  # single quantile
+  m <- matrix(1:5)
+  one_quantile <- quantile_pred(m, 5/9)
+  expect_snapshot(one_quantile)
+  expect_snapshot(tibble(qntls = one_quantile))
+  m[2] <- NA
+  expect_snapshot(quantile_pred(m, 5/9))
+})
+
+test_that("as_tibble() for quantile_pred", {
+  v <- quantile_pred(matrix(1:20, 5), 1:4 / 5)
+  tbl <- as_tibble(v)
+  expect_s3_class(tbl, c("tbl_df", "tbl", "data.frame"))
+  expect_named(tbl, c(".pred_quantile", ".quantile_levels", ".row"))
+  expect_true(nrow(tbl) == 20)
+})

From 1739032575e50fd96eaa94def9ca33703a0cfd3f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Fri, 13 Sep 2024 11:30:59 -0400
Subject: [PATCH 02/29] version bump

---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 50bd6217..a5d508ed 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: hardhat
 Title: Construct Modeling Packages
-Version: 1.4.0.9000
+Version: 1.4.0.9001
 Authors@R: c(
     person("Hannah", "Frick", , "hannah@posit.co", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-6049-5258")),

From 82a89c4b5b9d04f4e3270408f329579275ec0ed5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Fri, 13 Sep 2024 11:32:43 -0400
Subject: [PATCH 03/29] news update

---
 NEWS.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 4ce3259d..28c31732 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
 # hardhat (development version)
 
+* Added a new vector class called `quantile_pred()` to house predictions made from a quantile regression model. 
+
 # hardhat 1.4.0
 
 * Added `extract_postprocessor()` generic (#247).

From 8add7cb211c4bdbeaba1129c740b042af5b8de71 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Fri, 13 Sep 2024 12:03:39 -0400
Subject: [PATCH 04/29] add pkgdown entry

---
 _pkgdown.yml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/_pkgdown.yml b/_pkgdown.yml
index 3d0ce780..6894b4c5 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -24,7 +24,9 @@ reference:
   - forge
 
 - title: Prediction
-  contents: contains("spruce")
+  contents:
+  - contains("spruce")
+  - quantile_pred
 
 - title: Utility
   contents:

From 7192170f06e7cdf6eafb1aa9b4bf74177202cd0b Mon Sep 17 00:00:00 2001
From: Max Kuhn <mxkuhn@gmail.com>
Date: Fri, 13 Sep 2024 16:10:44 -0400
Subject: [PATCH 05/29] Apply suggestions from code review

Co-authored-by: Simon P. Couch <simonpatrickcouch@gmail.com>
---
 NEWS.md           | 2 +-
 R/quantile-pred.R | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 28c31732..b76ba201 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,6 @@
 # hardhat (development version)
 
-* Added a new vector class called `quantile_pred()` to house predictions made from a quantile regression model. 
+* Added a new vector class called `quantile_pred()` to house predictions made from a quantile regression model (tidymodels/parsnip#1191, @dajmcdon). 
 
 # hardhat 1.4.0
 
diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index cae29de0..e51cb5fc 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -208,11 +208,11 @@ as_tibble.quantile_pred <-
     lvls <- attr(x, "quantile_levels")
     n_samp <- length(x)
     n_quant <- length(lvls)
-    tibble::tibble(
+    tibble::new_tibble(list(
       .pred_quantile = unlist(x),
       .quantile_levels = rep(lvls, n_samp),
       .row = rep(1:n_samp, each = n_quant)
-    )
+    ))
   }
 
 #' @export

From fa85a3b90d0eab414b162be167484d97f0f67728 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 21:54:41 +0100
Subject: [PATCH 06/29] add snapshot file

---
 tests/testthat/_snaps/quantile-pred.md | 114 +++++++++++++++++++++++++
 1 file changed, 114 insertions(+)
 create mode 100644 tests/testthat/_snaps/quantile-pred.md

diff --git a/tests/testthat/_snaps/quantile-pred.md b/tests/testthat/_snaps/quantile-pred.md
new file mode 100644
index 00000000..0925f61d
--- /dev/null
+++ b/tests/testthat/_snaps/quantile-pred.md
@@ -0,0 +1,114 @@
+# quantile_pred error types
+
+    Code
+      quantile_pred(1:10, 1:4 / 5)
+    Condition
+      Error in `quantile_pred()`:
+      ! `values` must be a <matrix>, not an integer vector.
+
+---
+
+    Code
+      quantile_pred(matrix(1:20, 5), -1:4 / 5)
+    Condition
+      Error in `quantile_pred()`:
+      ! `quantile_levels` must be a number between 0 and 1, not the number -0.2.
+
+---
+
+    Code
+      quantile_pred(matrix(1:20, 5), 1:5 / 6)
+    Condition
+      Error in `quantile_pred()`:
+      ! The number of columns in `values` must be equal to the length of `quantile_levels`.
+
+---
+
+    Code
+      quantile_pred(matrix(1:20, 5), 4:1 / 5)
+    Condition
+      Error in `quantile_pred()`:
+      ! `quantile_levels` must be sorted in increasing order.
+
+# quantile_pred formatting
+
+    Code
+      v
+    Output
+      <quantiles[5]>
+      [1] [8.5]  [9.5]  [10.5] [11.5] [12.5]
+      # Quantile levels:  0.2 0.4 0.6 0.8 
+
+---
+
+    Code
+      quantile_pred(matrix(1:18, 9), c(1 / 3, 2 / 3))
+    Output
+      <quantiles[9]>
+      [1] [5.5]  [6.5]  [7.5]  [8.5]  [9.5]  [10.5] [11.5] [12.5] [13.5]
+      # Quantile levels:  0.333 0.667 
+
+---
+
+    Code
+      quantile_pred(matrix(seq(0.01, 1 - 0.01, length.out = 6), 3), c(0.2, 0.8))
+    Output
+      <quantiles[3]>
+      [1] [0.304] [0.5]   [0.696]
+      # Quantile levels:  0.2 0.8 
+
+---
+
+    Code
+      tibble(qntls = v)
+    Output
+      # A tibble: 5 x 1
+            qntls
+        <qtls(4)>
+      1     [8.5]
+      2     [9.5]
+      3    [10.5]
+      4    [11.5]
+      5    [12.5]
+
+---
+
+    Code
+      quantile_pred(m, 1:4 / 5)
+    Output
+      <quantiles[5]>
+      [1] [8.5]  [9.5]  [10.5] [11.5] [12.5]
+      # Quantile levels:  0.2 0.4 0.6 0.8 
+
+---
+
+    Code
+      one_quantile
+    Output
+      <quantiles[5]>
+      [1] 1 2 3 4 5
+      # Quantile levels:  0.556 
+
+---
+
+    Code
+      tibble(qntls = one_quantile)
+    Output
+      # A tibble: 5 x 1
+           qntls
+        <qtl(1)>
+      1        1
+      2        2
+      3        3
+      4        4
+      5        5
+
+---
+
+    Code
+      quantile_pred(m, 5 / 9)
+    Output
+      <quantiles[5]>
+      [1]  1 NA  3  4  5
+      # Quantile levels:  0.556 
+

From cae06331a1e095f72d71f18d243fef84efe025fd Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 21:55:47 +0100
Subject: [PATCH 07/29] #259 already claimed `.9001`

---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index a5d508ed..0e910dc5 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: hardhat
 Title: Construct Modeling Packages
-Version: 1.4.0.9001
+Version: 1.4.0.9002
 Authors@R: c(
     person("Hannah", "Frick", , "hannah@posit.co", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-6049-5258")),

From b18861e73e4a7857105ea71268b048aa4858b48b Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 21:57:03 +0100
Subject: [PATCH 08/29] tidy style

---
 R/quantile-pred.R | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index e51cb5fc..ae732fec 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -159,8 +159,11 @@ check_vector_probability <- function(x, ...,
                                      call = caller_env()) {
   for (d in x) {
     check_number_decimal(
-      d, min = 0, max = 1,
-      arg = arg, call = call,
+      d, 
+      min = 0,
+      max = 1,
+      arg = arg,
+      call = call,
       allow_na = allow_na,
       allow_null = allow_null,
       allow_infinite = FALSE

From a8c935546d93afc3c4d5da7efc53deb5be7c6b64 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 22:01:17 +0100
Subject: [PATCH 09/29] change styling to class and test

---
 R/quantile-pred.R                      |  2 +-
 tests/testthat/_snaps/quantile-pred.md |  8 ++++++++
 tests/testthat/test-quantile-pred.R    | 10 ++++++++++
 3 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index ae732fec..00ab855d 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -199,7 +199,7 @@ restructure_rq_pred <- function(x, object) {
 #' @rdname quantile_pred
 extract_quantile_levels <- function(x) {
   if (!inherits(x, "quantile_pred")) {
-    cli::cli_abort("{.arg x} should have class {.val quantile_pred}.")
+    cli::cli_abort("{.arg x} should have class {.cls quantile_pred}.")
   }
   attr(x, "quantile_levels")
 }
diff --git a/tests/testthat/_snaps/quantile-pred.md b/tests/testthat/_snaps/quantile-pred.md
index 0925f61d..b8929b19 100644
--- a/tests/testthat/_snaps/quantile-pred.md
+++ b/tests/testthat/_snaps/quantile-pred.md
@@ -30,6 +30,14 @@
       Error in `quantile_pred()`:
       ! `quantile_levels` must be sorted in increasing order.
 
+# extract_quantile_levels
+
+    Code
+      extract_quantile_levels(1:10)
+    Condition
+      Error in `extract_quantile_levels()`:
+      ! `x` should have class <quantile_pred>.
+
 # quantile_pred formatting
 
     Code
diff --git a/tests/testthat/test-quantile-pred.R b/tests/testthat/test-quantile-pred.R
index cdf71aa7..eebb29f3 100644
--- a/tests/testthat/test-quantile-pred.R
+++ b/tests/testthat/test-quantile-pred.R
@@ -27,6 +27,16 @@ test_that("quantile_pred outputs", {
   )
 })
 
+test_that("extract_quantile_levels", {
+  v <- quantile_pred(matrix(1:20, 5), 1:4 / 5)
+  expect_identical(extract_quantile_levels(v), 1:4 / 5)
+
+  expect_snapshot(
+    error = TRUE,
+    extract_quantile_levels(1:10)
+  )
+})
+
 test_that("quantile_pred formatting", {
   # multiple quantiles
   v <- quantile_pred(matrix(1:20, 5), 1:4 / 5)

From 754e385d5c5faeb7e9d599bc689191ccdcb912cf Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 22:06:12 +0100
Subject: [PATCH 10/29] add test for `as.matrix()` to illustrate current
 behavior

---
 tests/testthat/test-quantile-pred.R | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/tests/testthat/test-quantile-pred.R b/tests/testthat/test-quantile-pred.R
index eebb29f3..d123e04c 100644
--- a/tests/testthat/test-quantile-pred.R
+++ b/tests/testthat/test-quantile-pred.R
@@ -67,3 +67,10 @@ test_that("as_tibble() for quantile_pred", {
   expect_named(tbl, c(".pred_quantile", ".quantile_levels", ".row"))
   expect_true(nrow(tbl) == 20)
 })
+
+test_that("as.matrix() for quantile_pred", {
+  v <- quantile_pred(matrix(1:20, 5), 1:4 / 5)
+  m <- as.matrix(v)
+  expect_true(is.matrix(m))
+  expect_identical(m, matrix(1:20, 5))
+})

From 100ddcbf2ffba280e405869db8cfa46eb77365e1 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 22:07:35 +0100
Subject: [PATCH 11/29] move constructor

---
 R/quantile-pred.R | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index 00ab855d..cb5d79c3 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -40,13 +40,6 @@ vec_ptype_abbr.quantile_pred <- function(x, ...) {
 #' @export
 vec_ptype_full.quantile_pred <- function(x, ...) "quantiles"
 
-new_quantile_pred <- function(values = list(), quantile_levels = double()) {
-  quantile_levels <- vctrs::vec_cast(quantile_levels, double())
-  vctrs::new_vctr(
-    values, quantile_levels = quantile_levels, class = "quantile_pred"
-  )
-}
-
 #' Create a vector containing sets of quantiles
 #'
 #' [quantile_pred()] is a special vector class used to efficiently store
@@ -102,6 +95,13 @@ quantile_pred <- function(values, quantile_levels = double()) {
   new_quantile_pred(values, quantile_levels)
 }
 
+new_quantile_pred <- function(values = list(), quantile_levels = double()) {
+  quantile_levels <- vctrs::vec_cast(quantile_levels, double())
+  vctrs::new_vctr(
+    values, quantile_levels = quantile_levels, class = "quantile_pred"
+  )
+}
+
 check_quantile_pred_inputs <- function(values, levels, call = caller_env()) {
   if (any(is.na(levels))) {
     cli::cli_abort("Missing values are not allowed in {.arg quantile_levels}.",

From 89d98d199acbf19da89fd6389722a4e49ed3dc87 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 22:10:07 +0100
Subject: [PATCH 12/29] group vctrs methods

---
 R/quantile-pred.R | 35 ++++++++++++++++++-----------------
 1 file changed, 18 insertions(+), 17 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index cb5d79c3..dcf45ac7 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -22,23 +22,6 @@ check_quantile_level <- function(x, object, call) {
 # -------------------------------------------------------------------------
 # A column vector of quantiles with an attribute
 
-#' @importFrom vctrs vec_ptype_abbr
-#' @export
-vctrs::vec_ptype_abbr
-
-#' @importFrom vctrs vec_ptype_full
-#' @export
-vctrs::vec_ptype_full
-
-
-#' @export
-vec_ptype_abbr.quantile_pred <- function(x, ...) {
-  n_lvls <- length(attr(x, "quantile_levels"))
-  cli::format_inline("qtl{?s}({n_lvls})")
-}
-
-#' @export
-vec_ptype_full.quantile_pred <- function(x, ...) "quantiles"
 
 #' Create a vector containing sets of quantiles
 #'
@@ -142,6 +125,24 @@ format.quantile_pred <- function(x, ...) {
   out
 }
 
+#' @importFrom vctrs vec_ptype_abbr
+#' @export
+vctrs::vec_ptype_abbr
+
+#' @importFrom vctrs vec_ptype_full
+#' @export
+vctrs::vec_ptype_full
+
+
+#' @export
+vec_ptype_abbr.quantile_pred <- function(x, ...) {
+  n_lvls <- length(attr(x, "quantile_levels"))
+  cli::format_inline("qtl{?s}({n_lvls})")
+}
+
+#' @export
+vec_ptype_full.quantile_pred <- function(x, ...) "quantiles"
+
 #' @importFrom vctrs obj_print_footer
 #' @export
 vctrs::obj_print_footer

From 9ab5809cb2e408764aeb1b922e8097937b58e8d5 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 22:14:26 +0100
Subject: [PATCH 13/29] group checking functions together

---
 R/quantile-pred.R | 38 ++++++++++++++++++++------------------
 1 file changed, 20 insertions(+), 18 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index dcf45ac7..fa18a073 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -108,6 +108,25 @@ check_quantile_pred_inputs <- function(values, levels, call = caller_env()) {
   invisible(NULL)
 }
 
+check_vector_probability <- function(x, ...,
+                                     allow_na = FALSE,
+                                     allow_null = FALSE,
+                                     arg = caller_arg(x),
+                                     call = caller_env()) {
+  for (d in x) {
+    check_number_decimal(
+      d, 
+      min = 0,
+      max = 1,
+      arg = arg,
+      call = call,
+      allow_na = allow_na,
+      allow_null = allow_null,
+      allow_infinite = FALSE
+    )
+  }
+}
+
 #' @export
 format.quantile_pred <- function(x, ...) {
   quantile_levels <- attr(x, "quantile_levels")
@@ -153,24 +172,7 @@ obj_print_footer.quantile_pred <- function(x, digits = 3, ...) {
   cat("# Quantile levels: ", format(lvls, digits = digits), "\n", sep = " ")
 }
 
-check_vector_probability <- function(x, ...,
-                                     allow_na = FALSE,
-                                     allow_null = FALSE,
-                                     arg = caller_arg(x),
-                                     call = caller_env()) {
-  for (d in x) {
-    check_number_decimal(
-      d, 
-      min = 0,
-      max = 1,
-      arg = arg,
-      call = call,
-      allow_na = allow_na,
-      allow_null = allow_null,
-      allow_infinite = FALSE
-    )
-  }
-}
+
 
 #' @export
 median.quantile_pred <- function(x, ...) {

From 26bc32755bb015bf67544aa7887c896fa260744d Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 22:16:10 +0100
Subject: [PATCH 14/29] move up functions which are placed on the main help
 page

---
 R/quantile-pred.R | 61 +++++++++++++++++++++++------------------------
 1 file changed, 30 insertions(+), 31 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index fa18a073..f1eda875 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -127,6 +127,36 @@ check_vector_probability <- function(x, ...,
   }
 }
 
+#' @export
+#' @rdname quantile_pred
+extract_quantile_levels <- function(x) {
+  if (!inherits(x, "quantile_pred")) {
+    cli::cli_abort("{.arg x} should have class {.cls quantile_pred}.")
+  }
+  attr(x, "quantile_levels")
+}
+
+#' @export
+#' @rdname quantile_pred
+as_tibble.quantile_pred <-
+  function (x, ..., .rows = NULL, .name_repair = "minimal", rownames = NULL) {
+    lvls <- attr(x, "quantile_levels")
+    n_samp <- length(x)
+    n_quant <- length(lvls)
+    tibble::new_tibble(list(
+      .pred_quantile = unlist(x),
+      .quantile_levels = rep(lvls, n_samp),
+      .row = rep(1:n_samp, each = n_quant)
+    ))
+  }
+
+#' @export
+#' @rdname quantile_pred
+as.matrix.quantile_pred <- function(x, ...) {
+  num_samp <- length(x)
+  matrix(unlist(x), nrow = num_samp)
+}
+
 #' @export
 format.quantile_pred <- function(x, ...) {
   quantile_levels <- attr(x, "quantile_levels")
@@ -152,7 +182,6 @@ vctrs::vec_ptype_abbr
 #' @export
 vctrs::vec_ptype_full
 
-
 #' @export
 vec_ptype_abbr.quantile_pred <- function(x, ...) {
   n_lvls <- length(attr(x, "quantile_levels"))
@@ -197,33 +226,3 @@ restructure_rq_pred <- function(x, object) {
 
   tibble::new_tibble(x = list(.pred_quantile = quantile_pred(x, quantile_level)))
 }
-
-#' @export
-#' @rdname quantile_pred
-extract_quantile_levels <- function(x) {
-  if (!inherits(x, "quantile_pred")) {
-    cli::cli_abort("{.arg x} should have class {.cls quantile_pred}.")
-  }
-  attr(x, "quantile_levels")
-}
-
-#' @export
-#' @rdname quantile_pred
-as_tibble.quantile_pred <-
-  function (x, ..., .rows = NULL, .name_repair = "minimal", rownames = NULL) {
-    lvls <- attr(x, "quantile_levels")
-    n_samp <- length(x)
-    n_quant <- length(lvls)
-    tibble::new_tibble(list(
-      .pred_quantile = unlist(x),
-      .quantile_levels = rep(lvls, n_samp),
-      .row = rep(1:n_samp, each = n_quant)
-    ))
-  }
-
-#' @export
-#' @rdname quantile_pred
-as.matrix.quantile_pred <- function(x, ...) {
-  num_samp <- length(x)
-  matrix(unlist(x), nrow = num_samp)
-}

From 09799853da7c38f541ce152949fecced97efc13f Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 22:17:18 +0100
Subject: [PATCH 15/29] group remaining methods

---
 R/quantile-pred.R | 28 +++++++++++++---------------
 1 file changed, 13 insertions(+), 15 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index f1eda875..551df4cd 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -174,6 +174,19 @@ format.quantile_pred <- function(x, ...) {
   out
 }
 
+#' @export
+median.quantile_pred <- function(x, ...) {
+  lvls <- attr(x, "quantile_levels")
+  loc_median <- (abs(lvls - 0.5) < sqrt(.Machine$double.eps))
+  if (any(loc_median)) {
+    return(map_dbl(x, ~ .x[min(which(loc_median))]))
+  }
+  if (length(lvls) < 2 || min(lvls) > 0.5 || max(lvls) < 0.5) {
+    return(rep(NA, vctrs::vec_size(x)))
+  }
+  map_dbl(x, ~ stats::approx(lvls, .x, xout = 0.5)$y)
+}
+
 #' @importFrom vctrs vec_ptype_abbr
 #' @export
 vctrs::vec_ptype_abbr
@@ -201,21 +214,6 @@ obj_print_footer.quantile_pred <- function(x, digits = 3, ...) {
   cat("# Quantile levels: ", format(lvls, digits = digits), "\n", sep = " ")
 }
 
-
-
-#' @export
-median.quantile_pred <- function(x, ...) {
-  lvls <- attr(x, "quantile_levels")
-  loc_median <- (abs(lvls - 0.5) < sqrt(.Machine$double.eps))
-  if (any(loc_median)) {
-    return(map_dbl(x, ~ .x[min(which(loc_median))]))
-  }
-  if (length(lvls) < 2 || min(lvls) > 0.5 || max(lvls) < 0.5) {
-    return(rep(NA, vctrs::vec_size(x)))
-  }
-  map_dbl(x, ~ stats::approx(lvls, .x, xout = 0.5)$y)
-}
-
 restructure_rq_pred <- function(x, object) {
   if (!is.matrix(x)) {
     x <- as.matrix(x)

From c8c4230db3a3067d7a29acc80bcf3ba9ccef44f7 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 16 Sep 2024 22:20:56 +0100
Subject: [PATCH 16/29] move unused check function with others for visibility

---
 R/quantile-pred.R | 43 ++++++++++++++++++-------------------------
 1 file changed, 18 insertions(+), 25 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index 551df4cd..bc99425f 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -1,28 +1,3 @@
-# Helpers for quantile regression models
-
-check_quantile_level <- function(x, object, call) {
-  if (object$mode != "quantile regression") {
-    return(invisible(TRUE))
-  } else {
-    if (is.null(x)) {
-      cli::cli_abort("In {.fn check_mode}, at least one value of
-      {.arg quantile_level} must be specified for quantile regression models.")
-    }
-  }
-  if (any(is.na(x))) {
-    cli::cli_abort("Missing values are not allowed in {.arg quantile_levels}.",
-                   call = call)
-  }
-  x <- sort(unique(x))
-  check_vector_probability(x, arg = "quantile_level", call = call)
-  x
-}
-
-
-# -------------------------------------------------------------------------
-# A column vector of quantiles with an attribute
-
-
 #' Create a vector containing sets of quantiles
 #'
 #' [quantile_pred()] is a special vector class used to efficiently store
@@ -127,6 +102,24 @@ check_vector_probability <- function(x, ...,
   }
 }
 
+check_quantile_level <- function(x, object, call) {
+  if (object$mode != "quantile regression") {
+    return(invisible(TRUE))
+  } else {
+    if (is.null(x)) {
+      cli::cli_abort("In {.fn check_mode}, at least one value of
+      {.arg quantile_level} must be specified for quantile regression models.")
+    }
+  }
+  if (any(is.na(x))) {
+    cli::cli_abort("Missing values are not allowed in {.arg quantile_levels}.",
+                   call = call)
+  }
+  x <- sort(unique(x))
+  check_vector_probability(x, arg = "quantile_level", call = call)
+  x
+}
+
 #' @export
 #' @rdname quantile_pred
 extract_quantile_levels <- function(x) {

From db0e1a507f233bbcd64aa4e52a85f18cfa36a006 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Tue, 17 Sep 2024 19:26:44 -0400
Subject: [PATCH 17/29] fix typo

---
 R/quantile-pred.R    | 4 ++--
 man/quantile_pred.Rd | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index bc99425f..fa463b2d 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -19,7 +19,7 @@
 #'   * [extract_quantile_levels()] returns a numeric vector of levels.
 #'   * [as_tibble()] returns a tibble with rows `".pred_quantile"`,
 #'   `".quantile_levels"`, and `".row"`.
-#'   * [as.matrix()] returns an unnamed matrix with rows as sames, columns as
+#'   * [as.matrix()] returns an unnamed matrix with rows as samples, columns as
 #'   quantile levels, and entries are predictions.
 #' @examples
 #' .pred_quantile <- quantile_pred(matrix(rnorm(20), 5), c(.2, .4, .6, .8))
@@ -90,7 +90,7 @@ check_vector_probability <- function(x, ...,
                                      call = caller_env()) {
   for (d in x) {
     check_number_decimal(
-      d, 
+      d,
       min = 0,
       max = 1,
       arg = arg,
diff --git a/man/quantile_pred.Rd b/man/quantile_pred.Rd
index d36b73e8..b73166a3 100644
--- a/man/quantile_pred.Rd
+++ b/man/quantile_pred.Rd
@@ -35,7 +35,7 @@ quantile levels.
 \item \code{\link[=extract_quantile_levels]{extract_quantile_levels()}} returns a numeric vector of levels.
 \item \code{\link[=as_tibble]{as_tibble()}} returns a tibble with rows \code{".pred_quantile"},
 \code{".quantile_levels"}, and \code{".row"}.
-\item \code{\link[=as.matrix]{as.matrix()}} returns an unnamed matrix with rows as sames, columns as
+\item \code{\link[=as.matrix]{as.matrix()}} returns an unnamed matrix with rows as samples, columns as
 quantile levels, and entries are predictions.
 }
 }

From 9a659ef476783134b913bea0841b38a056ba0586 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Tue, 17 Sep 2024 19:27:04 -0400
Subject: [PATCH 18/29] remove function for parsnip's set_mode()

---
 R/quantile-pred.R | 18 ------------------
 1 file changed, 18 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index fa463b2d..6207821b 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -102,24 +102,6 @@ check_vector_probability <- function(x, ...,
   }
 }
 
-check_quantile_level <- function(x, object, call) {
-  if (object$mode != "quantile regression") {
-    return(invisible(TRUE))
-  } else {
-    if (is.null(x)) {
-      cli::cli_abort("In {.fn check_mode}, at least one value of
-      {.arg quantile_level} must be specified for quantile regression models.")
-    }
-  }
-  if (any(is.na(x))) {
-    cli::cli_abort("Missing values are not allowed in {.arg quantile_levels}.",
-                   call = call)
-  }
-  x <- sort(unique(x))
-  check_vector_probability(x, arg = "quantile_level", call = call)
-  x
-}
-
 #' @export
 #' @rdname quantile_pred
 extract_quantile_levels <- function(x) {

From 30de46fb5a00475766a07dd8359133d24240b4b4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Tue, 17 Sep 2024 19:32:19 -0400
Subject: [PATCH 19/29] remove test helpers

---
 tests/testthat/helper-data.R | 14 --------------
 1 file changed, 14 deletions(-)
 delete mode 100644 tests/testthat/helper-data.R

diff --git a/tests/testthat/helper-data.R b/tests/testthat/helper-data.R
deleted file mode 100644
index f38183ac..00000000
--- a/tests/testthat/helper-data.R
+++ /dev/null
@@ -1,14 +0,0 @@
-# ------------------------------------------------------------------------------
-# for quantile regression tests
-
-library(modeldata)
-
-data("Sacramento")
-
-cols <- c("price", "beds", "baths", "sqft", "latitude", "longitude")
-Sacramento_small <- modeldata::Sacramento
-Sacramento_small$price <- log10(Sacramento_small$price)
-Sacramento_small <- Sacramento_small[, cols]
-
-sac_train <- Sacramento_small[-(1:5), ]
-sac_test  <- Sacramento_small[  1:5 , ]

From 9dc4b12d04fa4421f788da7e869313760f7b562c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Tue, 17 Sep 2024 19:39:58 -0400
Subject: [PATCH 20/29] remove functions for restructuring

---
 R/quantile-pred.R | 11 -----------
 1 file changed, 11 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index 6207821b..4dc23c39 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -188,14 +188,3 @@ obj_print_footer.quantile_pred <- function(x, digits = 3, ...) {
   lvls <- attr(x, "quantile_levels")
   cat("# Quantile levels: ", format(lvls, digits = digits), "\n", sep = " ")
 }
-
-restructure_rq_pred <- function(x, object) {
-  if (!is.matrix(x)) {
-    x <- as.matrix(x)
-  }
-  rownames(x) <- NULL
-  n_pred_quantiles <- ncol(x)
-  quantile_level <- object$spec$quantile_level
-
-  tibble::new_tibble(x = list(.pred_quantile = quantile_pred(x, quantile_level)))
-}

From dfe8288abb8bfcb38d05682926f72f15a53d03ff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Tue, 17 Sep 2024 19:56:19 -0400
Subject: [PATCH 21/29] remove range code; add digits argument

---
 R/quantile-pred.R                      | 11 ++++-------
 tests/testthat/_snaps/quantile-pred.md | 14 ++++++++++++++
 tests/testthat/test-quantile-pred.R    |  5 +++++
 3 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index 4dc23c39..56ac287b 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -133,18 +133,15 @@ as.matrix.quantile_pred <- function(x, ...) {
 }
 
 #' @export
-format.quantile_pred <- function(x, ...) {
+format.quantile_pred <- function(x, digits = 3L, ...) {
   quantile_levels <- attr(x, "quantile_levels")
   if (length(quantile_levels) == 1L) {
     x <- unlist(x)
-    out <- round(x, 3L)
+    out <- signif(x, digits = digits)
     out[is.na(x)] <- NA_real_
   } else {
-    rng <- sapply(x, range, na.rm = TRUE)
-    out <- paste0("[", round(rng[1, ], 3L), ", ", round(rng[2, ], 3L), "]")
-    out[is.na(rng[1, ]) & is.na(rng[2, ])] <- NA_character_
-    m <- median(x)
-    out <- paste0("[", round(m, 3L), "]")
+    m <- median(x, na.rm = TRUE)
+    out <- paste0("[", signif(m, digits = digits), "]")
   }
   out
 }
diff --git a/tests/testthat/_snaps/quantile-pred.md b/tests/testthat/_snaps/quantile-pred.md
index b8929b19..c98d7b6e 100644
--- a/tests/testthat/_snaps/quantile-pred.md
+++ b/tests/testthat/_snaps/quantile-pred.md
@@ -120,3 +120,17 @@
       [1]  1 NA  3  4  5
       # Quantile levels:  0.556 
 
+---
+
+    Code
+      format(v)
+    Output
+      [1] "[1.72]"  "[0.568]" "[1.24]"  "[2.21]"  "[0.767]"
+
+---
+
+    Code
+      format(v, digits = 5)
+    Output
+      [1] "[1.7154]"  "[0.56784]" "[1.2393]"  "[2.2062]"  "[0.76714]"
+
diff --git a/tests/testthat/test-quantile-pred.R b/tests/testthat/test-quantile-pred.R
index d123e04c..5dc8c1a5 100644
--- a/tests/testthat/test-quantile-pred.R
+++ b/tests/testthat/test-quantile-pred.R
@@ -58,6 +58,11 @@ test_that("quantile_pred formatting", {
   expect_snapshot(tibble(qntls = one_quantile))
   m[2] <- NA
   expect_snapshot(quantile_pred(m, 5/9))
+
+  set.seed(393)
+  v <- quantile_pred(matrix(exp(rnorm(20)), ncol = 4), 1:4 / 5)
+  expect_snapshot(format(v))
+  expect_snapshot(format(v, digits = 5))
 })
 
 test_that("as_tibble() for quantile_pred", {

From 7d6c4e21202c70834c2b1a45a30eb3421fd3534d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Tue, 17 Sep 2024 19:57:46 -0400
Subject: [PATCH 22/29] fix as.matrix method

---
 R/quantile-pred.R                   | 2 +-
 tests/testthat/test-quantile-pred.R | 5 +++--
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index 56ac287b..fadcfdd1 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -129,7 +129,7 @@ as_tibble.quantile_pred <-
 #' @rdname quantile_pred
 as.matrix.quantile_pred <- function(x, ...) {
   num_samp <- length(x)
-  matrix(unlist(x), nrow = num_samp)
+  matrix(unlist(x), nrow = num_samp, byrow = TRUE)
 }
 
 #' @export
diff --git a/tests/testthat/test-quantile-pred.R b/tests/testthat/test-quantile-pred.R
index 5dc8c1a5..81bdf7b9 100644
--- a/tests/testthat/test-quantile-pred.R
+++ b/tests/testthat/test-quantile-pred.R
@@ -74,8 +74,9 @@ test_that("as_tibble() for quantile_pred", {
 })
 
 test_that("as.matrix() for quantile_pred", {
-  v <- quantile_pred(matrix(1:20, 5), 1:4 / 5)
+  x <- matrix(1:20, 5)
+  v <- quantile_pred(x, 1:4 / 5)
   m <- as.matrix(v)
   expect_true(is.matrix(m))
-  expect_identical(m, matrix(1:20, 5))
+  expect_identical(m, x)
 })

From d0444bdae0fbc42b9f1b9a21f2d34aaa9c7710d8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Tue, 17 Sep 2024 20:05:03 -0400
Subject: [PATCH 23/29] remove  @importFrom

---
 R/quantile-pred.R | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index fadcfdd1..79d15e5b 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -159,11 +159,9 @@ median.quantile_pred <- function(x, ...) {
   map_dbl(x, ~ stats::approx(lvls, .x, xout = 0.5)$y)
 }
 
-#' @importFrom vctrs vec_ptype_abbr
 #' @export
 vctrs::vec_ptype_abbr
 
-#' @importFrom vctrs vec_ptype_full
 #' @export
 vctrs::vec_ptype_full
 
@@ -176,7 +174,6 @@ vec_ptype_abbr.quantile_pred <- function(x, ...) {
 #' @export
 vec_ptype_full.quantile_pred <- function(x, ...) "quantiles"
 
-#' @importFrom vctrs obj_print_footer
 #' @export
 vctrs::obj_print_footer
 

From c5972148dd07a42f9e71fc0c05f6365f1e22e441 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Wed, 18 Sep 2024 10:52:18 +0100
Subject: [PATCH 24/29] don't re-export vctrs generics

---
 NAMESPACE         |  6 ------
 R/quantile-pred.R |  9 ---------
 man/reexports.Rd  | 18 ------------------
 3 files changed, 33 deletions(-)
 delete mode 100644 man/reexports.Rd

diff --git a/NAMESPACE b/NAMESPACE
index a69acc29..1ee97fe9 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -106,7 +106,6 @@ export(new_importance_weights)
 export(new_model)
 export(new_recipe_blueprint)
 export(new_xy_blueprint)
-export(obj_print_footer)
 export(quantile_pred)
 export(recompose)
 export(refresh_blueprint)
@@ -133,8 +132,6 @@ export(validate_outcomes_are_numeric)
 export(validate_outcomes_are_univariate)
 export(validate_prediction_size)
 export(validate_predictors_are_numeric)
-export(vec_ptype_abbr)
-export(vec_ptype_full)
 export(weighted_table)
 import(rlang)
 import(vctrs)
@@ -147,6 +144,3 @@ importFrom(stats,model.matrix)
 importFrom(stats,terms)
 importFrom(tibble,as_tibble)
 importFrom(tibble,tibble)
-importFrom(vctrs,obj_print_footer)
-importFrom(vctrs,vec_ptype_abbr)
-importFrom(vctrs,vec_ptype_full)
diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index 79d15e5b..6ab5fc75 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -159,12 +159,6 @@ median.quantile_pred <- function(x, ...) {
   map_dbl(x, ~ stats::approx(lvls, .x, xout = 0.5)$y)
 }
 
-#' @export
-vctrs::vec_ptype_abbr
-
-#' @export
-vctrs::vec_ptype_full
-
 #' @export
 vec_ptype_abbr.quantile_pred <- function(x, ...) {
   n_lvls <- length(attr(x, "quantile_levels"))
@@ -174,9 +168,6 @@ vec_ptype_abbr.quantile_pred <- function(x, ...) {
 #' @export
 vec_ptype_full.quantile_pred <- function(x, ...) "quantiles"
 
-#' @export
-vctrs::obj_print_footer
-
 #' @export
 obj_print_footer.quantile_pred <- function(x, digits = 3, ...) {
   lvls <- attr(x, "quantile_levels")
diff --git a/man/reexports.Rd b/man/reexports.Rd
deleted file mode 100644
index b3f7c333..00000000
--- a/man/reexports.Rd
+++ /dev/null
@@ -1,18 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/quantile-pred.R
-\docType{import}
-\name{reexports}
-\alias{reexports}
-\alias{vec_ptype_abbr}
-\alias{vec_ptype_full}
-\alias{obj_print_footer}
-\title{Objects exported from other packages}
-\keyword{internal}
-\description{
-These objects are imported from other packages. Follow the links
-below to see their documentation.
-
-\describe{
-  \item{vctrs}{\code{\link[vctrs:obj_print]{obj_print_footer}}, \code{\link[vctrs:vec_ptype_full]{vec_ptype_abbr}}, \code{\link[vctrs]{vec_ptype_full}}}
-}}
-

From 9006d02e6e6145c06d0feefa0a6ef9a40f9c955f Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Wed, 18 Sep 2024 11:36:26 +0100
Subject: [PATCH 25/29] add pluralization to `obj_print_footer()` method

---
 R/quantile-pred.R                      |  3 ++-
 tests/testthat/_snaps/quantile-pred.md | 12 ++++++------
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index 6ab5fc75..fc7e3793 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -171,5 +171,6 @@ vec_ptype_full.quantile_pred <- function(x, ...) "quantiles"
 #' @export
 obj_print_footer.quantile_pred <- function(x, digits = 3, ...) {
   lvls <- attr(x, "quantile_levels")
-  cat("# Quantile levels: ", format(lvls, digits = digits), "\n", sep = " ")
+  footer <- cli::format_inline("# Quantile {cli::qty(length(lvls))}level{?s}:")
+  cat(footer, format(lvls, digits = digits), "\n", sep = " ")
 }
diff --git a/tests/testthat/_snaps/quantile-pred.md b/tests/testthat/_snaps/quantile-pred.md
index c98d7b6e..a7db194b 100644
--- a/tests/testthat/_snaps/quantile-pred.md
+++ b/tests/testthat/_snaps/quantile-pred.md
@@ -45,7 +45,7 @@
     Output
       <quantiles[5]>
       [1] [8.5]  [9.5]  [10.5] [11.5] [12.5]
-      # Quantile levels:  0.2 0.4 0.6 0.8 
+      # Quantile levels: 0.2 0.4 0.6 0.8 
 
 ---
 
@@ -54,7 +54,7 @@
     Output
       <quantiles[9]>
       [1] [5.5]  [6.5]  [7.5]  [8.5]  [9.5]  [10.5] [11.5] [12.5] [13.5]
-      # Quantile levels:  0.333 0.667 
+      # Quantile levels: 0.333 0.667 
 
 ---
 
@@ -63,7 +63,7 @@
     Output
       <quantiles[3]>
       [1] [0.304] [0.5]   [0.696]
-      # Quantile levels:  0.2 0.8 
+      # Quantile levels: 0.2 0.8 
 
 ---
 
@@ -86,7 +86,7 @@
     Output
       <quantiles[5]>
       [1] [8.5]  [9.5]  [10.5] [11.5] [12.5]
-      # Quantile levels:  0.2 0.4 0.6 0.8 
+      # Quantile levels: 0.2 0.4 0.6 0.8 
 
 ---
 
@@ -95,7 +95,7 @@
     Output
       <quantiles[5]>
       [1] 1 2 3 4 5
-      # Quantile levels:  0.556 
+      # Quantile level: 0.556 
 
 ---
 
@@ -118,7 +118,7 @@
     Output
       <quantiles[5]>
       [1]  1 NA  3  4  5
-      # Quantile levels:  0.556 
+      # Quantile level: 0.556 
 
 ---
 

From fbed1c1e6ca456ca2f523bd5944fc05fa6610e5a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E2=80=98topepo=E2=80=99?= <‘mxkuhn@gmail.com’>
Date: Mon, 23 Sep 2024 06:08:23 -0400
Subject: [PATCH 26/29] refactor inout checks

---
 NAMESPACE                    |   1 +
 R/quantile-pred.R            | 128 +++++++++++++++++++++--------------
 man/check_quantile_levels.Rd |  23 +++++++
 3 files changed, 101 insertions(+), 51 deletions(-)
 create mode 100644 man/check_quantile_levels.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 1ee97fe9..e3d2995a 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -63,6 +63,7 @@ export(check_outcomes_are_numeric)
 export(check_outcomes_are_univariate)
 export(check_prediction_size)
 export(check_predictors_are_numeric)
+export(check_quantile_levels)
 export(create_modeling_package)
 export(default_formula_blueprint)
 export(default_recipe_blueprint)
diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index fc7e3793..f807656f 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -36,17 +36,10 @@
 #' library(tibble)
 #' as_tibble(.pred_quantile)
 quantile_pred <- function(values, quantile_levels = double()) {
-  check_quantile_pred_inputs(values, quantile_levels)
-
   quantile_levels <- vctrs::vec_cast(quantile_levels, double())
-  num_lvls <- length(quantile_levels)
+  check_quantile_levels(quantile_levels)
+  check_quantile_pred_inputs(values, quantile_levels)
 
-  if (ncol(values) != num_lvls) {
-    cli::cli_abort(
-      "The number of columns in {.arg values} must be equal to the length of
-        {.arg quantile_levels}."
-    )
-  }
   rownames(values) <- NULL
   colnames(values) <- NULL
   values <- lapply(vctrs::vec_chop(values), drop)
@@ -60,48 +53,6 @@ new_quantile_pred <- function(values = list(), quantile_levels = double()) {
   )
 }
 
-check_quantile_pred_inputs <- function(values, levels, call = caller_env()) {
-  if (any(is.na(levels))) {
-    cli::cli_abort("Missing values are not allowed in {.arg quantile_levels}.",
-                   call = call)
-  }
-
-  if (!is.matrix(values)) {
-    cli::cli_abort(
-      "{.arg values} must be a {.cls matrix}, not {.obj_type_friendly {values}}.",
-      call = call
-    )
-  }
-  check_vector_probability(levels, arg = "quantile_levels", call = call)
-
-  if (is.unsorted(levels)) {
-    cli::cli_abort(
-      "{.arg quantile_levels} must be sorted in increasing order.",
-      call = call
-    )
-  }
-  invisible(NULL)
-}
-
-check_vector_probability <- function(x, ...,
-                                     allow_na = FALSE,
-                                     allow_null = FALSE,
-                                     arg = caller_arg(x),
-                                     call = caller_env()) {
-  for (d in x) {
-    check_number_decimal(
-      d,
-      min = 0,
-      max = 1,
-      arg = arg,
-      call = call,
-      allow_na = allow_na,
-      allow_null = allow_null,
-      allow_infinite = FALSE
-    )
-  }
-}
-
 #' @export
 #' @rdname quantile_pred
 extract_quantile_levels <- function(x) {
@@ -174,3 +125,78 @@ obj_print_footer.quantile_pred <- function(x, digits = 3, ...) {
   footer <- cli::format_inline("# Quantile {cli::qty(length(lvls))}level{?s}:")
   cat(footer, format(lvls, digits = digits), "\n", sep = " ")
 }
+
+
+# ------------------------------------------------------------------------------
+# Checking functions
+
+check_quantile_pred_inputs <- function(values, levels, call = caller_env()) {
+  if (!is.matrix(values)) {
+    cli::cli_abort(
+      "{.arg values} must be a {.cls matrix}, not {.obj_type_friendly {values}}.",
+      call = call
+    )
+  }
+
+  num_lvls <- length(levels)
+
+  if (ncol(values) != num_lvls) {
+    cli::cli_abort(
+      "The number of columns in {.arg values} must be equal to the length of
+        {.arg quantile_levels}.", call = call
+    )
+  }
+
+  invisible(TRUE)
+}
+
+#' Check levels of quantiles
+#' @param levels The quantile levels.
+#' @param arg,call Inputs to use to write error messages
+#' @return Invisible `TRUE`
+#' @keywords internal
+#' @details
+#' Checks the levels for their data type, range, uniqueness, orderm and missingness.
+#' @export
+check_quantile_levels <- function(levels, call = rlang::caller_env()) {
+  # data type, range, etc
+  check_quantile_level_values(levels, arg = "quantile_levels", call = call)
+
+  # uniqueness
+  is_dup <- duplicated(levels)
+  if (any(is_dup)) {
+    redund <- levels[is_dup]
+    redund <- signif(redund, digits = 5)
+    cli::cli_abort("Quantile levels should be unique. The following values were
+                   repeated: {redund}.", call = call)
+  }
+
+  # order
+  if (is.unsorted(levels)) {
+    cli::cli_abort(
+      "{.arg quantile_levels} must be sorted in increasing order.",
+      call = call
+    )
+  }
+
+  invisible(TRUE)
+}
+
+check_quantile_level_values <- function(levels, arg, call) {
+  if (is.null(levels)) {
+    cli::cli_abort("{.arg {arg}} cannot be NULL.", call = call)
+  }
+  for (val in levels) {
+    check_number_decimal(
+      val,
+      min = 0,
+      max = 1,
+      arg = arg,
+      call = call,
+      allow_na = FALSE,
+      allow_null = FALSE,
+      allow_infinite = FALSE
+    )
+  }
+  invisible(TRUE)
+}
diff --git a/man/check_quantile_levels.Rd b/man/check_quantile_levels.Rd
new file mode 100644
index 00000000..3d64e750
--- /dev/null
+++ b/man/check_quantile_levels.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/quantile-pred.R
+\name{check_quantile_levels}
+\alias{check_quantile_levels}
+\title{Check levels of quantiles}
+\usage{
+check_quantile_levels(levels, call = rlang::caller_env())
+}
+\arguments{
+\item{levels}{The quantile levels.}
+
+\item{arg, call}{Inputs to use to write error messages}
+}
+\value{
+Invisible \code{TRUE}
+}
+\description{
+Check levels of quantiles
+}
+\details{
+Checks the levels for their data type, range, uniqueness, and missingness.
+}
+\keyword{internal}

From f9808c625cc4ca81a93e1a3ad70fad80e33f33a5 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 23 Sep 2024 14:48:34 +0100
Subject: [PATCH 27/29] fix typo

---
 R/quantile-pred.R            | 2 +-
 man/check_quantile_levels.Rd | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index f807656f..e83455ed 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -156,7 +156,7 @@ check_quantile_pred_inputs <- function(values, levels, call = caller_env()) {
 #' @return Invisible `TRUE`
 #' @keywords internal
 #' @details
-#' Checks the levels for their data type, range, uniqueness, orderm and missingness.
+#' Checks the levels for their data type, range, uniqueness, order and missingness.
 #' @export
 check_quantile_levels <- function(levels, call = rlang::caller_env()) {
   # data type, range, etc
diff --git a/man/check_quantile_levels.Rd b/man/check_quantile_levels.Rd
index 3d64e750..3f258287 100644
--- a/man/check_quantile_levels.Rd
+++ b/man/check_quantile_levels.Rd
@@ -18,6 +18,6 @@ Invisible \code{TRUE}
 Check levels of quantiles
 }
 \details{
-Checks the levels for their data type, range, uniqueness, and missingness.
+Checks the levels for their data type, range, uniqueness, order and missingness.
 }
 \keyword{internal}

From 04525e8adaff733e1e54b39335c1cfca500713ae Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 23 Sep 2024 14:50:15 +0100
Subject: [PATCH 28/29] only show unique values in error

---
 R/quantile-pred.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index e83455ed..e4973c59 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -166,6 +166,7 @@ check_quantile_levels <- function(levels, call = rlang::caller_env()) {
   is_dup <- duplicated(levels)
   if (any(is_dup)) {
     redund <- levels[is_dup]
+    redund <- unique(redund)
     redund <- signif(redund, digits = 5)
     cli::cli_abort("Quantile levels should be unique. The following values were
                    repeated: {redund}.", call = call)

From 480c2ff4eb7f024cef6f657e032c688277f1c860 Mon Sep 17 00:00:00 2001
From: Hannah Frick <hannah@posit.co>
Date: Mon, 23 Sep 2024 14:51:00 +0100
Subject: [PATCH 29/29] add pluralization

---
 R/quantile-pred.R                      | 10 +++++---
 tests/testthat/_snaps/quantile-pred.md | 34 ++++++++++++++++++++++++++
 tests/testthat/test-quantile-pred.R    | 15 ++++++++++++
 3 files changed, 56 insertions(+), 3 deletions(-)

diff --git a/R/quantile-pred.R b/R/quantile-pred.R
index e4973c59..6630357a 100644
--- a/R/quantile-pred.R
+++ b/R/quantile-pred.R
@@ -168,8 +168,12 @@ check_quantile_levels <- function(levels, call = rlang::caller_env()) {
     redund <- levels[is_dup]
     redund <- unique(redund)
     redund <- signif(redund, digits = 5)
-    cli::cli_abort("Quantile levels should be unique. The following values were
-                   repeated: {redund}.", call = call)
+    cli::cli_abort(c(
+      "Quantile levels should be unique.", 
+      i = "The following {cli::qty(length(redund))}value{?s} {?was/were} repeated:
+         {redund}."),
+      call = call
+    )
   }
 
   # order
@@ -185,7 +189,7 @@ check_quantile_levels <- function(levels, call = rlang::caller_env()) {
 
 check_quantile_level_values <- function(levels, arg, call) {
   if (is.null(levels)) {
-    cli::cli_abort("{.arg {arg}} cannot be NULL.", call = call)
+    cli::cli_abort("{.arg {arg}} cannot be {.val NULL}.", call = call)
   }
   for (val in levels) {
     check_number_decimal(
diff --git a/tests/testthat/_snaps/quantile-pred.md b/tests/testthat/_snaps/quantile-pred.md
index a7db194b..2a706946 100644
--- a/tests/testthat/_snaps/quantile-pred.md
+++ b/tests/testthat/_snaps/quantile-pred.md
@@ -30,6 +30,40 @@
       Error in `quantile_pred()`:
       ! `quantile_levels` must be sorted in increasing order.
 
+# quantile levels are checked
+
+    Code
+      quantile_pred(matrix(1:20, 5), quantile_levels = NULL)
+    Condition
+      Error in `quantile_pred()`:
+      ! `quantile_levels` cannot be "NULL".
+
+---
+
+    Code
+      quantile_pred(matrix(1:20, 5), quantile_levels = c(0.7, 0.7, 0.7))
+    Condition
+      Error in `quantile_pred()`:
+      ! Quantile levels should be unique.
+      i The following value was repeated: 0.7.
+
+---
+
+    Code
+      quantile_pred(matrix(1:20, 5), quantile_levels = c(rep(0.7, 2), rep(0.8, 3)))
+    Condition
+      Error in `quantile_pred()`:
+      ! Quantile levels should be unique.
+      i The following values were repeated: 0.7 and 0.8.
+
+---
+
+    Code
+      quantile_pred(matrix(1:20, 5), quantile_levels = c(0.8, 0.7))
+    Condition
+      Error in `quantile_pred()`:
+      ! `quantile_levels` must be sorted in increasing order.
+
 # extract_quantile_levels
 
     Code
diff --git a/tests/testthat/test-quantile-pred.R b/tests/testthat/test-quantile-pred.R
index 81bdf7b9..a18ac570 100644
--- a/tests/testthat/test-quantile-pred.R
+++ b/tests/testthat/test-quantile-pred.R
@@ -17,6 +17,21 @@ test_that("quantile_pred error types", {
   )
 })
 
+test_that("quantile levels are checked", {
+  expect_snapshot(error = TRUE, {
+    quantile_pred(matrix(1:20, 5), quantile_levels = NULL)
+  })
+  expect_snapshot(error = TRUE, {
+    quantile_pred(matrix(1:20, 5), quantile_levels = c(0.7, 0.7, 0.7))   
+  })
+  expect_snapshot(error = TRUE, {
+    quantile_pred(matrix(1:20, 5), quantile_levels = c(rep(0.7, 2), rep(0.8, 3)))    
+  })
+  expect_snapshot(error = TRUE, {
+    quantile_pred(matrix(1:20, 5), quantile_levels = c(0.8, 0.7))    
+  })
+})
+
 test_that("quantile_pred outputs", {
   v <- quantile_pred(matrix(1:20, 5), 1:4 / 5)
   expect_s3_class(v, "quantile_pred")