R/is_numeric_values.R

Defines functions is_numeric_values.Raster is_numeric_values.SpatRaster is_numeric_values.sf is_numeric_values.Spatial is_numeric_values.data.frame is_numeric_values.matrix is_numeric_values.Matrix is_numeric_values.numeric is_numeric_values.default is_numeric_values

#' @include internal.R
NULL

#' Is numeric values?
#'
#' Check if an object has numeric values?
#'
#' @param object.
#'
#' @return A `logical` value.
#'
#' @noRd
is_numeric_values <- function(x) UseMethod("is_numeric_values")

assertthat::on_failure(is_numeric_values)  <- function(call, env) {
  paste(deparse(call$x), "has non-numeric values")
}

#' @export
is_numeric_values.default <- function(x) {
  FALSE
}

#' @export
is_numeric_values.numeric <- function(x) {
  is.numeric(x)
}

#' @export
is_numeric_values.Matrix <- function(x) {
  is.numeric(x@x)
}

#' @export
is_numeric_values.matrix <- function(x) {
  is.numeric(c(x))
}

#' @export
is_numeric_values.data.frame <- function(x) {
  all(vapply(x, is_numeric_values, logical(1)))
}

#' @export
is_numeric_values.Spatial <- function(x) {
  all(vapply(x@data, is_numeric_values, logical(1)))
}

#' @export
is_numeric_values.sf <- function(x) {
  all(vapply(sf::st_drop_geometry(x), is_numeric_values, logical(1)))
}

#' @export
is_numeric_values.SpatRaster <- function(x) {
  all(!terra::is.factor(x))
}

#' @export
is_numeric_values.Raster <- function(x) {
  TRUE
}
prioritizr/prioritizr documentation built on April 30, 2024, 1:35 a.m.