[R] applying a function to data frame columns

[Tim Hesterberg]

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, ...)
}