Created
October 31, 2013 15:43
-
-
Save mrdwab/7251969 to your computer and use it in GitHub Desktop.
Makes the output of `cut` a `list` with the values of `cut` and a `data.frame` with the lower and upper values of each interval.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
CUT <- function (x, breaks, labels = NULL, include.lowest = FALSE, right = TRUE, | |
dig.lab = 3L, ordered_result = FALSE, ...) | |
{ | |
if (!is.numeric(x)) | |
stop("'x' must be numeric") | |
if (length(breaks) == 1L) { | |
if (is.na(breaks) || breaks < 2L) | |
stop("invalid number of intervals") | |
nb <- as.integer(breaks + 1) | |
dx <- diff(rx <- range(x, na.rm = TRUE)) | |
if (dx == 0) | |
dx <- abs(rx[1L]) | |
breaks <- seq.int(rx[1L] - dx/1000, rx[2L] + dx/1000, | |
length.out = nb) | |
} | |
else nb <- length(breaks <- sort.int(as.double(breaks))) | |
if (anyDuplicated(breaks)) | |
stop("'breaks' are not unique") | |
codes.only <- FALSE | |
if (is.null(labels)) { | |
for (dig in dig.lab:max(12L, dig.lab)) { | |
ch.br <- formatC(breaks, digits = dig, width = 1L) | |
if (ok <- all(ch.br[-1L] != ch.br[-nb])) | |
break | |
} | |
labels <- if (ok) | |
paste0(if (right) | |
"(" | |
else "[", ch.br[-nb], ",", ch.br[-1L], if (right) | |
"]" | |
else ")") | |
else paste("Range", seq_len(nb - 1L), sep = "_") | |
if (ok && include.lowest) { | |
if (right) | |
substr(labels[1L], 1L, 1L) <- "[" | |
else substring(labels[nb - 1L], nchar(labels[nb - | |
1L], "c")) <- "]" | |
} | |
} | |
else if (is.logical(labels) && !labels) | |
codes.only <- TRUE | |
else if (length(labels) != nb - 1L) | |
stop("lengths of 'breaks' and 'labels' differ") | |
code <- .bincode(x, breaks, right, include.lowest) | |
if (codes.only) | |
FIN <- code | |
else FIN <- factor(code, seq_along(labels), labels, ordered = ordered_result) | |
list(output = FIN, ranges = data.frame(lower = ch.br[-nb], upper = ch.br[-1L])) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment