Re: [R] applying a function to data frame columns

From: Tim Hesterberg <timh_at_insightful.com>
Date: Fri, 22 Feb 2008 10:31:32 -0800

You can do:

        lapply2(u, v, function(u,v) u[inRange(u, range(v))])

using two functions 'lapply2' and 'inRange' defined at bottom. This basically does:

	lapply(seq(along=u),
               function(i, U, V){
                 u <- U[[i]]
                 v <- V[[i]]
                 u[u >= range(v)[1] & u <= range(v)[2]]
               },
               U = u, V = v)

Tim Hesterberg

>I want to apply this function to the columns of a data frame:
>
>u[u >= range(v)[1] & u <= range(v)[2]]
>
>where u is the n column data frame under consideration and v is a data frame
>of values with the same number of columns as u. For example,
>v1 <- c(1,2,3)
>v2 <- c(3,4,5)
>v3 <- c(2,3,4)
>v <- as.data.frame(cbind(v1,v2,v3))
>
>uk1 <- seq(min(v1) - .5, max(v1) + .5, .5)
>uk2 <- seq(min(v2) - .5, max(v2) + .5, .5)
>uk3 <- seq(min(v3) - .5, max(v3) + .5, .5)
>
>u <- do.call("expand.grid", list(uk1,uk2,uk3))
>
>Here, there are 3 columns; instead of hard-coding this, can the function
>given above, which will restrict the u data frame to values within the
>ranges of each variable, be done with the apply function? Thanks in
>advance.
>
>dxc13

# inRange requires ifelse1, part of the "splus2R" package.

inRange <- function(x, a, b, strict = FALSE) {

  # Return TRUE where x is within the range of a to b.
  # If a is length 2 and b is missing, assume that a gives the range.
  # if(strict==FALSE), then allow equality, otherwise require a < x < b.
  # strict may be a vector of length 2, governing the two ends.
  if(length(a)==2) {
    b <- a[2]
    a <- a[1]
  }
  else if(length(a) * length(b) != 1)
    stop("a and b must both have length 1, or a may have length 2")   strict <- rep(strict, length=2)
  ifelse1(strict[1], x>a, x>=a) & ifelse1(strict[2], x<b, x<=b) }

lapply2 <- function(X1, X2, FUN, ...){
  # Like lapply, but for two inputs.
  # FUN should take two inputs, one from X1 and one from X2.

  n1 <- length(X1)
  if(n1 != length(X2))
    stop("X1 and X2 have different lengths")

  if(is.character(FUN))

    FUN <- getFunction(FUN)
  else if(!is.function(FUN)) {
    farg <- substitute(FUN)
    if(is.name(farg))
      FUN <- getFunction(farg)
    else
      stop("'", deparseText(farg), "' is not a function")
  }

  FUNi <- function(i, X1, X2, FUN2, ...)     FUN2(X1[[i]], X2[[i]], ...)

  # Create sequence vector.
  # If objects have same names, use them.   i <- seq(length = n1)
  names1 <- names(X1)
  if(length(names1) && identical(names1, names(X2)))     names(i) <- names1

  # Final result; loop over the sequence vector   lapply(i, FUNi, X1 = X1, X2 = X2, FUN2 = FUN, ...) }



R-help_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code. Received on Fri 22 Feb 2008 - 18:34:26 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Fri 22 Feb 2008 - 19:30:43 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.

list of date sections of archive