Nothing
# Comparisons -------------------------------------------------------------
# Engine
compare <- function(x, equal_to = NULL, minimum = NULL, maximum = NULL, comparison_inclusive = TRUE, all_must_satisfy = TRUE){
# Check at least one comparison criterion is supplied
if(is.null(minimum) && is.null(maximum) && is.null(equal_to))
stop("Must supply at least one threshold: either 'equal_to', `minimum` or maximum")
# Assert no missing values
assert_no_missing(x, arg_name = deparse(substitute(x, env = parent.frame())))
# Preset some vals
passes_min_threshold = TRUE
passes_max_threshold = TRUE
passes_equivalence = TRUE
# Is Greater Than
if(!is.null(minimum)){
if(comparison_inclusive) passes_min_threshold <- x >= minimum
else passes_min_threshold <- x > minimum
passes_min_threshold <- if(all_must_satisfy) all(passes_min_threshold) else any(passes_min_threshold)
}
# Is Less Than
if(!is.null(maximum)) {
if(comparison_inclusive) passes_max_threshold <- x <= maximum
else passes_max_threshold <- x < maximum
passes_max_threshold <- if(all_must_satisfy) all(passes_max_threshold) else any(passes_max_threshold)
}
# Is Equal To
if(!is.null(equal_to)){
passes_equivalence <- x == equal_to
passes_equivalence <- if(all_must_satisfy) all(passes_equivalence) else any(passes_equivalence)
}
# Passes thresholds
passes_all_thresholds <- passes_min_threshold && passes_max_threshold && passes_equivalence
return(passes_all_thresholds)
}
#' Check if a numeric vector is greater than a specified minimum value
#'
#' This function checks if a numeric vector is greater than a specified minimum value. It can also optionally check if all elements of the vector must be greater than the minimum value or if only one element is sufficient
#'
#' @param x a numeric vector to check
#' @param minimum The minimum value to compare against
#'
#' @return A logical value indicating whether all elements of the numeric vector x are greater than the specified minimum value
#' @examples
#' if(interactive()){
#' is_greater_than(c(2,3,4), 1) # TRUE
#' is_greater_than(c(2,3,4), 2) # TRUE
#' is_greater_than(c(2,3,1), 3) # FALSE
#' }
is_greater_than <- function(x, minimum){
compare(x = x, minimum = minimum, all_must_satisfy = TRUE, comparison_inclusive = FALSE)
}
#' Check if a numeric vector is greater than or equal to a specified minimum value
#'
#' This function checks if a numeric vector is greater than or equal to a specified minimum value. It can also optionally check if all elements of the vector must be greater than or equal to the minimum value or if only one element is sufficient
#'
#' @param x a numeric vector to check
#' @param minimum The minimum value to compare against
#' @return A logical value indicating whether all elements of the numeric vector x are greater than or equal to the specified minimum value
#' @examples
#' if(interactive()){
#' is_greater_than_or_equal_to(c(2,3,4), 1) # TRUE
#' is_greater_than_or_equal_to(c(2,3,4), 2) # TRUE
#' is_greater_than_or_equal_to(c(2,3,1), 3) # FALSE
#' }
is_greater_than_or_equal_to <- function(x, minimum){
compare(x = x, minimum = minimum, all_must_satisfy = TRUE, comparison_inclusive = TRUE)
}
#' Check if two objects are identical
#'
#' @param x first object to compare
#' @param y second object to compare
#' @return logical value indicating whether or not the objects are identical
is_identical <- function(x, y){
identical(x = x, y = y)
}
#' Check equality of two objects
#'
#' Is `x` equal to `y`. powered by the [all.equal()] function.
#'
#' @param x first object to compare
#' @param y second object to compare
#' @param tolerance Differences smaller than tolerance are not reported. The default value is close to 1.5e-8 (numeric >= 0).
#' @param check_names should the names(.) of target and current should be compare (flag)
#' @param check_environment should the environments of functions should be compared?
#' You may need to set check.environment=FALSE in unexpected cases, such as when comparing two nls() fits. (flag)
#' @param check_tzone should "tzone" attributes be compared. Important for comparing POSIXt objects. (flag)
#' @return TRUE if x is equal to y
#'
#' @examples
#' if(interactive()){
#' is_equal(1, 1) #TRUE
#' is_equal(c(1, 2), 1) #FALSE
#'
#' is_equal(c("A", "B"), c("A", "B")) #TRUE
#' is_equal("A", "B") #FALSE
#' }
is_equal <- function(x, y, tolerance = sqrt(.Machine$double.eps), check_names = TRUE, check_environment = TRUE, check_tzone = TRUE){
isTRUE(all.equal(x, y, check.names = check_names, check.environment = check_environment, check.tzone = check_tzone))
}
#' Check equality of type
#'
#' Is type of `x` the same as `y` (according to typof)
#'
#' @param x first object to compare
#' @param y second object to compare
#'
#' @return TRUE if x and y are of the same type, otherwise FALSE
#'
is_same_type <- function(x, y){
typeof(x) == typeof(y)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.