An inefficient Haskell implementation of the Integer Partitioning problem

This is my first shot at implementing a solution for the integer partitioning problem in Haskell. It is a very inefficient algorithm, and it would probably either hang forever or crash with a core dump beyond, say, 20, but it is a first step in an efficient implementation of this problem which appears to be egregiously difficult to implement in idiomatic Haskell as compared to say, Java.

This implementation also generates the partitions in lexicographic order.

Here is the code:

module Partitions where
isort :: Ord a => (a -> a -> Bool) -> [a] -> [a]
isort _ [] = []
isort f (x:xs) = insert f x (isort f xs)
                   where
                     insert _ x [] = [x]
                     insert f x (y:ys) | f x y = x : (y:ys)
                                       | otherwise = y : insert f x ys
lexical :: Ord a => [a] -> [a] -> Bool
lexical [] [] = True
lexical [] ys = True
lexical xs [] = True
lexical (x:xs) (y:ys) | x > y = False
                      | x < y = True
                      | otherwise = lexical xs ys
clean :: Ord a => [[a]] -> [[a]]
clean xss = h (map (isort (<)) xss) []
      where
        h [] acc = acc
        h [xs] acc = if elem xs acc then acc else (xs:acc)
        h (xs:xss) acc = if elem xs acc then h xss acc
                         else h xss (xs:acc)
partitions :: Int -> [[Int]]
partitions 0 = []
partitions n = isort lexical $ clean $ f start [start]
               where
                 start = replicate n 1
                 f [_] acc = acc
                 f xs acc = f (normalise xs) (acc ++ cs) ++ clean (concat (map (\ys -> f ys []) cs))
                   where
                     normalise [] = []
                     normalise [x, y] = [x+y]
                     normalise (x:xs) = x : normalise xs
                     combinations [] = []
                     combinations [x] = [[x]]
                     combinations xs = g xs (length xs – 2)
                       where
                         g xs s | s < 0 = []
                                | otherwise = [take s xs ++ [xs!!s + xs!!(s+1)] ++ drop (s+2) xs] ++
                                  g xs (s-1)
                     cs = clean $ combinations xs

 

Running some sample tests:

$ ghci
GHCi, version 8.0.2: http://www.haskell.org/ghc/
Prelude> :l Partitions.hs
[1 of 1] Compiling Partitions       (Partitions.hs, interpreted )
Ok, modules loaded: Partitions.
*Partitions> partitions 0
[]
*Partitions> partitions 4
[[1,1,1,1],[1,1,2],[1,3],[2,2],[4]]
*Partitions> partitions 9
[[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,2],[1,1,1,1,1,1,3],[1,1,1,1,1,2,2],[1,1,1,1,1,4],[1,1,1,1,2,3],[1,1,1,1,5],[1,1,1,2,2,2],[1,1,1,2,4],[1,1,1,3,3],[1,1,1,6],[1,1,2,2,3],[1,1,2,5],[1,1,3,4],[1,1,7],[1,2,2,2,2],[1,2,2,4],[1,2,3,3],[1,2,6],[1,3,5],[1,4,4],[1,8],[2,2,2,3],[2,2,5],[2,3,4],[2,7],[3,3,3],[3,6],[4,5],[9]]
*Partitions> partitions 12
[[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1,1,2],[1,1,1,1,1,1,1,1,1,3],[1,1,1,1,1,1,1,1,2,2],[1,1,1,1,1,1,1,1,4],[1,1,1,1,1,1,1,2,3],[1,1,1,1,1,1,1,5],[1,1,1,1,1,1,2,2,2],[1,1,1,1,1,1,2,4],[1,1,1,1,1,1,3,3],[1,1,1,1,1,1,6],[1,1,1,1,1,2,2,3],[1,1,1,1,1,2,5],[1,1,1,1,1,3,4],[1,1,1,1,1,7],[1,1,1,1,2,2,2,2],[1,1,1,1,2,2,4],[1,1,1,1,2,3,3],[1,1,1,1,2,6],[1,1,1,1,3,5],[1,1,1,1,4,4],[1,1,1,1,8],[1,1,1,2,2,2,3],[1,1,1,2,2,5],[1,1,1,2,3,4],[1,1,1,2,7],[1,1,1,3,3,3],[1,1,1,3,6],[1,1,1,4,5],[1,1,1,9],[1,1,2,2,2,2,2],[1,1,2,2,2,4],[1,1,2,2,3,3],[1,1,2,2,6],[1,1,2,3,5],[1,1,2,4,4],[1,1,2,8],[1,1,3,3,4],[1,1,3,7],[1,1,4,6],[1,1,5,5],[1,1,10],[1,2,2,2,2,3],[1,2,2,2,5],[1,2,2,3,4],[1,2,2,7],[1,2,3,3,3],[1,2,3,6],[1,2,4,5],[1,2,9],[1,3,3,5],[1,3,4,4],[1,3,8],[1,4,7],[1,5,6],[1,11],[2,2,2,2,2,2],[2,2,2,2,4],[2,2,2,3,3],[2,2,2,6],[2,2,3,5],[2,2,4,4],[2,2,8],[2,3,3,4],[2,3,7],[2,4,6],[2,5,5],[2,10],[3,3,3,3],[3,3,6],[3,4,5],[3,9],[4,4,4],[4,8],[5,7],[6,6],[12]]

 

An explanation will be provided when the efficient solution has been implemented!

Advertisements

An absolute beginner’s guide to folding in Haskell

(This is a small write-up I did on a forum for a Haskell MOOC).

foldr and foldl are simply means of reducing/accumulating/folding over values of a sequence into a single value. That’s basically it!

To make it more concrete, let’s analyse a specific implementation of foldr and foldl for Lists:

The easier one to understand is actually foldl since it is more intuitive and natural:

foldl :: (b -> a -> b) -> b -> [a] -> b
foldl f acc [] = acc
foldl f acc (x:xs) = foldl f (f acc x) xs

The first thing to do is look at the type. How does it read? In plain English, you can read that as “foldl is a function that takes three arguments: the first argument is a function that takes a value of type b and a value of type a and produces a value of type b, the second argument is a value of type b (this is the accumulator), and the final argument is a list of values of type a. The overall result is a single value of type b”. Makes sense?

With that intuition, let’s look at an example and map that to the definition itself:

Suppose you have a list, xs = [1, 2, 3, 4, 5] and you want to find the sum of all the elements of this list. Then you basically want to reduce the list into a single element under addition, right? So you can define the whole operation as: foldl (+) 0 xs.

Now see how that maps to the definition. So the first argument to foldl, which is a function, is +, and this makes sense since + is a binary function that takes two numerical values and produces their sum. The second argument, which is the “accumulator” (basically the one which keeps accumulating the results as we traverse the list) and we want to start off with 0 here since that is the identity for addition. Finally, the final argument is the list of values itself, xs.

Now look at the body of foldl. It has two patterns to match the inputs against:

1). foldl f acc [] = acc

So when we run out of values in our input list, we simply return the accumulator, which had been dutifully collecting the running sum of the elements of the list. So in our case, this would be analogous to something like foldl (+) acc [] = acc.

2). foldl f acc (x:xs) = foldl f (f acc x) xs

This is the more interesting case. Translating it to our example, we might have something like foldl (+) acc (x:xs) = foldl (+) (acc + x) xs. This is the crucial part – note the acc + x part. In the recursive call, the next value of acc will be acc + x, right? So we are collecting, in this example, the sums of the elements of the list in the variable acc. Now, the most important bit – note that acc is always the left operand of the function as in acc + xs (which, in function application form would be (+) acc xs). This is the reason why we call it “foldl” or “fold left” – we are simply reducing the list from the left to the end of the list!

So, for example:
foldl (+) 0 [1, 2, 3, 4, 5] can be expanded (conceptually) as:

foldl (+) 0 [1, 2, 3, 4, 5]
= foldl (+) (0+1) [2, 3, 4, 5
= foldl (+) ((0+1)+2) [3, 4, 5]
= foldl (+) (((0+1)+2)+3) [4, 5]
= foldl (+) ((((0+1)+2)+3)+4) [5]
= foldl (+) ((((((0+1)+2)+3)+4)+5) []
= (((((0+1)+2)+3)+3)+5) — from the first pattern in the definition of `foldl`.
= 15

As you can see, we move from left to right across the list, and keep accumulating the values as we go along. This is also the reason why foldl is much more efficient than foldr (as we will see).

Now, onto foldr. foldr is very similar to foldl, but whereas foldl fold from left to right, foldr fold from right to left! First, again, let’s look at the definition:

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f acc [] = acc
foldr f acc (x:xs) = f x (foldr f acc xs)

The type in plain English: “foldr is a function that takes three arguments – the first argument is a binary function that takes a value of type a and a value of type b, and produces a value of type b, the second argument is the “accumulator” of type b, and the final argument is the list of values of type a. The overall result is a single value of type b”.

Now taking the same example, let’s analyse the body:

1). foldr f acc [] = acc

This is identical to the first pattern in the body of foldl. This makes sense since once we have exhausted the list, we simply need to return the final result, which is stored in the running accumulator, acc.

2), foldr f acc (x:xs) = f x (foldr f acc xs)

Now, this is the tricky part and needs to be analysed carefully. The analogue of this definition for our sum example would be foldr (+) acc (x:xs) = x + (foldr (+) acc xs). What does this mean?

Well, since we want to process the list starting from the rightmost end of the list, we are forced to have to update the accumulator from the right and move towards the beginning of the list. This is what that definition basically means. So if you observe carefully, the value of the accumulator is actually given by the expression (foldr f acc xs) (or (foldr (+) acc xs) in our example). Remember that in the case of foldl, the accumulator was always the left operand. Likewise, in the case of foldr, the accumulator is always the right operand. This is why in the expression f x (foldr f acc xs), the second operand is the running state of the accumulator. Note that the full call itself cannot be fully evaluated until the (foldr f acc xs) part has been evaluated. This means that we keep on building up a stack of function calls, and only when the entire list has been consumed can we begin actually updating the value of the accumulator. This is why foldr is much slower and memory-intensive than foldl, which does not suffer from this deficiency.

To use the same example, let’s evaluate the call foldr (+) 0 [1, 2, 3, 4, 5]:

foldr (+) 0 [1, 2, 3, 4, 5]
= 1 + (foldr (+) 0 [2, 3, 4, 5])
= 1 + (2 + (foldr (+) 0 [3, 4, 5]))
= 1 + (2 + (3 + (foldr (+) 0 [4, 5])))
= 1 + (2 + (3 + (4 + (foldr (+) 0 [5]))))
= 1 + (2 + (3 + (4 + (5 + (foldr (+) 0 []))))) — we now match with the first pattern in the definition of `foldr`
= 1 + (2 + (3 + (4 + (5 + 0)))) — we now keep updating the accumulator all the way from right to left
= 1 + (2 + (3 + (4 + 5)))
= 1 + (2 + (3 + 9))
= 1 + (2 + 12)
= 1 + 14
= 15

If you observe carefully, the expressions are parenthesised from right to left whereas in the case of foldl, they were from left to right.

Now, you see that both foldl and foldr gave the same result 15 for our example. However, this is only because addition is a commutative property (just like multiplication), and that’s why it doesn’t matter if we fold from the left or from the right. So, multiplication would also give the same results for both foldl and foldr, but subtraction and division would not, since they are not commutative operations.

To confirm this assertion, just compare the outputs of the following expressions:

Prelude> foldr (+) 0 [1..5]
15
Prelude> foldl (+) 0 [1..5]
15

Prelude> foldr (*) 1 [1..5]
120
Prelude> foldl (*) 1 [1..5]
120

Prelude> foldr (-) 0 [1..5]
3
Prelude> foldl (-) 0 $ [1..5]
-15

Prelude> foldr (/) 1.0 [1.0, 2.0, 3.0, 4.0, 5.0]
1.875
Prelude> foldl (/) 1.0 [1.0, 2.0, 3.0, 4.0, 5.0]
8.333333333333333e-3

Let’s just analyse the subtraction example:

foldr (-) 0 [1..5]
= 1 – (foldr (-) [2, 3, 4, 5])
= 1 – (2 – (foldr (-) [3, 4, 5]))
= 1 – (2 – (3 – (foldr (-) [4, 5])))
= 1 – (2 – (3 – (4 – (foldr (-) [5]))))
= 1 – (2- (3 – (4 – (5 – (foldr (-) [])))))
= 1 – (2 – (3 – (4 – (5 – 0))))
= 1 – (2 – (3 – (4 – 5)))
= 1 – (2 – (3 – (-1)))
= 1 – (2 – 4)
= 1 – (-2)
= 3.

and

foldl (-) 0 [1..5]
= foldl (-) (0-1) [2, 3, 4, 5]
= foldl (-) ((0-1)-2) [3, 4, 5]
= foldl (-) (((0-1)-2)-3) [4, 5]
= foldl (-) ((((0-1)-2)-3)-4) [5]
= foldl (-) (((((0-1)-2)-3)-4)-5) []
= (((((0-1)-2)-3)-4)-5)
= -15.

Et voila!

Optional

In case you are familiar with C, the functions may be rendered thus, for instance:

// The generic foldr function
void *foldr(void *(*fptr)(void*, void*), void *acc, void *arr, size_t n, size_t delta)
{
    if (!n) {
        return acc;
    } else {
        return fptr(arr, foldr(fptr, acc, arr+delta, n-1, delta));
    }
}

// The generic foldl function
void *foldl(void *(*fptr)(void*, void*), void *acc, void *arr, size_t n, size_t delta)
{
    if (!n) {
        return acc;
    } else {
        return foldl(fptr, fptr(acc, arr), arr+delta, n-1, delta);
    }
}

Note how they map to the Haskell definitions directly.

If you are interested, here is a full program (note that this is only to simulate Haskell behaviour as closely as possible – it is not the idiomatic way to do the operations in C, and it leaks memory as well which we do not care to consider for this demo) that you can run to observe the behaviour and compare it with Haskell:

The program:

#include <stdio.h>
#include <stdlib.h>

void *add_int(void *x, void *y)
{
    int *res = malloc(sizeof(int));
    *res = *((int*) x) + *((int*) y);

    return (void*) res;
}

void *multiply_int(void *x, void *y)
{
    int *res = malloc(sizeof(int));
    *res = *((int*) x) * *((int*) y);

    return (void*)res;
}

void *subtract_int(void *x, void *y)
{
    int *res = malloc(sizeof(int));
    *res = *((int*) x) - *((int*) y);

    return (void*) res;
}

void *divide_double(void *x, void *y)
{
    double *res = malloc(sizeof(double));
    *res = *((double*) x) / *((double*) y);

    return (void*) res;
}

// The generic foldr function
void* foldr(void *(*fptr)(void*, void*), void *acc, void *arr, size_t n, size_t delta)
{
    if (!n) {
        return acc;
    } else {
        return fptr(arr, foldr(fptr, acc, arr+delta, n-1, delta));
    }
}

// The generic foldl function
void *foldl(void *(*fptr)(void*, void*), void *acc, void *arr, size_t n, size_t delta)
{
    if (!n) {
        return acc;
    } else {
        return foldl(fptr, fptr(acc, arr), arr+delta, n-1, delta);
    }
}

int sum_foldr(int a[], size_t n)
{
    int sum = 0, acc = 0;
    void *ret = foldr(add_int, &acc, a, n, sizeof(int));
    if (ret) {
        sum = *((int*) ret);
        free(ret);
    }

    return sum;
}

int product_foldr(int a[], size_t n)
{
    int prod = 1, acc = 1;
    void *ret = foldr(multiply_int, &acc, a, n, sizeof(int));
    if (ret) {
        prod = *((int*) ret);
        free(ret);
    }

    return prod;
}

int sum_foldl(int a[], size_t n)
{
    int sum = 0, acc = 0;
    void *ret = foldl(add_int, &acc, a, n, sizeof(int));
    if (ret) {
        sum = *((int*) ret);
        free(ret);
    }

    return sum;
}

int product_foldl(int a[], size_t n)
{
    int prod = 1, acc = 1;
    void *ret = foldl(multiply_int, &acc, a, n, sizeof(int));
    if (ret) {
        prod = *((int*) ret);
        free(ret);
    }

    return prod;
}

int sub_foldr(int a[], size_t n)
{
    int diff = 0, acc = 0;
    void *ret = foldr(subtract_int, &acc, a, n, sizeof(int));
    if (ret) {
        diff = *((int*) ret);
        free(ret);
    }

    return diff;
}

int sub_foldl(int a[], size_t n)
{
    int diff = 0, acc = 0;
    void *ret = foldl(subtract_int, &acc, a, n, sizeof(int));
    if (ret) {
        diff = *((int*) ret);
        free(ret);
    }

    return diff;
}

double div_foldr(double a[], size_t n)
{
    double div = 1.0, acc = 1.0;
    void *ret = foldr(divide_double, &acc, a, n, sizeof(double));
    if (ret) {
        div = *((double*) ret);
        free(ret);
    }

    return div;
}

double div_foldl(double a[], size_t n)
{
    double div = 1.0, acc = 1.0;
    void *ret = foldl(divide_double, &acc, a, n, sizeof(double));
    if (ret) {
        div = *((double*) ret);
        free(ret);
    }

    return div;
}

int main(int argc, char **argv)
{
    int a[] = { 1, 2, 3, 4, 5 };
    size_t n = sizeof(a)/sizeof(a[0]);

    double b[] = { 1.0, 2.0, 3.0, 4.0, 5.0 };
    size_t m = sizeof(b)/sizeof(b[0]);

    printf("sum_foldr = %d\n", sum_foldr(a, n));
    printf("product_foldr = %d\n", product_foldr(a, n));

    printf("sum_foldl = %d\n", sum_foldl(a, n));
    printf("product_foldl = %d\n", product_foldl(a, n));

    printf("sub_foldr = %d\n", sub_foldr(a, n));
    printf("div_foldr = %lf\n", div_foldr(b, m));

    printf("sub_foldl = %d\n", sub_foldl(a, n));
    printf("div_foldl = %lf\n", div_foldl(b, m));

    return 0;
}

Running it:

$ gcc -Wall -O2 -o fold fold.c && ./fold
sum_foldr = 15
product_foldr = 120
sum_foldl = 15
product_foldl = 120
sub_foldr = 3
div_foldr = 1.875000
sub_foldl = -15
div_foldl = 0.008333

Exactly the same result as in the case of Haskell.

The basic idea is this – take a simple example, and work through it with pen and paper to really understand how it works!

Implementing Monad for a custom List type in Haskell

As an extension to the previous blog, we finally reach the highest level of abstraction yet – the Monad. Let’s see how we can implement our custom List type as an instance of the Monad typeclass. Here is the definition of the Monad typeclass as given in the book:

class Applicative m => Monad m where
    return :: a -> m a

    (>>=) :: m a -> (a -> m b) -> m b

    return = pure

This means that in order to make our List type an instance of Monad, we will have to make it an instance of Functor as well as Applicative.

Here is a simple but comprehensive implementation:

data List a = Nil | Cons a (List a) deriving Show

append :: List a -> List a -> List a
append Nil ys = ys
append (Cons x xs) ys = Cons x (append xs ys)

instance Functor List where
    -- fmap :: (a -> b) -> List a -> List b
    fmap _ Nil = Nil
    fmap f (Cons x xs) = Cons (f x) (fmap f xs)

instance Applicative List where
    -- pure :: a -> List a
    pure x = Cons x Nil

    -- (<*>) :: List (a -> b) -> List a -> List b
    Nil <*> _ = Nil
    (Cons g gs) <*> xs = fmap g xs `append` (gs <*> xs)

instance Monad List where
    -- (>>=) :: List a -> (a -> List b) -> List b
    Nil >>= _ = Nil
    (Cons x xs) >>= f = (f x) `append` (xs >>= f)

We also define some test data to work with, and a function called pairs that simply returns the cross-product of the two input lists.


-- test data
l1 :: List Int
l1 = Cons 1 (Cons 2 (Cons 3 (Cons 4 (Cons 5 Nil))))

l2 :: List String
l2 = Cons "Hello" (Cons "World" (Cons "we" (Cons "meet" (Cons "again" Nil))))

pairs :: Monad m => m a -> m b -> m (a, b)
pairs xs ys = xs >>= \x ->
                ys >>= \y ->
                    return (x, y)

Note that the pairs function could also have been written using the do notation as follows:

pairs :: Monad m => m a -> m b -> m (a, b)
pairs xs ys = do x <- xs
                 y <- ys
                 return (x, y)

This is identical to the previous version since the do notation is simply syntactic sugar for the bind operator.

Sample test run:

*Main> :t l1
l1 :: List Int
*Main> l2
Cons "Hello" (Cons "World" (Cons "we" (Cons "meet" (Cons "again" Nil))))
*Main> pairs l1 l2
Cons (1,"Hello") (Cons (1,"World") (Cons (1,"we") (Cons (1,"meet") (Cons (1,"again") (Cons (2,"Hello") (Cons (2,"World") (Cons (2,"we") (Cons (2,"meet") (Cons (2,"again") (Cons (3,"Hello") (Cons (3,"World") (Cons (3,"we") (Cons (3,"meet") (Cons (3,"again") (Cons (4,"Hello") (Cons (4,"World") (Cons (4,"we") (Cons (4,"meet") (Cons (4,"again") (Cons (5,"Hello") (Cons (5,"World") (Cons (5,"we") (Cons (5,"meet") (Cons (5,"again") Nil))))))))))))))))))))))))

Implementing Applicative for a custom List type in Haskell

Continuing with the Haskell theme, this is a small implementation of Applicative for a custom List type in Haskell.

Here is the general definition of Applicative as given in Professor Graham Hutton’s exemplary book, “Programming in Haskell” (2nd Edition) – one of the best books on Haskell:

class Functor f => Applicative f where
   pure :: a -> f a

   (<*>) :: f (a -> b) -> f a -> fb

This means that we have to make our custom List type into an instance of Functor before we can make it an instance of Applicative. Here is the definition of Functor from the same book:

class Functor f where
    fmap :: (a -> b) -> f a -> f b

Okay, enough preamble, let’s get started with it. First, we define our custom List type:

data List a = Nil | Cons a (List a) deriving (Eq, Ord, Show, Read)

Now we define a function called append. This is our analogue of the built-in ++ generic append operator in Haskell. This will be required when implementing the Applicative code:

-- append function for our custom List type
append :: List a -> List a -> List a
append Nil ys = ys
append (Cons x xs) ys = Cons x (append xs ys)

Almost there! Let’s make our List type a Functor type:

-- make it an instance of the Functor typeclass 
instance Functor List where
    -- fmap :: (a -> b) -> List a -> List b
    fmap _ Nil = Nil
    fmap g (Cons x xs) = Cons (g x) (fmap g xs)

Simple enough – we simply implement the fmap function using Pattern Matching. Now, finally, let’s make our type an Applicative Functor!

-- now make the List type an instance of Applicative
instance Applicative List where
    -- pure :: a -> List a
    pure x = Cons x Nil

    -- (<*>) :: List (a -> b) -> List a -> List b
    Nil <*> _ = Nil
    (Cons g gs) <*> xs = append (fmap g xs) (gs <*> xs)

That’s it! We’re all done. Again, we use Pattern Matching in the implementation of , the applicative operator. As promised earlier, we make use of both fmap and append in this definition.

Finally, let’s define some test data:

-- test data
l1 :: List Int
l1 = Cons 1 (Cons 2 (Cons 2 Nil)) -- [1, 2, 3]

l2 :: List Int
l2 = Cons 10 (Cons 20 Nil) -- [10, 20]

l3 :: List Int
l3 = Nil -- []    

Let’s try out a few tests to make sure that it works correctly!

*Main> l1
Cons 1 (Cons 2 (Cons 2 Nil))

*Main> l2
Cons 10 (Cons 20 Nil)

*Main> l3
Nil

*Main> pure (+1) <*> l1
Cons 2 (Cons 3 (Cons 3 Nil))

*Main> pure (+) <*> l1 <*> l2
Cons 11 (Cons 21 (Cons 12 (Cons 22 (Cons 12 (Cons 22 Nil)))))

*Main> pure (\x -> \y -> \z -> x * y * z) <*> l1 <*> l2 <*> l1
Cons 10 (Cons 20 (Cons 20 (Cons 20 (Cons 40 (Cons 40 (Cons 20 (Cons 40 (Cons 40 <br/>(Cons 40 (Cons 80 (Cons 80 (Cons 20 (Cons 40 (Cons 40 (Cons 40 (Cons 80 <br/>(Cons 80 Nil)))))))))))))))))

*Main> pure (\x -> \y -> \z -> x * y * z) <*> l1 <*> l2 <*> Nil
Nil

*Main> pure (^200) <*> l3
Nil

*Main> pure (\x y z w -> (x+y) * (z+w)) <*> l1 <*> l2 <*> l1 <*> l2
Cons 121 (Cons 231 (Cons 132 (Cons 242 (Cons 132 (Cons 242 (Cons 231 (Cons 441 <br/>(Cons 252 (Cons 462 (Cons 252 (Cons 462 (Cons 132 (Cons 252 (Cons 144 (Cons <br/>264 (Cons 144 (Cons 264 (Cons 242 (Cons 462 (Cons 264 (Cons 484 (Cons 264 (Cons <br/>484 (Cons 132 (Cons 252 (Cons 144 (Cons 264 (Cons 144 (Cons 264 (Cons <br/>242 (Cons 462 (Cons 264 (Cons 484 (Cons 264 (Cons 484 <br/>Nil)))))))))))))))))))))))))))))))))))

Most satisfying indeed!

A simple Guessing Game implementation in Haskell

Just a quick program since it’s been some time since I updated my blog!

module Main where

import System.Random

main :: IO ()
main = do putStrLn "Try to guess the secret word ([1-100])..."
          secret <- randomRIO (1, 100)
          play secret


play :: Int -> IO ()
play secret = do guesses <- playGame secret 0
                 putStrLn $ "You win! You took " ++ show guesses ++ " guesses!"


playGame :: Int -> Int -> IO Int
playGame secret guesses = do putStr "? "
                             input <- getLine
                             let guess = read input :: Int
                             if guess == secret then
                                do return (guesses + 1)
                             else if guess < secret then
                                do putStrLn "Too small!"
                                   playGame secret (guesses + 1)
                             else do putStrLn "Too big!"
                                     playGame secret (guesses + 1)   

The code is pretty straightforward – the only tricky part I faced was implementing the random number generation (quite a complicated topic in Haskell).

Running it,

$ ghc guessingGame.hs
[1 of 1] Compiling Main             ( guessingGame.hs, guessingGame.o )
Linking guessingGame ...

$ ./guessingGame
Try to guess the secret word ([1-100])...
50
? Too small!
75
? Too big!
63
? Too big!
56
? Too small!
59
? Too small!
61
? You win! You took 6 guesses!

Exciting, eh? 🙂

Implementing Nat in Rust (a la Haskell)

The power of Algebraic Data Types comes to the fore when dealing with complex problem domains. Most modern languages tend towards supporting some form of ADTs, but the complexity of expressing such paradigms is not completely lost when compared to languages that were designed with such support in mind.

Case in point – defining the prototypical example of an algebraic data type, defining the Natural Number type (Nat). Let’s compare the naive implementation in two languages that do have varying support for ADTs – Haskell, and Rust.

First, the Haskell version. Haskell, just like ML and other members of this family, is eminently suited for describing such types almost effortlessly:

module NatDemo where

import Test.HUnit

data Nat = Zero | Succ Nat deriving (Show, Eq)

nat2int :: Nat -> Int
nat2int Zero = 0
nat2int (Succ n) = 1 + nat2int n

int2nat :: Int -> Nat
int2nat 0 = Zero
int2nat n = Succ (int2nat (n-1))

add :: Nat -> Nat -> Nat
add Zero n = n
add (Succ m) n = Succ (add m n)


-- test cases
test1 = TestCase (assertEqual "nat to int" (nat2int (Succ (Succ Zero))) 2)
test2 = TestCase (assertEqual "int to nat" (int2nat 5) (Succ (Succ (Succ (Succ (Succ Zero))))))
test3 = TestCase (assertEqual "add two nats" (add (int2nat 5) (int2nat 6)) (int2nat 11))

tests = TestList [test1, test2, test3]

run = runTestTT tests

Running it to confirm:


Macushla:Nat-in-Rust z0ltan$ ghci
GHCi, version 8.0.2: http://www.haskell.org/ghc/  😕 for help
Loaded GHCi configuration from /Users/z0ltan/.ghci

Prelude> :l Nat.hs
[1 of 1] Compiling NatDemo          ( Nat.hs, interpreted )
Ok, modules loaded: NatDemo.

*NatDemo> run
Cases: 3  Tried: 3  Errors: 0  Failures: 0
Counts {cases = 3, tried = 3, errors = 0, failures = 0}

As can be seen, it’s almost trivial to define the Nat type in Haskell, as well as write functions that operate on this type. It reads almost exactly like the mathematical version of the concept. Simply beautiful.

Now let’s show the Rust version first, and then perhaps a comment or two on the implementation.

#[derive(Debug, PartialEq)]
enum Nat {
    Zero,
    Succ(Box<Nat>),
}

/// open it up for code readability
use Nat::{Zero, Succ};

fn nat_to_int(n: Nat) -> i32 {
    match n {
        Zero => 0,
        Succ(n) => 1 + nat_to_int(*n),
    }
}


fn int_to_nat(n: i32) -> Nat {
    match n {
        0 => Zero,
        n => Succ(Box::new(int_to_nat(n-1))),
    }
}


fn add(m: Nat, n: Nat) -> Nat {
    match (m, n) {
        (Zero, n) => n,
        (Succ(m), n) => Succ(Box::new(add(*m, n))),
    }
}

fn main() {
    assert_eq!(nat_to_int(Succ(Box::new(Succ(Box::new(Succ(Box::new(Zero))))))), 3);
    assert_eq!(int_to_nat(5), Succ(Box::new(Succ(Box::new(Succ(Box::new(Succ(Box::new(Succ(Box::new(Zero)))))))))));
    assert_eq!(add(int_to_nat(5), int_to_nat(11)), int_to_nat(16));
}

Let’s make sure that it’s all in working condition:

Macushla:Nat-in-Rust z0ltan$ rustc nat.rs && ./nat
Macushla:Nat-in-Rust z0ltan$

Excellent! It all just works. However, a couple of points to notice – first of all, because Rust doesn’t really have a runtime, we need to wrap the recursive part in a Box (amongst other choices) so that the compiler knows what size the data is (a box, being a pointer, is of a fixed size determinable at compile time). Of course, the test code is positively ghastly because we have to wrap all calls with Box::new, not to mention to remember to dereference the boxed value inside the functions.

Secondly, the code is surprisingly clean for the most part. However, writing the code in not nearly as intuitive as writing the same in Haskell (or ML for that matter). I can only imagine how much more daunting the task would be in a language without pattern matching (amongst other higher-level features) such as Java. Of course we would make it work, but the distance between the intent of the code and the code itself would be much much higher. Syntax does matter, folks!

Well, that was a nice little experiment of an evening.

Mutual Recursion demo in Rust and Racket (inspired by Haskell)

This is a quick post on a Rust version of the Haskell evens and odds program demonstrating mutual recursion (as shown in Hutton’s book).

First off, the Haskell code:

  evens :: [a] -> [a]
  evens [] = []
  evens (x:xs) = x : odds xs

  odds :: [a] -> [a]
  odds [] = []
  odds (_:xs) = evens xs

A sample run:

*Main> let string = "abcde"
*Main> evens string
"ace"
*Main> odds string
"bd"
*Main> string
"abcde"

So the whole ideas is to have the evens functions display all the characters in even positions (starting from 0), and then odds function likewise display all the characters in odd positions.

The evens function acts as the actual accumulator whilst odds is only used as a trampoline for continuing the recursion.

Now, for a rough Rust version of it (preserving the original character array):


fn main() {
    fn evens<T: Copy>(xs: &[T]) -> Vec<T> {
        if xs.is_empty() {
            Vec::new()
        } else {
            cons(&xs[0], &odds(&xs[1..]))
        }
    }

    fn odds<T: Copy>(xs: &[T]) -> Vec<T> {
        if xs.is_empty() {
            Vec::new()
        } else {
            evens(&xs[1..])
        }
    }

    fn cons<T: Copy>(x: &T, xs: &[T]) -> Vec<T> {
        let mut vec = Vec::new();

        vec.push(*x);

        for e in xs.iter() {
            vec.push(*e);
        }
        vec
    }

    let string = String::from("abcde");

    println!("{}",
             String::from_utf8(evens(&string.clone().into_bytes())).unwrap());
    println!("{}",
             String::from_utf8(odds(&string.clone().into_bytes())).unwrap());

    println!("{}", string);
}

And a quick run:

Macushla:EvensAndOdds z0ltan$ rustc evens_and_odds.rs
Macushla:EvensAndOdds z0ltan$ ./evens_and_odds
ace
bd
abcde

So, as can be clearly seen, the original string is left unmodified. Of course this version looks quite dirty, but the nice bit is that &[T] accepts parameters of type Vec (or reference variants) and vice-versa. This enables using slicing extensively and naturally inside the functions. The vector copying code could, of course, be made to work with an API call, but I feel this is much better in its explicit form.

The Racket version looks much nicer, being more amenable to functional constructs than Rust:

#lang racket

(define (evens xs)
  (if (null? xs)
      '()
      (cons (car xs) (odds (cdr xs)))))

(define (odds xs)
  (if (null? xs)
      '()
      (evens (cdr xs))))

(define (main)
  (let ([string "abcde"])
    (displayln (list->string (evens (string->list string))))
    (displayln (list->string (odds (string->list string))))
    (displayln string)))

And a final run for the Racket version:

evens-and-odds.rkt> (main)
ace
bd
abcde

A bit of play with Rust macros

Here are a couple of macros that I wrote up on a slow evening. The first one provides a nice literal way of creating maps, and the second one mimicks Haskell’s list comprehension syntax in a rather crude manner.

My aim originally had been to:

  • have a simple if-then-else structure created in Rust, something like so:
    fn main() {
      let res = if 2 > 3 then "Yes" else "No";
    }
    

    However, this did not appear to be possible with the current macro support in Rust since a fragment of type expr (expression) can be followed only by the following sigils –=> ; ,. So much for that.

  • and secondly, to be able to replicate Haskell’s list comprehension syntax in its entirety, allowing for any possible generator. However, I then realised that Rust’s macro system also did not support actual evaluation of code during expansion like Common Lisp or Scheme/Racket does, even though it does work on the actual AST and not merely text. So out that went through the window as well.

So here’s the first macro demo:

use std::collections::HashMap;

macro_rules! my_map {
    ($($key: expr => $val: expr)*) => {
        {
            let mut map = HashMap::new();

            $(
                map.insert($key, $val);
            )*

          map
        }
    };
}

fn main() {
    let my_map = my_map!{
        1 => "One"
        2 => "Two"
        3 => "Three"
        4 => "Four"
        5 => "Five"
    };

    println!("{:?}", my_map);
}

Nothing fancy here, but you must say that it does look nicer, almost Ruby-esque! Here’s the code run:

Macushla:List_Comprehension_Macro z0ltan$ ./map
{2: "Two", 1: "One", 3: "Three", 5: "Five", 4: "Four"}

And here’s the poor man’s list comprehension that is not only limited in scope, but also entirely inflexible in its syntax (I just couldn’t be bothered tinkering with it for little return):

macro_rules! compr {
    ($id1: ident | $id2: ident <- [$start: expr ; $end: expr] , $cond: expr) => {
        {
            let mut vec = Vec::new();

            for num in $start..$end + 1 {
                if $cond(num) {
                    vec.push(num);
                }
            }

            vec
        }  
    };
}

fn even(x: i32) -> bool {
    x%2 == 0
}

fn odd(x: i32) -> bool {
    x%2 != 0
}

fn main() {
    let evens = compr![x | x <- [1;10], even];
    println!("{:?}", evens);

    let odds = compr![y | y <- [1;10], odd];
    println!("{:?}", odds);
}

As you can see, the ident fragments are completely for show, I cannot use .. in the generator (again due to restrictions on what can follow a expr fragment), and the guards don’t even check against the supposed identifier that’s supposed to be collecting the results into the final list/vector! Anyway, here’s the code run output:

Macushla:List_Comprehension_Macro z0ltan$ rustc list_compr.rs
Macushla:List_Comprehension_Macro z0ltan$ ./list_compr
[2, 4, 6, 8, 10]
[1, 3, 5, 7, 9]

Not too shabby, eh? In all seriousness though, while Rust’s macros are a big improvement over the debacle that is C’s macro system, the surface similarities to Racket’s powerful macro system ends right there – on the surface. As it stands now, there are far too many restrictions on the macro system for it to be considered a viable way of extending the syntax of the language, or even creating new languages (as in the Racket world).

EDIT: The list comprehension macro can actually be improved by using tt for the start and end of the range – this also allows .. to be used much in the Haskell way. Moreover, now we can actually simulate the exact Haskell syntax (for this very specific case, of course), and also make use of the identS as well.

Here’s the new code, but I’m keeping the old code up to remind myself that I can be a doddering idiot at times!

Updated macro:

macro_rules! compr {
    ($id1:ident | $id2:ident <- [$start:tt..$end:tt] , $cond:tt $id3:ident) => {
        {
            let mut vec = Vec::new();
 
            for $id1 in $start..$end + 1 {
                if $cond($id3) {
                    vec.push($id2);
                }
            }
 
            vec
        }  
    };
}
 
fn even(x: i32) -> bool {
    x%2 == 0
}
 
fn odd(x: i32) -> bool {
    x%2 != 0
}
 
fn main() {
    let evens = compr![x | x <- [1..10], even x];
    println!("{:?}", evens);
 
    let odds = compr![y | y <- [1..10], odd y];
    println!("{:?}", odds);
}

And a run just to make sure it’s working:

Macushla:List_Comprehension_Macro z0ltan$ rustc list_compr.rs
Macushla:List_Comprehension_Macro z0ltan$ ./list_compr
[2, 4, 6, 8, 10]
[1, 3, 5, 7, 9]

That’s much better!

A quick comparison of Euclid’s Algorithm in Haskell, Rust, and D

I recently procured a copy of Graham Hutton’s most excellent book, “Programming in Haskell” (2nd Edition). I had earlier worked through the first edition, and that is the book that really opened my eyes to the power of Haskell! Having become a bit rusty with my Haskell, I decided to work through the second edition book (which is considerably larger and more comprehensive). As part of that exercise, I decided to use a lazy weekend afternoon to code up Euclid’s GCD Algorithm in Haskell, Rust and in D. Just for a quick visual comparison of how the languages look. Here’s how they look:

First off, the Haskell version, which is the best looking one in my opinion:

Macushla:Playground z0ltan$ cat Euclid.hs
module Main where

euclid :: Int -> Int -> Int
euclid m n | m <= 0 && n <= 0 = error "GCD works for positive numbers only"
           | m == n = m
           | m < n = euclid m (n-m)
           | otherwise = euclid (m-n) n

main :: IO ()
main = do putStrLn "Enter the first number: "
          x <- getLine
          putStrLn "Enter the second number: "
          y <- getLine
          let x' = read x :: Int
          let y' = read y :: Int

          putStrLn $ "The GCD of " ++ x
                     ++ " and " ++ y
                     ++ " is " ++ show (euclid x' y')

Macushla:Playground z0ltan$ ghc Euclid.hs
[1 of 1] Compiling Main             ( Euclid.hs, Euclid.o )
Linking Euclid ...
Macushla:Playground z0ltan$ ./Euclid
Enter the first number:
12
Enter the second number:
18
The GCD of 12 and 18 is 6

Here’s the Rust version (a bit uglier, but the Pattern Matching is quite nice):

Macushla:Playground z0ltan$ cat euclid.rs
use std::io;
use std::str::FromStr;
use std::cmp::Ordering;

fn get_number(prompt: &str) -> u32 {
    println!("{}", prompt);

    let mut input = String::new();

    io::stdin().read_line(&mut input)
        .expect("no input!");

    u32::from_str(input.trim()).unwrap()
}

fn main() {
    let x = get_number("Enter the first number: ");
    let y = get_number("Enter the second number: ");

    println!("The GCD of {} and {} is {}", x, y, euclid(x, y));
}

fn euclid(m: u32, n: u32) -> u32 {
    assert!(m > 0 && n > 0);

    match m.cmp(&n) {
        Ordering::Equal => m,
        Ordering::Less => euclid(m, n-m),
        Ordering::Greater => euclid(m-n, n),
        }
}
Macushla:Playground z0ltan$ rustc euclid.rs && ./euclid
Enter the first number:
12
Enter the second number:
18
The GCD of 12 and 18 is 6

And finally, here is the D version – clean, succinct, and a pleasure to read as always:

Macushla:Playground z0ltan$ cat euclid.d
import std.stdio: readln, writeln, writefln;

uint get_number(string prompt) {
    writeln(prompt);

    import std.conv: to;
    import std.string: chomp;

    return readln().chomp().to!(uint);
}

void main() {
    uint x = get_number("Enter the first number: ");
    uint y = get_number("Enter the second number: ");

    writefln("The GCD of %s and %s is %s", x, y, euclid(x, y));
}

uint euclid(uint m, uint n) {
    assert(m > 0 && n > 0);

    if (m < n) {
        return euclid(m, n-m);
    } else if (m == n) {
        return m;
    } else {
        return euclid(m-n, n);
    }
}
Macushla:Playground z0ltan$ dmd -run euclid.d
Enter the first number:
12
Enter the second number:
18
The GCD of 12 and 18 is 6

One thing is for sure. Aside from syntactic differences, most modern languages are all converging in terms of paradigms and features. Hell, even keeping languages like Haskell and Idris aside, most mainstream languages are also converging on the syntactical front! Anyway, this was a fun little exercise on a slow afternoon. I personally like the Haskell version best , followed by the D version, and then finally the Rust version (ruined by the somewhat ugly I/O syntax). What do you think?

A simple Tree data structure in Haskell

This is part of my attempt to learn Haskell in a proper manner. I have been on and off learning Haskell for quite a few years now, always getting interrupted for some reason. This time, I decided to bite the bullet and get on with it!

As part of that, I started off with my favourite Haskell textbook, Professor Graham Hutton’s “Programming in Haskell”, 2nd Edition. This is arguably THE book that opened my eyes to Functional Programming in general. This book is almost perfect with one small flaw, in my opinion, of course. The bottom-up approach of solving problems is excellent, but it would have been rather nice if a small synopsis of the problem and the proposed approach were given at the beginning instead of having to read the whole code to understand it.

Having finished around half of that book, I realised that it was a bit short on examples, problems, and the downright dirty parts of Haskell, introducing IO only around the middle of the book. That’s when I decided to go for Allen and Moronuki’s book, “Haskell Programming from First Principles” to get up to speed on actual real-world programming in Haskell. The first few chapters are extremely basic (and I do find the tone a bit too prescriptive and pedantic, but that should suit a complete beginner just fine. For practice and hands-on though, it is a most excellent resource.

As part of my reboot of Haskell, I decided to implement a small Tree data structure in Haskell, all with the express aim of getting rid of the cobwebs. I can’t say that I’m too happy with my first attempt even though it clearly works more or less as expected. It feels very rough and creaky and the Null vs Leaf issue is pretty irritating as well. Well, after some more practice, I should be able to start iterating on better versions!

For now, here’s the code. It’s pretty much self-explanatory. The basic Tree type (single type parameter for now!), a helper function to create a Binary Search Tree (easier to confirm the output using preorder traversal), and the three standard binary tree traversal algorithms.

{- A binary tree implementation -}

data Tree a = Null | Leaf a | Node (Tree a) a (Tree a)  deriving Show


createNode :: a -> Tree a
createNode value = Leaf value 


addNode :: (Ord a) => Tree a -> a -> Tree a
addNode tree value = case tree of
                        Null -> createNode value
                        Leaf x -> if value <= x then
                                    Node (createNode value) x Null
                                  else
                                    Node Null x (createNode value)
                        Node l n r -> if value <= n then
                                        Node (addNode l value) n r
                                      else
                                        Node l n (addNode r value)

makeBST :: Ord a => [a] -> Tree a
makeBST [] = Null  
makeBST (n:ns) = addNode (makeBST ns) n
                     


-- inorder traversal (left, root, right)
inorder :: Tree a -> [a]
inorder tree = case tree of
                 Null -> []
                 Leaf x -> [x]
                 Node l n r -> inorder l ++ [n] ++  inorder r


-- preorder traversal (root, left, right)
preorder :: Tree a -> [a]
preorder tree = case tree of
                  Null -> []
                  Leaf x -> [x]
                  Node l n r -> [n] ++ preorder l ++ preorder r


-- postorder traversal (left, right, root)
postorder :: Tree a -> [a]
postorder tree = case tree of
                   Null -> []
                   Leaf x -> [x]
                   Node l n r -> postorder l ++ postorder r ++ [n]

A sample run:

*Main> let bst = makeBST [10,18,12,7,10,11,3,4,4,-2,-3,100]
*Main> bst
Node (Node Null (-3) (Node Null (-2) (Node (Node (Leaf 3) 4 Null) 4 (Node (Node (Node Null 7 (Leaf 10)) 10 Null) 11 (Node Null 12 (Leaf 18)))))) 100 Null
*Main> inorder bst
[-3,-2,3,4,4,7,10,10,11,12,18,100]
*Main> preorder bst
[100,-3,-2,4,4,3,11,10,7,10,12,18]
*Main> postorder bst
[3,4,10,7,10,18,12,11,4,-2,-3,100]
*Main> 

Ah well, it’s quite exciting to see something working as expected, isn’t it? Well, onwards then with Haskell (and then on to Agda and Idris, which I am very much interested in for edificational purposes!)