add rounding utilities
Gitea Organization/civilyticsR/pipeline/head There was a failure building this commit
Gitea Organization/civilyticsR/pipeline/head There was a failure building this commit
This commit is contained in:
@@ -376,3 +376,72 @@ safe_ratio <- function(num, denom) {
|
||||
y <- num / denom
|
||||
return(y)
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Take the maximum of a number after trimming values
|
||||
#'
|
||||
#' @param vec a numeric vector
|
||||
#' @param n integer, the number of maximum values to trim before taking the maximum
|
||||
#'
|
||||
#' @return the highest value after removing the highest n values
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' trim_max(c(10, 10, 10, 9, 8, 7), n = 2)
|
||||
#' trim_max(c(10, 10, 10, 9, 8, 7), n = 3)
|
||||
#' trim_max(c(10, 10, 10, 9, 8, 7), n = 4)
|
||||
trim_max <- function(vec, n) {
|
||||
# Sort vector ascending
|
||||
sorted_vec <- sort(vec)
|
||||
end_point <- length(vec) - n
|
||||
if (end_point <= 0) {
|
||||
return(1)
|
||||
}
|
||||
# Exclude n largest (most extreme) values
|
||||
filtered_vec <- sorted_vec[(1:(length(vec)-n))]
|
||||
# Find the maximum value among excluded values if any exist
|
||||
max_value <- max(filtered_vec, na.rm = TRUE)
|
||||
return(max_value)
|
||||
}
|
||||
|
||||
|
||||
#' Round values to the nearest 0.5
|
||||
#'
|
||||
#' @param x a numeric vector to round
|
||||
#'
|
||||
#' @return a numeric vector with all elements rounded to 0, 0.5, or 1
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' round_to_nearest_half(0.9)
|
||||
#' round_to_nearest_half(0.7)
|
||||
#' round_to_nearest_half(0.4)
|
||||
round_to_nearest_half <- function(x) {
|
||||
if (x %% 1 == 0) { # If x is already an integer, no change needed
|
||||
return(as.integer(x))
|
||||
} else {
|
||||
decimal_part <- x - floor(x)
|
||||
if (decimal_part >= 0.25 & decimal_part < 0.75) {
|
||||
rounded_x <- floor(x) + 0.5
|
||||
} else {
|
||||
rounded_x <- round(x, 0)
|
||||
}
|
||||
return(rounded_x)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#' Round values to the nearest 0.5
|
||||
#'
|
||||
#' @inheritParams round_to_nearest_half
|
||||
#'
|
||||
#' @return a numeric vector with all elements rounded to 0, 0.5, or 1
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' rnh(c(0.2, 0.3, 0.4, 0.8, 0.09, 0.9))
|
||||
rnh <- function(x) {
|
||||
tmp <- Vectorize(civilytics::round_to_nearest_half)
|
||||
tmp(x)
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user