What are your favourite short, mind-blowing snippets in functional languages?
My two favourite ones are (Haskell):
powerset = filterM (const [True, False])
foldl f v xs = foldr (\x g a -> g (f a x)) id xs v -- from Hutton's tutorial
(I tagged the question as Haskell, but examples in all languages - including non-FP ones - are welcome as long as they are in functional spirit.)
My "aha!" moment with JavaScript came when I was reading this memoization [1] blog post. The relevant functional code, from that post was:
Bezier.prototype.getLength = function() {
var length = ... // expensive computation
this.getLength = function(){return length};
return length;
}
Basically, the function overwrites itself with the answer after the first computation, make all subsequent calls memoized.
It was at this point that I realized how all my previous ill-conceived notions of JS were founded in ignorance. And it was at this point that I realized the true power of its functional aspects.
[1] http://osteele.com/archives/2006/04/javascript-memoizationbwp xs = map snd $ sort $ zip (rots xs) (rrot xs)
rots xs = take (length xs) (iterate lrot xs)
lrot xs = tail xs ++ [head xs]
rrot xs = last xs : init xs
The (forwards)
Burrows-Wheeler Transform
[1], from a Functional Pearl
paper
[2]. BWT is used as the second stage in the bzip2
compression (after run-length encoding), grouping similar features together to make most inputs more compressible by the following stages.
The paper also has a couple implementations for the inverse, also elegant but not quite as short.
[1] http://en.wikipedia.org/wiki/Burrows%E2%80%93Wheeler%5Ftransformbwp xs = map snd $ sort $ zip (tail $ iterate lrot xs) xs where lrot (a:as) = as ++ [a]
;-) - jberryman
Array.sort [|for i in 0..n-1 -> [|for j in 0..n-1 -> xs.[(i+j) % n]|]|] |> Array.map (fun xs -> xs.[n-1])
! - Jon Harrop
Data.Sequence
from the containers package is probably better. - Ben Millwood
My mind-blowing time happened while watching the
SICP video lectures.
[1]
Data made of thin air. The functions as data containers.
More specifically, store a pair of data even if the language doesn't have a built-in data container.
That was my baptism on functional programming.
#lang scheme
;; Version 1
(define (pair x y)
(lambda (p)
(cond ((> p 0) x)
(else y))))
(define (pair-x z)
(z 1))
(define (pair-y z)
(z 0))
;; Version 2, Alonzo Church Pairs - Lambda Calculus
;; SICP exercise
(define (church-pair x y)
(lambda (m) (m x y)))
(define (church-pair-x z)
(z (lambda (x y) x)))
(define (church-pair-y z)
(z (lambda (x y) y)))
Example:
> (define p (pair 7 8))
> (pair-x p)
7
> (pair-y p)
8
>
[1] http://groups.csail.mit.edu/mac/classes/6.001/abelson-sussman-lectures/Definitely this one (from wikipedia [1]) for a short RPN-interpreter.
calc = foldl f [] . words
where
f (x:y:zs) "+" = (y + x):zs
f (x:y:zs) "-" = (y - x):zs
f (x:y:zs) "*" = (y * x):zs
f (x:y:zs) "/" = (y / x):zs
f xs y = read y : xs
And to bring a slightly more complicated example ;-): Linq raytracer [2]
[1] http://en.wikipedia.org/wiki/Haskell%5F%28programming%5Flanguage%29I got this from Sean Seefried. Here we use tying the knot to replace all leaves of a tree with the minimal leaf value in a single pass.
data Tree
= Fork Tree Tree
| Leaf Int
aux i (Leaf i') = (i', Leaf i)
aux i (Fork t1 t2) =
let (m1, t1') = aux i t1
(m2, t2') = aux i t2
in (min m1 m2, Fork t1' t2')
replaceMin t =
let (m, t') = aux m t in t'
Thus:
replaceMin (Fork (Leaf 4) (Leaf 7)) = Fork (Leaf 4) (Leaf 4)
I've always loved the Fibonacci numbers definition:
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
Or anything else co-recursive.
If C++ metaprogramming counts, I choose the first metaprogram ever created [1] :)
// Prime number computation by Erwin Unruh
template <int i> struct D { D(void*); operator int(); };
template <int p, int i> struct is_prime {
enum { prim = (p%i) && is_prime<(i > 2 ? p : 0), i -1> :: prim };
};
template < int i > struct Prime_print {
Prime_print<i-1> a;
enum { prim = is_prime<i, i-1>::prim };
void f() { D<i> d = prim; }
};
struct is_prime<0,0> { enum {prim=1}; };
struct is_prime<0,1> { enum {prim=1}; };
struct Prime_print<2> { enum {prim = 1}; void f() { D<2> d = prim; } };
#ifndef LAST
#define LAST 10
#endif
main () {
Prime_print<LAST> a;
}
[1] http://www.erwin-unruh.de/primorig.htmltemplate<> struct
), GCC refuses to compile this satisfactorily. - ephemient
D<2>
in struct Prime_print<2>
and doesn't go any further, which kind of defeats the purpose of the rest of the program, and I'm not sure how to convince GCC to behave more like the writer wanted it to. - ephemient
template<>
, since the syntax for template specialization has changed. However, the problem is that in order for this to work, you need the compiler to blow up while chasing Prime_print<LAST>
instead of on Prime_print<2>
a few lines up, and GCC just refuses to cooperate... - ephemient
The biggest "Oh Wow!" moment I've had is with the exponentiation function in lambda calculus.
\ab.ba
results in a ^ b
\ab.ba
is not flip
, it is flip id
. flip = \fab.(fb)a
, which is very different. id = \ab.ab = 1
in Church numerals. (Which is expected, since function composition is multiplication of Church numerals.) - misterbee
C++ is to pointers as functional programming is to continuations: newbies are mystified by them both.
Start with a simple binary tree insert:
type 'a tree =
| Node of 'a tree * 'a * 'a tree
| Nil
let rec insert x = function
| Nil -> Node(Nil, x, Nil)
| Node(l, a, r) as node ->
if x > a then Node(l, a, insert x r)
elif x < a then Node(insert x l, a, r)
else node
Simple, utilitarian, but its not tail-recursive. So, you go-go-gadget continuation passing style, and you get this:
let insert x tree =
let rec loop cont x = function
| Nil -> cont <| Node(Nil, x, Nil)
| Node(l, a, r) as node ->
if x > a then loop (fun r' -> cont <| Node(l, a, r')) x r
elif x < a then loop (fun l' -> cont <| Node(l', a, r)) x l
else cont node
loop id x tree
At the expense of a little clarity, the algorithm is properly tail-recursive.
Here's a traditional and tail-recursive list append side-by-side:
let rec append a b =
match a with
| [] -> b
| x::xs -> x::append xs b
let append2 a b =
let rec loop cont = function
| [] -> cont b
| x::xs -> loop (fun xs' -> cont <| x::xs') xs
loop id a
As noted by Ron Jeffries on his blog
#define pi 3.14159
//z = radius
//a = thickness
float volume (float a, float z) { return pi*z*z*a; }
Courtesy of Douglas Crockford [1]:
function Y(le) {
return (function (f) {
return f(f);
}(function (f) {
return le(function (x) {
return f(f)(x);
});
}));
}
And the inevitable application:
var factorial = Y(function (fac) {
return function (n) {
return n <= 2 ? n : n * fac(n - 1);
};
});
var number120 = factorial(5);
For more exploration of the fine line between clever and stupid, see Evolution of a Haskell Programmer [2].
[1] http://www.crockford.com/javascript/little.htmlI'm always impressed when I see Haskell functions that feed part of their output into the input of the same function.
As a contrived example, I'll show how to find the mean average of a list.
This basic example requires 2 traversals through the list:
average_basic :: [Double] -> Double
average_basic xs = sum xs / length xs
This example leverages the power of lazy evaluation to feed part of the results of a function back into the function call itself:
average :: [Double] -> Double
average xs = s
-- avg calculates the length of a list, then feeds that result back into itself
-- to total up the average number.
where (s, len) = avg len xs
-- Given the length of a list, scan through it calculating the average and length
-- along the way.
avg :: Double -> [Double] -> (Double, Double)
avg len xs = foldl' op (0, 0) xs
where op (res, l) x = (res + x / len, l + 1)
example run:
Prelude> :m +Data.List
Prelude Data.List> let avg len xs = foldl' op (0, 0) xs where op (res, l) x = (res + x / len, l + 1)
Prelude Data.List> let average xs = s where (s, len) = avg len xs
Prelude Data.List> average [1..10]
5.5
Prelude Data.List>
average xs = s / fromInteger l where (s, l) = foldl' (\(!s, !l) x -> (s+x, l+1)) (0, 0) xs
, though. - ephemient
this is the scheme implementation of the omega combinator (essentially an infinite loop):
((call/cc call/cc) (call/cc call/cc))
Calculating the list of all Fibonacci numbers, lazily. Code snippet written in Scala.
class ConsStream[T](str: => Stream[T]) {
def ::(element: T) = Stream.cons(element, str)
}
implicit def stream2ConsStream[T](str: => Stream[T]) = new ConsStream[T](str)
lazy val fib: Stream[BigInt] = 0 :: 1 :: fib.zip(fib.tail).map(n => n._1 + n._2)
This can be made shorter (but not as nice) without using the implicit conversion that adds the ::
operator to a Stream
, by writing
lazy val fib: Stream[BigInt] =
Stream.cons(0, Stream.cons(1, fib.zip(fib.tail).map(n => n._1 + n._2)))
-- Flaviu Cipcigan
fib = 0 : 1 : zipWith (+) fib (tail fib)
- ephemient
zipWith
from Scalaz, the above Scala code gets compressed to: lazy val fib: Stream[BigInt] = 0 #:: 1 #:: (fib zipWith fib.tail)(_ + _)
. Longer than the Haskell version, but much shorter than the original Scala version :) - missingfaktor
After reading Steven Huwig's post [1] about a Javascript Y-Combinator [2] I played around a bit with that idea. A simpler version of the Y-combinator would be this:
function Y(f) {
return function recf(n) {
return f(recf, n);
}
}
This gives an easy implementation of the factorial function:
function facstep(rec, n) {
if (n==0)
return 1;
return n * rec(n-1);
}
var fac = Y(facstep);
alert(fac(6));
The syntax for this can be simplified even more. By using some of Javascripts special features the recursive step can be passed implicitly as this
while supporting any number of arguments for the "recursive" function:
function Y(f) {
return function rec() {
return f.apply(rec, arguments);
}
}
function gcdstep(n, m) {
// greatest common divisor
if (n == m)
return n;
if (n > m)
return this(n-m, m);
else
return this(m, n);
}
var gcd = Y(gcdstep);
alert(gcd(350, 40));
This syntax looks quite straight forward, but note that it's not normally possible for a Javascript function to refer to itself by using this
, this
normally refers to the object the function is a method of. In this case this
references the function itself, due to the magic of the Y-combinator:
y f = f (y f)
, which also uses some kind of recursion. I also wanted to avoid the additional function wrapper you easily end up with if you try to emulate Haskells laziness. - sth
Breadth-first traversal of an n-ary tree in Haskell:
bfs t = (fmap . fmap) rootLabel $
takeWhile (not . null) $
iterate (>>= subForest) [t]
Hamming numbers in Haskell.
hamming = 1 : map (2*) hamming `merge` map (3*) hamming `merge` map (5*) hamming
where merge (x:xs) (y:ys)
| x < y = x : merge xs (y:ys)
| y < x = y : merge (x:xs) ys
| otherwise = x : merge xs ys
This generalizes very elegantly to a solution generating any sort of smooth numbers. See a very long discussion at this lambda-the-ultimate thread: http://lambda-the-ultimate.org/node/608
Problem:
Given 4 number a, b, c, and d; output the sequence of a, b and c along with arithmetic
operators such that the result is d. The arithmetic operations allowed are
“+,-,/,*”.
I/p: a,b,c,d
O/p: <expression>
Eg.:
I/p: 4 3 2 10
O/p: 4+3*2=10
Solution: (in Scala)
object Aha {
def main(args: Array[String]) {
val (a, b, c, d) = (readInt, readInt, readInt, readInt)
val operations = List[((Int, Int) => Int, Int, String)](
({_+_}, 1, "+"), ({_-_}, 1, "-"), ({_*_}, 2, "*"), ({_/_}, 2, "/")
)
for {
(i, pi, si) <- operations
(j, pj, sj) <- operations
if((pi >= pj && j(i(a, b), c) == d) || (pi < pj && i(a, j(b, c)) == d))
} println(a + si + b + sj + c + "=" + d)
}
}
Same thing in C++ (with Boost):
#include <iostream>
#include <string>
#include <functional>
#include <boost/tuple/tuple.hpp>
#include <boost/function.hpp>
#include <boost/foreach.hpp>
using namespace std;
using namespace boost;
int main() {
int a, b, c, d;
cin >> a >> b >> c >> d;
tuple<function<int(int, int)>, int, string> operations[] = {
make_tuple(plus<int>(), 1, "+"),
make_tuple(minus<int>(), 1, "-"),
make_tuple(multiplies<int>(), 2, "*"),
make_tuple(divides<int>(), 2, "/")
};
function<int(int, int)> i, j;
int pi, pj;
string si, sj;
BOOST_FOREACH(tie(i, pi, si), operations) {
BOOST_FOREACH(tie(j, pj, sj), operations) {
if((pi >= pj && j(i(a, b), c) == d) || (pi < pj && i(a, j(b, c)) == d)) {
cout << a << si << b << sj << c << "=" << d << endl;
}
}
}
}
My personal favourite is the recursive directory traversal function from Higher Order Perl [1]. It was my first introduction to the power of functional programming (in this case the complete decoupling of the file tree traversal from the specific closures that act on the files and directories), and it really blew me away.
sub dir_walk {
my ( $top, $file_func, $dir_func ) = @_;
my $dh;
if ( -d $top ) {
my $file;
unless ( opendir $dh, $top ) {
warn "Couldn't open directory $top: $!; skipping.\n";
return;
}
my @results;
while ( $file = readdir $dh ) {
next if $file eq '.' || $file eq '..';
push @results, dir_walk("$top/$file", $file_func, $dir_func);
}
return $dir_func ? $dir_func->($top, @results) : ();
}
else {
return $file_func ? $file_func->($top): ();
}
}
[1] http://hop.perl.plover.com/After reading about Haskell's currying capabilities, I said to myself: "I can do that in JavaScript". I did it and am very proud of it (hence this answer). The whole gist is on GitHub [1], but here goes:
var curry = function (f) {
var array = Array.slice,
prevArity = arguments[1] || f.length;
return function () {
var args = array(arguments),
currArity = args.length;
if (currArity >= prevArity) {
return f.apply(this, args);
}
return curry(function () {
return f.apply(this, args.concat(array(arguments)));
}, prevArity - currArity);
};
};
And these are some BDD specs for it:
$.describe("The curry() function", function () {
$.it("should curry one argument functions", function () {
var unary = curry(function (a) {
return a;
});
var result = unary(1);
$(result).should.equal(1);
});
$.it("should curry multi argument functions", function () {
var nary = curry(function (a, b) {
return a + b;
});
var result = nary(1)(2);
$(result).should.equal(3);
});
$.it("should curry multi argument functions", function () {
var nary = curry(function (a, b, c) {
return a + b + c;
});
var result = nary(1, 2)(3);
$(result).should.equal(6);
});
});
[1] http://gist.github.com/134907I like Duff's Device [1]:
n=(count+7)/8;
switch(count%8){
case 0: do{ *to++ = *from++;
case 7: *to++ = *from++;
case 6: *to++ = *from++;
case 5: *to++ = *from++;
case 4: *to++ = *from++;
case 3: *to++ = *from++;
case 2: *to++ = *from++;
case 1: *to++ = *from++;
}while(--n>0);
}
This is essentially a loop unrolled custom memcpy, as opposed to the more straightforward implementation:
do{
*to++=*from++;
}while(--count>0);
this version has ~8 times the number of comparisons, decrements and jumps.
You probably woudn't want to do something like this in the place of just using memcpy in most circumstances. I actually had call to use a similar construct recently to interleave some arrays and measured a fairly nice speed increase.
[1] http://en.wikipedia.org/wiki/Duff%27s%5FdeviceI am still newb in functional, spent like 20 hours learning it, but i like this code and lazines
orderf :: Integer -> Integer -> Integer -> Integer
orderf 1 c b =(c + b)
orderf d c b = ( foldl (orderf (d - 1) ) c (replicate' (b - 1) c) )
-- orderf 1 7 9 -- 7 + 9
-- orderf 2 7 9 -- 7 * 9
-- orderf 3 7 9 -- 7 ^ 9
-- orderf 4 7 9 -- 7 ^ 7 ^ 7 ^ 7 ^ 7 ^ 7 ^ 7 ^ 7 ^ 7 but do not try this
-- orderf 3 99 99 ok, this works
(a -> b -> a) -> a -> [b] -> a
. The first argument is a function that takes an accumulator and a list element and returns a new value for the accumulator. The second argument is the initial accumulator value. The third argument, obviously, is the list. - Chuckconst [True, False]
=\\_ -> [True, False]
: the function that returns[True, False]
regardless of its argument.[True, False]
is two values in the[]
monad. For each elementpowerset
is given,filterM
applies the function to it, then enters the monad to determine whether or not the element is to be included... and the answer is yes/no. :) - ephemient