[R] cut in R

From: Steve Su <s.su_at_qut.edu.au>
Date: Thu 21 Jul 2005 - 15:01:28 EST


Dear All,

I wonder whether it is still valid to use the following R code for cut. All I have done is changed:

   if (is.na(breaks) | breaks < 2)

to:  

   if (is.na(breaks) | breaks < 1)

so that it covers interval of 1?

It seems okay for my purposes but I am not sure why R specifically does not allow break<2 to happen.

Steve.

cut.default<-
function (x, breaks, labels = NULL, include.lowest = FALSE, right = TRUE, dig.lab = 3, ...) {

    if (!is.numeric(x))

        stop("'x' must be numeric")
    if (length(breaks) == 1) {

        if (is.na(breaks) | breaks < 1) 
            stop("invalid number of intervals")
        nb <- as.integer(breaks + 1)
        dx <- diff(rx <- range(x, na.rm = TRUE))
        if (dx == 0) 
            dx <- rx[1]
        breaks <- seq(rx[1] - dx/1000, rx[2] + dx/1000, len = nb)

}

    else nb <- length(breaks <- sort(breaks))     if (any(duplicated(breaks)))

        stop("'breaks' are not unique")
    codes.only <- FALSE
    if (is.null(labels)) {

        for (dig in dig.lab:max(12, dig.lab)) {
            ch.br <- formatC(breaks, digits = dig, wid = 1)
            if (ok <- all(ch.br[-1] != ch.br[-nb])) 
                break
        }
        labels <- if (ok) 
            paste(if (right) 
                "("
            else "[", ch.br[-nb], ",", ch.br[-1], if (right) 
                "]"
            else ")", sep = "")
        else paste("Range", 1:(nb - 1), sep = "_")
        if (ok && include.lowest) {
            if (right) 
                substr(labels[1], 1, 1) <- "["
            else substring(labels[nb - 1], nchar(labels[nb - 
                1], type = "char")) <- "]"
        }

}

    else if (is.logical(labels) && !labels)

        codes.only <- TRUE
    else if (length(labels) != nb - 1)

        stop("labels/breaks length conflict")     code <- .C("bincode", x = as.double(x), n = as.integer(length(x)),

        breaks = as.double(breaks), as.integer(nb), code = integer(length(x)), 
        right = as.logical(right), include = as.logical(include.lowest), 
        naok = TRUE, NAOK = TRUE, DUP = FALSE, PACKAGE = "base")$code
    if (codes.only) 
        code

    else factor(code, seq(labels), labels) }

 Steve Su (s.su@qut.edu.au)
 Postdoctoral fellow

 Faculty of Business
 Queensland University of Technology  

 Postal Address: Steve Su, School of Accountancy, QUT, PO Box 2434, Brisbane,  Queensland, Australia, 4001.

 CRICOS No. 00213J  

 Phone: +61 7 3864 4357
 Fax: +61 7 3864 1812
 Mobile: 0421 840 586

     .                               
   _--_|\                  
  /      QUT                                   
  \_.--._/                                                                           
        v                                               
                                                                      
**************************************************************************************                                                                   
	[[alternative HTML version deleted]]

______________________________________________
R-help@stat.math.ethz.ch mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html Received on Thu Jul 21 15:07:40 2005

This archive was generated by hypermail 2.1.8 : Fri 03 Mar 2006 - 03:33:53 EST