Tuesday, February 14, 2017

Apply a function to each consecutive pairs in a vector.

diff.func <- function(x, func)
{ 
    ## Purpose: Apply a function to each consecutive pairs in a vector. 
    ## Arguments:
    ##   x: a vector
    ##   func: a function that operature on two elements (of "x")
    ## Return: a vector, whose length is length(x) - 1, that looks like (where N=length(x))
    ##    func(x[2], x[1]), func(x[3], x[2]), func(x[4], x[3]), ..., func(x[N], x[N-1]).
    ## Author: Feiming Chen, Date:  9 Feb 2017, 11:25
    ## ________________________________________________
    
    ## embed in 2-dim space to make consecutive pairs
    x2 <- embed(x, 2)                  # N - 1 pairs
    ## apply a function to each consecutive paris (reversely)
    x3 <- apply(x2, 1, func)
    x3
}
if (F) {                                # Unit Test
    diff.func(1:5, diff)                # -1 -1 -1 -1   
    diff.func(1:5, mean)                # 1.5 2.5 3.5 4.5
}

Plot multiple lines together using "matplot"


my.line.plot  <- function(x, y, ...)
{ 
    ## Purpose: Template function for making lines by group. 
    ## Arguments:
    ##   x: X-coords
    ##   y: a matrix with Y-coords (each column has a set of Y values)
    ##   ...: passed to "plot"
    ## Return: A plot assuming log X-axis with axes tickes given by "x". 
    ## Author: Feiming Chen, Date:  9 Feb 2017, 14:02
    ## ________________________________________________n
    N <- ncol(y)                        # number of lines
    matplot(x, y, type="b", log="x", xaxt="n", lwd=2, lty=seq(N), col = rainbow(N), ...)  
    matpoints(x, y, log="x", xaxt="n", col = "black", ...)
    axis(1, at=x)
}
if (F) {                                # Unit Test
    x <- c(0.1, 1, 10)
    y <- matrix(rnorm(9), 3)
    my.line.plot(x, y, xlab="Tiime", ylab="Signal", main="Line Plot by Groups")
}


Monday, February 6, 2017

R Code: Apply a function to each element of a list (or data frame) or to each element of a list within a list of data while retaining the names attribute of each nested list


lf.compute.data.column <- function(dat.list, func, ...)
{
## Purpose: Apply a function to each column of a list (e.g. data frame). Retains the names information.
## Basis for processing more complex data (e.g. a list of a list)
## Arguments:
## dat.list: a list of data (e.g. data frame)
## func: a function that computes a vector (may have an argument "name")
## ...: passed to "func"
## Return:
## a list of outputs.
## Author: Feiming Chen, Date: 30 Jan 2017, 13:21
## ________________________________________________

this.name <- null2na(names(dat.list))

mapply(func,
dat.list,
name = this.name,
...,
SIMPLIFY = FALSE
)
}
if (F) { # Unit Test
dat.list = data.frame(x=rnorm(10), y=rnorm(10))
lf.compute.data.column(dat.list, mean)
lf.compute.data.column(dat.list, function(x, ...) { c(a=mean(x), b=sd(x)) })
lf.compute.data.column(dat.list, function(x, name) { list(a=mean(x), n=name) })
}


lf.compute.data.column.2 <- function(dat.list, func, ...)
{
## Purpose: Apply a function to a list of a list of data. Retains the names information.
## Arguments:
## dat.list: a list of a list
## func: a function that computes a vector. (may have an argument "name")
## Return: a list of list of results
## Author: Feiming Chen, Date: 6 Feb 2017, 12:50
## ________________________________________________

this.name <- null2na(names(dat.list))

mapply(
function(d, name) {
if (!is.na(name)) names(d) <- paste0(name, ".", names(d))
lf.compute.data.column(d, func)
},
dat.list,
name = this.name,
...,
SIMPLIFY = FALSE
)
}
if (F) { # Unit Test
dat.list.2 = list(test1 = data.frame(x=1:5, y=6:10), test2= data.frame(x=11:15, y=16:20))
lf.compute.data.column.2(dat.list.2, mean)
lf.compute.data.column.2(dat.list.2, function(x, ...) { c(m=mean(x), s=sd(x)) })
lf.compute.data.column.2(dat.list.2, function(x, name) { list(m=mean(x), n=name) })
}

null2na <- function(x) {
## if the value of x is NULL(as determined by length test since is.null may
## not always work), turn it into NA so that an object
## made of it will always exist.
if (length(x)==0)
x <- NA
x
}

R Code: Extract a fixed component of a list within a list and optionally apply a function


lf <- function(obj, comp, fun=identity, wrap=identity,
return.vector=TRUE, verbose=FALSE,
...) {
## WARNING: "comp" have to be a real string instead of a variable
## Functional Apply
## "comp": a character string, indicated a list component.
## "obj" is a list. "comp" is a component of each element of the
## list "obj". Apply a funcion (just an unquoted name) to each "comp" of the list
## "obj". "..." is passed to "fun". use "fun=identity" if no
## processing is needed. "wrap" is applied to the final result.
## "return.vector" will force the result to be a vector.

comp <- substitute(comp)
e <- paste(deparse(substitute(wrap)), "(lapply(obj,",
deparse(substitute(function(x) fun(x[[comp]], ...))), "))")
ans <- eval(parse(text=e))
if (verbose) cat("expression:", e, "\n")
if (return.vector)
ans <- sapply(ans, function(x) if (is.null(x)) NA else x)

ans
}
if (F) {
a <- list(x=c(1:3), y=c(4:6))
lf(a, 2) # c(x=2, y=5)

a <- list(x=list(median=3, mean=4), y=list(median=5, mean=6))
lf(a, "mean") # c(x=4, y=6)
lf(a, "mean", sqrt, verbose=T) # c(x=2, y=2.4495)
lf(a, "mean", sqrt, wrap=length, verbose=T) # 2
}

R Code: Apply a function to a vector in an accumulative manner


cum.func <- function(x, func)
{
## Purpose: Apply a function to a vector in an accumulative manner (like cumsum)
## Arguments:
## x: a vector
## func: a function
## Return: a vector that is the result of:
## c( func(x[1]), func(x[1:2]), func(x[1:3]), func(x[1:4]), func(x[1:5]), ... )
## Author: Feiming Chen, Date: 30 Jan 2017, 14:06
## ________________________________________________

N <- length(x)
y <- rep_len(NA, N)
for (i in 1:N) y[i] <- func(x[1:i])
y
}
if (F) { # Unit Test
identical(cum.func(5:1, mean), c(5.0, 4.5, 4.0, 3.5, 3.0))
}

R Function for Overlaying a New Plot on an Existing Plot


plot.overlay <- function(..., label="2nd Y", col="blue")
{
## Purpose: Overlay a new plot on an existing plot.
## Arguments:
## ...: Passed to the "plot" function for the new plot.
## label: The secondary Y-axis label.
## col: The color of the ticks and tick labels for the new plot.
## Return: A modified plot.
## Author: Feiming Chen, Date: 6 Feb 2017, 10:19
## ________________________________________________

par(new=T)
plot(..., axes=F, xlab="", ylab="", col=col)
axis(side=4, col.ticks = col, col.axis=col)
mtext(label, side=4, line=-1, col=col)
}
if (F) { # Unit Test
plot(rnorm(100))
plot.overlay(rnorm(100), type="l", label="Test")
}

Tuesday, April 26, 2016

Parallel Computing for R: A convenient wrapper function for the R package "parallel"


I wrote the following wrapper function that makes it easy to call parallel computing in R.  You may want to change the "nCores" parameter to the number of CPU cores you have and want to utilize.


my.parallel <- function(X, FUN,
clFUN=c("parSapply", "parLapply", "parRapply", "parCapply"),
nCores=2, ...)
{
## PURPOSE: Wrapper for R Parallel Computing Package "parallel"
## ARGUMENT:
## X: a list or vector of data
## FUN: a function to be applied over the data X.
## clFUN: a string for the parallel version of the "apply" function
## varieties available from the R package "parallel".
## Only four versions are allowed.
## nCores: Numer of CPU cores to be utilized for parallel computing
## ...: other arguments that will be passed the function "clFUN".
## RETURN: Computed data that are returned from the "clFUN" call.
## DATE: 26 Apr 2016, 12:43
## -----------------------------------------------------
clFUN <- match.arg(clFUN)
require(parallel)
cl <- makeCluster(nCores, type="FORK")
res <- do.call(clFUN, list(cl=cl, X, FUN, ...))
stopCluster(cl)
res
}
if (F) { # Unit Test 
    parallel::detectCores()       # check how many CPU cores are available
base <- 2
f <- function(exponent) base^exponent
my.parallel(2:4, f) # 4 8 16
my.parallel(matrix(1:9, 3), sum, "parRapply") # 12 15 18
}