BOT: Fix #406: Rename get_type() to get_vector_type() and add convenience wrappers

NAMESPACE

@@ -70,8 +70,11 @@ export(get_forecast_counts)
 export(get_forecast_unit)
 export(get_grouping)
 export(get_metrics)
+export(get_observed_type)
 export(get_pairwise_comparisons)
 export(get_pit_histogram)
+export(get_predicted_type)
+export(get_vector_type)
 export(interval_coverage)
 export(is_forecast)
 export(is_forecast_binary)

R/get-forecast-type.R

@@ -43,20 +43,24 @@ assert_forecast_type <- function(data,
 }
 
 
-#' @title Get type of a vector or matrix of observed values or predictions
+#' @title Get type of a vector or matrix
 #'
 #' @description
-#' Internal helper function to get the type of a vector (usually
-#' of observed or predicted values). The function checks whether the input is
-#' a factor, or else whether it is integer (or can be coerced to integer) or
-#' whether it's continuous.
+#' Determine the type of a vector or matrix of values. The function checks
+#' whether the input is a factor (returns "classification"), or else whether it
+#' is integer (or can be coerced to integer without loss, returns "integer") or
+#' whether it's continuous (returns "continuous").
 #' @param x Input the type should be determined for.
 #' @importFrom cli cli_abort
 #' @return
 #' Character vector of length one with either "classification",
 #' "integer", or "continuous".
-#' @keywords internal_input_check
-get_type <- function(x) {
+#' @export
+#' @examples
+#' get_vector_type(1:3)
+#' get_vector_type(c(1.5, 2.3))
+#' get_vector_type(factor(c("a", "b")))
+get_vector_type <- function(x) {
   if (is.factor(x)) {
     return("classification")
   }
@@ -75,3 +79,41 @@ get_type <- function(x) {
     return("continuous")
   }
 }
+
+
+#' @title Get type of the observed values in a forecast object
+#'
+#' @description
+#' Extract the `observed` column from a forecast object and determine its type
+#' using [get_vector_type()].
+#' @inheritParams score
+#' @return
+#' Character vector of length one with either "classification",
+#' "integer", or "continuous".
+#' @export
+#' @examples
+#' get_observed_type(example_sample_continuous)
+#' get_observed_type(example_binary)
+get_observed_type <- function(forecast) {
+  assert_forecast(forecast)
+  get_vector_type(forecast$observed)
+}
+
+
+#' @title Get type of the predicted values in a forecast object
+#'
+#' @description
+#' Extract the `predicted` column from a forecast object and determine its type
+#' using [get_vector_type()].
+#' @inheritParams score
+#' @return
+#' Character vector of length one with either "classification",
+#' "integer", or "continuous".
+#' @export
+#' @examples
+#' get_predicted_type(example_sample_continuous)
+#' get_predicted_type(example_quantile)
+get_predicted_type <- function(forecast) {
+  assert_forecast(forecast)
+  get_vector_type(forecast$predicted)
+}

R/metrics-sample.R

@@ -98,7 +98,7 @@ check_input_sample <- function(observed, predicted) {
 bias_sample <- function(observed, predicted) {
 
   assert_input_sample(observed, predicted)
-  prediction_type <- get_type(predicted)
+  prediction_type <- get_vector_type(predicted)
 
   # empirical cdf
   n_pred <- ncol(predicted)
@@ -558,7 +558,7 @@ pit_histogram_sample <- function(observed,
   p_x <- rowSums(predicted <= observed) / n_pred
 
   # PIT calculation is different for integer and continuous predictions
-  if (get_type(predicted) == "integer" && integers != "ignore") {
+  if (get_vector_type(predicted) == "integer" && integers != "ignore") {
     p_xm1 <- rowSums(predicted <= (observed - 1)) / n_pred
     if (integers == "random") {
       pit_values <- as.vector(
@@ -580,7 +580,7 @@ pit_histogram_sample <- function(observed,
     pit_values <- p_x
   }
 
-  if (get_type(predicted) != "integer" || integers != "nonrandom") {
+  if (get_vector_type(predicted) != "integer" || integers != "nonrandom") {
     pit_histogram <- hist(pit_values, breaks = quantiles, plot = FALSE)$density
   }
 

tests/testthat/test-get-forecast-type.R

@@ -30,41 +30,41 @@
 
 
 # ==============================================================================
-# `get_type()` # nolint: commented_code_linter
+# `get_vector_type()` # nolint: commented_code_linter
 # ==============================================================================
-test_that("get_type() works as expected with vectors", {
-  expect_identical(get_type(1:3), "integer")
-  expect_identical(get_type(factor(1:2)), "classification")
-  expect_identical(get_type(c(1.0, 2)), "integer")
-  expect_identical(get_type(c(1.0, 2.3)), "continuous")
+test_that("get_vector_type() works as expected with vectors", {
+  expect_identical(get_vector_type(1:3), "integer")
+  expect_identical(get_vector_type(factor(1:2)), "classification")
+  expect_identical(get_vector_type(c(1.0, 2)), "integer")
+  expect_identical(get_vector_type(c(1.0, 2.3)), "continuous")
   expect_error(
-    get_type(c("a", "b")),
+    get_vector_type(c("a", "b")),
     "Assertion on 'as.vector(x)' failed: Must be of type 'numeric', not 'character'.",
     fixed = TRUE
   )
 })
 
-test_that("get_type() works as expected with matrices", {
-  expect_identical(get_type(matrix(1:4, nrow = 2)), "integer")
-  expect_identical(get_type(matrix(c(1.0, 2:4))), "integer")
-  expect_identical(get_type(matrix(c(1.0, 2.3, 3, 4))), "continuous")
+test_that("get_vector_type() works as expected with matrices", {
+  expect_identical(get_vector_type(matrix(1:4, nrow = 2)), "integer")
+  expect_identical(get_vector_type(matrix(c(1.0, 2:4))), "integer")
+  expect_identical(get_vector_type(matrix(c(1.0, 2.3, 3, 4))), "continuous")
 
   # matrix of factors doesn't work
   expect_error(
-    get_type(matrix(factor(1:4), nrow = 2)),
+    get_vector_type(matrix(factor(1:4), nrow = 2)),
     "Assertion on 'as.vector(x)' failed: Must be of type 'numeric', not 'character'.",
     fixed = TRUE
   )
 
   expect_error(
-    get_type(matrix(c("a", "b", "c", "d"))),
+    get_vector_type(matrix(c("a", "b", "c", "d"))),
     "Assertion on 'as.vector(x)' failed: Must be of type 'numeric', not 'character'.",
     fixed = TRUE
   )
 })
 
 
-test_that("new `get_type()` is equal to old `prediction_type()", {
+test_that("get_vector_type() is consistent with former get_type()", {
   get_prediction_type <- function(data) {
     if (is.data.frame(data)) {
       data <- data$predicted
@@ -94,13 +94,67 @@
   for (i in seq_along(check_data)) {
     expect_identical(
       get_prediction_type(check_data[[i]]),
-      get_type(check_data[[i]])
+      get_vector_type(check_data[[i]])
     )
   }
 })
 
-test_that("get_type() handles `NA` values", {
-  expect_identical(get_type(c(1, NA, 3)), "integer")
-  expect_identical(get_type(c(1, NA, 3.2)), "continuous")
-  expect_error(get_type(NA), "Can't get type: all values of are \"NA\"")
+test_that("get_vector_type() handles `NA` values", {
+  expect_identical(get_vector_type(c(1, NA, 3)), "integer")
+  expect_identical(get_vector_type(c(1, NA, 3.2)), "continuous")
+  expect_error(get_vector_type(NA), "Can't get type: all values of are \"NA\"")
+})
+
+test_that("get_vector_type() is exported and accessible", {
+  expect_identical(scoringutils::get_vector_type(1:3), "integer")
+})
+
+
+# ==============================================================================
+# `get_observed_type()` # nolint: commented_code_linter
+# ==============================================================================
+test_that("get_observed_type() returns the type of the observed column", {
+  expect_identical(get_observed_type(example_sample_discrete), "integer")
+  expect_identical(get_observed_type(example_binary), "classification")
+  expect_true(get_observed_type(example_sample_continuous) %in%
+    c("integer", "continuous"))
+})
+
+test_that("get_observed_type() errors on non-forecast objects", {
+  df <- data.frame(x = 1:10, y = rnorm(10))
+  expect_error(get_observed_type(df))
+})
+
+test_that("get_observed_type() is exported and accessible", {
+  expect_true(
+    scoringutils::get_observed_type(example_sample_continuous) %in%
+      c("integer", "continuous")
+  )
+})
+
+
+# ==============================================================================
+# `get_predicted_type()` # nolint: commented_code_linter
+# ==============================================================================
+test_that("get_predicted_type() returns the type of the predicted column", {
+  expect_identical(get_predicted_type(example_sample_continuous), "continuous")
+  expect_identical(get_predicted_type(example_sample_discrete), "integer")
+  expect_identical(get_predicted_type(example_binary), "continuous")
+})
+
+test_that("get_predicted_type() errors on non-forecast objects", {
+  df <- data.frame(x = 1:10, y = rnorm(10))
+  expect_error(get_predicted_type(df))
+})
+
+test_that("get_predicted_type() is exported and accessible", {
+  expect_identical(
+    scoringutils::get_predicted_type(example_sample_continuous),
+    "continuous"
+  )
+})
+
+test_that("get_predicted_type() works for quantile forecasts", {
+  expect_true(get_predicted_type(example_quantile) %in%
+    c("integer", "continuous"))
 })