Pointfree functional style in R (http://www.haskell.org/haskellwiki/Pointfree)

examples.R

source('functional.R')

# Composing functions for fun and profit:

hsv2col <- function (col)
    apply(col, 2, lpartial(do.call, hsv) %.% as.list)

# In non-functional style:
hsv2col <- function (col)
    apply(col, 2, function (c) do.call(hsv, as.list(x)))


# From a genomic sequence analysis script

# `loci` is a vector of 'chr:from..to' strings containing genome locations
lapply(loci, unlist %.% partial(strsplit, ':')) %|% head
# [[1]]
# [1] "chr18" "3026901..3027882"
#
# [[2]]
# [1] "chr18" "3080778..3081476"
#
# … etc.

functional.R

# Functional tools

id <- function (x) x

# This uses R's peculiarities in argument matching explained here:
# <http://stat.ethz.ch/R-manual/R-devel/doc/manual/R-lang.html#Argument-matching>
# `.expr` starts with a dot to allow `expr` being used in the actual
# expression.
let <- function (.expr, ...)
    eval(substitute(.expr), list2env(list(...), parent = parent.frame()))

#' Partial function application from right to left.
#' NB: this is the opposite from the (wrongly-named) roxygen::Curry:
#'
#'   minus <- function (x, y) x - y
#'   partial(minus, 5)(1) == -4
#'
#' But:
#'
#'   partial(minus, x = 5)(1) == 4
#'
partial <- function (f, ...)
    let(capture = list(...),
        function (...) do.call(f, c(list(...), capture)))

lpartial <- function(f, ...)
    let(capture = list(...),
        function (...) do.call(f, c(capture, list(...))))

#' Compose functions `g` and `f`. `compose(g, f)(...) = g(f(...))`.
#' NB: Functions are applied in the inverse order of `roxygen::Compose`.
#' <http://tolstoy.newcastle.edu.au/R/e9/help/10/02/4529.html>
compose <- function (g, f)
    function (...) g(f(...))

`%.%` <- compose

# Pipe operator modified after Robert Sugar, e.g. at
# <http://markmail.org/thread/uygwsdulfvxlydlh>
`%|%` <- function (x, y)
    let(thecall = match.call(),
        if (is.name(thecall$y) || is.function(thecall$y))
            y(x)
        else
            eval(thecall$y,
                 list(value = eval(thecall$x, env = parent.frame()))))

slice <- function (x, ...)
    x[...]