# R/cut.R In kimisc: Kirill's Miscellaneous Functions

```#' Convert Numeric to Factor, with custom formatting
#'
#' This is an enhanced version of [base::cut()] that allows a custom
#' formatting to be applied to the values.
#'
#' @inheritParams base::cut.default
#' @param breaks  `[numeric]`\cr
#' A vector of two or more unique cut points
#' @param ... Passed to `cut()`
#' @param format_fun `[function(x): character]`\cr
#'   A vectorized function that performs the desired formatting.  Default:
#'   [base::format()]
#' @param sep `[character(1)]`\cr
#'   The separator between lower and upper end of the interval. Default:
#'   `", "`
#' @param paren `[character(4)]`\cr
#'   Opening and closing parentheses in two variants. Default:
#'   \code{c("(", "[", ")", "]")}
#' @seealso [http://stackoverflow.com/q/14456371/946850]()
#'
#' @examples
#' cut_format(runif(10), seq(0, 1, by = 0.25), format_fun = function(x) paste(x * 100, "%"))
#' cut_format(runif(10), seq(0, 1, by = 0.25), paren = c("<", "{", ">", "}"))
#' @export
cut_format <- function(x, breaks, include.lowest = FALSE, right = TRUE,
ordered_result = FALSE, ...,
format_fun = format, sep = ", ",
paren = c("(", "[", ")", "]")) {
if (length(breaks) < 2L) {
stop("Please specify breaks as a numeric vector of length >= 2",
call. = FALSE)
}

if (right) {
ob <- c(include.lowest, rep(FALSE, length(breaks) - 2L))
cb <- rep(TRUE, length(breaks) - 1L)
} else {
ob <- rep(TRUE, length(breaks) - 1L)
cb <- c(rep(FALSE, length(breaks) - 2L), include.lowest)
}

ob <- ifelse(ob, paren[[2L]], paren[[1L]])
cb <- ifelse(cb, paren[[4L]], paren[[3L]])

formatted_breaks <- format_fun(breaks)
labels <- paste0(ob, head(formatted_breaks, -1L), sep, tail(formatted_breaks, -1L), cb)
cut.default(x = x, breaks = breaks, labels = labels, include.lowest = include.lowest,
right = right, ordered_result = ordered_result, ...)
}
```

## Try the kimisc package in your browser

Any scripts or data that you put into this service are public.

kimisc documentation built on May 2, 2019, 4:01 a.m.