I’m certain (or at the very least hopeful) that the actual “reveal” will come later on in the series… but in the mean time, he did show one very cute mathematical trick for winning a coin game.

This is the game:

• Player 1 chooses a 3-coin combination, say Tails,Tails,Heads
• Player 2 chooses another, for example Heads,Tails,Tails
• We now throw a series of coins until one of the players’ combination is thrown in order.

You might think, given that any 3-coin combination is as likely as another (will be thrown with a 1/8 probability) that there’s nothing to choose between them. But notice that I didn’t say you threw 3 coins at a time! For example, if we throw.

1. Tails
2. Heads
3. Tails … at this point we’ve thrown 3 coins, and matched no combination
4. Tails … and now player 2 has won: coins 2-4 read Heads,Tails,Tails

If you look at these 2 combinations, you’ll see that Player 1 will win if the sequence goes: Tails,Tails,(any number of Tails), Head. Player 2 will win in any other situation, i.e. 75% of the time.
The combination the hapless participant chose (Heads,Heads,Heads) is even worse, losing 87.5% of the time!

It’s about time for me to try modelling a problem in Haskell, so let’s try this one!
I find the docs for System.Random rather confusing, but found some inspiration from a
haskell-cafe post about random coin throws and encouragement on #haskell from Luke30, Twey, and others.

I won’t go through the code in detail this time, but here are some key things to note:

• the randoms function returns an infinite stream of random things. In this case I’m using it as a stream of Bools, like [False, True, True, False, True, ...] and then converting them into [Tail,Head, ...].

  lilac pointed out that I could create an instance of Random for Coins, I’ll have a look at that soon.

• I’m using tails (nicely overloaded vocabulary ;-) to iterate the infinite sequence of coin flips, stopping when one of the players’ sequences matches.

And here’s the code:

import System.Random
import Control.Monad
import System.IO
import Data.Maybe
import Data.List

data Coin = Head | Tail
    deriving (Eq, Ord, Show)

-- Derren Brown's coin game.
-- The second winner has chosen a combination that will win
-- significantly more often

main = do
    g1 <- guess
    let g2 = counter g1
    putStrLn $ "Player 1 chooses " ++ (show g1)
    putStrLn $ "Player 2 chooses " ++ (show g2)
    coins <- coinFlips
    let winner = take 1 .  catMaybes .
                 map (win g1 g2) $
                    tails coins
    putStrLn $ "Player " ++ (show winner) ++ " wins!"

guess = do f <- coinFlips
           return $ take 3 f

counter [a,b,_] = [rev b, a, b]
    where rev Head = Tail
          rev Tail = Head

win g1 g2 l | g1 `isPrefixOf` l = Just 1
            | g2 `isPrefixOf` l = Just 2
            | otherwise         = Nothing

-- modified from
-- http://www.haskell.org/pipermail/haskell-cafe/2005-April/009687.html
coinFlips :: IO [Coin]
coinFlips = do g <- newStdGen
               let bools = randoms g
               let coins = map bool2coin bools
               return coins
      where bool2coin True  = Head
            bool2coin False = Tail

When you declare a function in currying style, each argument is taken
one at a time, returning a new, more specialised function each time,
until the function is finally executed at the end.

Consider this function:

    sub add ($left, $right) {
        return $left + $right;
    }

(Note we’re assuming that Perl has argument lists… which it can do
with Devel::Declare, but we’ll come to that in a bit). If this was
currying style then we wouldn’t call it with

    my $answer = add (1, 3);  # 4

but instead

    my $answer = add(1) #  a function with $left bound to 1
                  ->(3) #  now executed with $right bound to 3

Implementation

This is actually quite simple to implement in pure vanilla Perl.

    sub add {
        my $left = shift;
        return sub {
            my $right = shift;
            return $left + $right;
        };
    }

That isn’t very pretty or convenient though… handily there are several
modules to encapsulate this behaviour on CPAN. One of them is my

Sub::Curried. The docs mention some of the other modules with
similar functionality: mine, which uses the shiny goodness of

Devel::Declare, has the advantage that you can declare a
curried subroutine with a simple, perlish syntax: in fact you do it more
or less exactly like the example I gave above. (The difference is that
we can’t override the sub keyword, so we create a new one,
‘curry‘:

    curry add ($left, $right) {
        return $left + $right;
    }

Using D::D, the moment the Perl parser sees a symbol ‘curry’ being
compiled, it hands control to our custom parser, which then injects code
into the source while it’s still being compiled. We can do some cunning
stuff, including telling it “Hey, when you get to the end of the scope
you’re compiling, inject some more text!”

I used to keep hold of an array @filled of the partially
applied arguments and then apply all in one go at the end. But it seems
to be more elegant to actually transform into sometihng like the
“vanilla” example I gave above. I say “something like” but it’s
actually little more complicated:

    sub add {
        return ROUTINE unless @_; # a reference to this subroutine
        check_args(2, @_);        # check we weren't called with >2 args
        my $f = sub {
            my $left = shift;
            return ROUTINE ...
            check_args...         # check we weren't called with >1 arg
            my $f = sub {
                my $right = shift;
                return $left + $right; # actually do the thing
                };
            $f = ...
            };
        # now call the subroutine for each
        $f = $f->(shift) for @_;
        return $f;
    }

Yikes! The extra boilerplate is there to make sure that we get some
niceties:

• Die with informative error message if we’re called with too many
  arguments.

• Handle being called with multiple arguments: i.e. treat add(1,2)
  the same as add(1)->(2)

• When called with zero arguments, the sub returned is logically (and
  cutely!) an alias. (I think the ROUTINE trick isn’t needed, will
  probably disappear with a restructure)

• Handle functions that return multiple values smoothly (not shown
  above)

Uses of currying

OK, so we’ve done a lot of furious work behind the scenes to make
something look very simple while doing a whole lot of extra work. But
why? When you program in Haskell, you’ll find currying useful at every
turn: it’s a hunch that it’d be useful in Perl too. There are certainly
some cute examples of it in common use:

Currying the invocant

Modules that do setup on a class would often use class methods: for
example:

    package My::Class;
    use base 'Class::Accessor';
    __PACKAGE__->add_accessor('foo');
    __PACKAGE__->add_accessor('bar');
    __PACKAGE__->add_accessor('baz');

__PACKAGE__ refers to the current package, so this is the same as
writing:

    My::Class->add_accessor('foo');
    ...

It’s also utterly hideous. Moose on the other hand provides a syntax
like this:

    package My::Class;
    use Moose;
    has 'foo' => ...
    has 'bar' => ...
    has 'baz' => ...

What’s going on? Incredibly, ‘has’ is actually a class method just like
‘add_accessor’ was! But the leftmost argument (the invocant, usually
referred to as $self for object methods, or $class for
class methods) has been curried into it. This is because Perl’s
importing is dynamic and instead of just copying the method.

    *{CALLER::has} = \&has;

It can do somethingl like this:

    *{CALLER::has} = has($CALLER); # assuming a currying 'has'

Sections

In Haskell you can take references not just to functions, but to
operators.

    add = (+)  -- alias
    add 1 2    -- result is 3
    (+) 1 2    -- also 3

You can also take ‘sections’ of these operators, by ‘partially applying’
either the left or the right hand side.

    add2       = (+ 2)
    halve      = (/ 2)
    reciprocal = (1.0 /)

This isn’t the same as currying, though you could implement sections
with curried functions:

    curry divide ($left, $right) {
        $left / $right
    }

    my $reciprocal = divide(1);         # 1    / $ARG
    my $halve      = flip(divide)->(2); # $ARG / 2

That’s rather ugly though, and remembering to flip the
arguments is annoying. So, again with Devel::Declare I
implemented
Sub::Section
(not yet on CPAN, the github repo is linked for now).

    my $add2         = op(+ 2);
    my $halve        = op(/ 2);
    my $contains_foo = op(=~ 'foo');

And of course:

    my $greet        = op("Hello " .);
    say $greet->('World');

Talk

I’ll be talking about Functional Perl at the
href="http://northwestengland.pm.org/meetings/004.html">NorthWestEngland
perlmongers tomorrow Tues 5th in Manchester, UK.

• A [[Cell]] structure seems to make sense for a lot of boards. In fact, even the problems I’m looking at might be approached simply indexing into row then col each time you want to access a list. However it feels inelegant, and some of the things I want to do (looking at lines of game pieces in a given direction N/S/E/W) would be more elegant if I can simply traverse the grid in an arbitrary direction.
• morrow remembered there had been a discussion on haskell-cafe about grids (+ +) recently. It seems to be mainly about infinite grids, but has lots of interesting stuff to absorb.
• paolino remembered that comonads were useful in grid representation. I don’t understand what they are but google finds http://blog.sigfpe.com/2006/12/evaluating-cellular-automata-is.html which looks interesting.
• I think I want a zipper, but didn’t know how it would work on [[Cell]]. Saizan clarified: “if Zipper [] a is the zipper for [a], then the one for [[a]] is Zipper [] (Zipper [] a), and depending on which layer you use the next/previous operations you move in one dimension or the other”. This isn’t quite true though, as when you move up/down by rows, you have to somehow remember the columnwise index.
• (Saizan referred to fmap’ing operations to keep the columns in sync, which is, I think, a more higher-order way of doing the same thing :-)
• dolio posted an ADT representation of a grid. I don’t understand that at all yet, but it is pretty… He also wrote a Traversable instance (this would appear to be a generic way to expose functions to move around in your arbitrary datastructure)
• I decided to try to fold a [[Cell]] into a Cell { value=x, down=d, right=r }. This took me several hours last night, during which I cursed my feeble brain, and the fact that mutable references would have made the task trivial in other languages. (However, mutable references would make the grid useless for many useful things, like keeping intermediate copies of grid state). My no-doubt crappy code is on github (I’ll come back to it in more detail later)
• While I’m whining about haskell being “too hard” I should mention that I’ve got bogged down in representing grids (for games or spreadsheet) in Java, Perl, and Javascript too, so I think it may be more a case of my brain being feeble. That or I’m just overcomplicating things…
• (As I remember it, the OO representation of grids is simpler to get started with but then I get bogged down with issues of multiple inheritance etc.)

Comments and suggestions welcome, I should write a full post on this soon.

But I had intended to do a version of this in Perl. I mentioned last time that the typical approach in this language would be nested hashes… which elicited the comment:

Ugh, one of the absolute worst things with perl: nonsensical handling of nested data structures. Every other modern language does this vastly better.

Em’s fightin’ words! So let’s try it in Perl and see how it looks…

First of all we need to create the multilevel hash. We want to end up with something like this:

        {
          '' => {
                  'a' => {
                           'a' => {}
                         },
                  'qux' => {
                             'wibble' => {}
                           },
                  'foo' => {
                             'bar' => {
                                        'baz' => {}
                                      }
                           },
                  'aa' => {}
                }
        };

The usual way to do this is to maintain an idea of the node that we’re currently in, and follow it to the next item of the path, changing the $node variable to the next level down. So, if we had a path /foo/bar/baz, we’d start off with an empty hash {}, create the next node { foo=> {} } and start the process again with the new empty hash {} and the remaining path bar/baz.

Remind you of anything? I thought it looked a little like a fold with an accumulator variable: the $node is the accumulator, which is initialised to {} and which gets set to each corresponding node in turn. The path is the list that we fold over. And it tickled me that we can write:

use List::Util 'reduce';
sub mk_hash {
    my %hash;
    reduce { $a->{$b} ||= {} }
           \%hash,
           split '/'
               for @_;
    return \%hash;
}

In polite company (well, in Perlish polite company at last), calling map in a void context is frowned upon, as it’s abusing a functional operator for its side effects. Here we are abusing reduce, making it destructive on a tree, and discarding its (useless) return value (the final leaf $node element). But it does work exactly as required: (the for @_ means that we run this sick fold on each path in turn) and returns a multilevel hash.

I’m aware that the example above might confirm the original commenter’s dislike of Perl hackishness. Personally I think it’s quite cute, mixing a beautiful functional idiom with pragmatic mutation. This may be brought on by my dabbling with Perl and FP programming languages, and is probably incurable. If you are either a) disgusted or b) confused by the Perl code above, you might like to try implementing the traditional algorithm (please let me know!) We’ll have a look at the equivalent in Haskell shortly.

There isn’t a leaves function built in for multilevel hashes (we do find some in the Tree:: and Graph:: namespaces, but let’s stick with the core datastructures for now), so let’s build one. This version is actually very similar to an FP language definition I think.

sub leaves {
    my ($node, $path) = @_;
    if (keys %$node) {
        # We still have to descend into all the leaves
        map {
              my ($k,$v)=@$_;
              leaves($v, [@$path, $k] );
            }
        kv_list $node
    } else {
        # the base case - we are at a leaf, so return path!
        join '/', @$path;
    }
}

Sadly, though there’s an inbuilt iterator each, there isn’t a flat list of keys/values, so we’ll have to define the function kv_list used above. The easiest way would be:

sub kv_list {
    my $hashref = shift;
    map { [$_ => $hashref->{$_}] } keys %$hashref;
}

Though we could also create an “iterator_to_list” function that acts on each.

And now, the Haskell version: let’s start with creating the tree. Instead of a hash, we’ll use Data.Map which is similar, but has an implementation better suited to purely functional usage. Of course, we can’t use the same technique as the Perl version: we don’t have destructive mutation, and if we did a fold, it would merely return the final leaf node of each path. So we start with a simpler recursive definition. I say “simpler”, but I needed a lot of help with this. Luckily #haskell came to the rescue: rwbarton pointed out that I’d need a newtype to do a recursive map, Heffalump improved it with unNode, sjanssen and quicksilver helped with a missing node constructors etc. So eventually my naive version of the code looked like:

import qualified Data.Map as M
import Text.Regex

newtype Node = Node { unNode :: M.Map String Node }
    deriving Show

dive :: Node -> [String] -> Node
dive n     [] = n
dive n (s:ss) = let v  = M.lookup s (unNode n) :: Maybe Node
                    n' = case v of
                            Nothing -> Node M.empty
                            Just v' -> v'
                            :: Node
                in Node $ M.insert s (dive n' ss) (unNode n)

splitpath = splitRegex $ mkRegex "/"

make_tree ps = foldl dive (Node M.empty) $ map splitpath ps

This is quite clumsy, and could be improved by replacing the lookup/insertion with a single insertWith. The Data.Map API is quite large and you need to play with it a bit to get your head around it! And of course I got a better version, from sjanssen:

import qualified Data.Map as M
import Text.Regex
import Data.Monoid

newtype Node = Node { unNode :: M.Map String Node }

instance Monoid Node where
    mempty = Node M.empty
    mappend (Node x) (Node y) = Node $ M.unionWith mappend x y

splitPath = splitRegex $ mkRegex "/"

nodeFromPath = foldr (\x n -> Node $ M.singleton x n) mempty . splitPath

nodeFromPaths :: [FilePath] -> Node
nodeFromPaths = mconcat  . map nodeFromPath

There are a number of clever things here! First of all, he returns the root node using a fold, which I was dubious about being able to do. That’s because instead of diving from the root, he starts from the right (foldr) and constructs the leaf node, then inserts that as the value of the node above, all the way up to the top. Very cute. Then note that he’s using the Data.Map API elegantly: notice how he uses M.singleton where I would have naively done a fromList of a single element, for example. Also, instead of having to descend each tree, updating, he simply creates a set of single path trees, then merges them together at the end with M.unionWith. Finally, it’s using Monoids, which (as well as being a classic Doctor Who monster) is a fancy way of saying “they behave like appendable things” (more or less). In fact you could write the snippet above without, but it does give us the convenient mempty and mconcat functions.

So, which version do you prefer? I mentioned to sjanssen that I thought the Haskell one had more “concepts”, but actually both versions use folds and some sort of mapping data structure. One is destructive, the other pure.
Of course, as he pointed out, not knowing Perl, my version looked incomprehensible.
But if you didn’t know how to write the sick fold above in Perl, you could have easily written a simple recursive version. Whereas the Haskell version does require some knowledge, like the use of recursive newtypes (which I found very confusing — and hard to compile/debug) and as I’ve mentioned, the Data.Map API is large, as befits its power.

I’m too tired to attempt the leaves function in Haskell — please do comment if you give it a go!

@joel: suppose I have a list of strings (they happen to be paths) -
       how might I find only the longest instance of each path?
@joel: that is give /foo /foo/bar /foo/bar/baz /qux I only want back
       /foo/bar/baz and /qux
@joel: do I need to build a trie myself? my cpanfu is failing me

As this was a Perl channel, Penfold suggested splitting on “/” into a multilevel hash, then
outputting the leaf nodes. Then pjcj suggested, performance permitting, to go through the
list deleting each entry that is a substring of the previous entry: that is, treating the
strings simply as strings of characters.

This makes it sound like you have to compare each string with the strings shorter than it,
but it turns out that you can get exactly the right behaviour on an asciibetically sorted
list. For example, a set of paths similar to the ones Joel quoted might get sorted as:

• /foo
• /foo/bar
• /foo/bar/baz
• /qux
• /qux/wibble

You can see that this should reduce to

• /foo/bar/baz
• /qux/wibble

as the list collapses the previous element every time we realise that it is a substring
prefix of the following element.

We can do this in a single pass using a fold, which is a pattern that’s less common in
Perl than other idioms from functional programming like map and grep, but
which is implemented in List::Util‘s reduce. A typical example of reduce
might be this:

  sub sum {
    reduce { $a+$b } @_;
  }
  print sum (1,2,3); # = 6

Of course there the two elements $a and $b are the same kind of thing (a number) and the
reducing function ($a+$b) returns a number in turn. But for the longest paths problem,
we need something else: a list of results. This is a common idiom in Haskell: using an
“accumulator” as the initial value. However Perl’s reduce uses the first element
of the list as the initial value. That’s often a very good strategy often known as
foldl1, but for a long time I thought that the Perl implementation was weak as it
didn’t allow a more flexible arbitrary value. I was wrong. LeoNerd pointed out in #moose
that you can just pass the init value as the first element of the list! (This works in Perl
of course, as lists are untyped). For example, this subroutine would be a (rather silly)
way of turning a list into a list reference:

  sub as_list {
    reduce { [@$a,$b] } [], @_
  }

So, we’re going to call our function like this:

  my $longest_list = longest qw( /foo /qux/wibble /foo/bar/baz /qux /foo/bar );

And we can implement it like this:

  sub longest {
    reduce {
        my ($acc, $val) = ($a, $b); # 'accumulator' and 'value'
        my $last = pop @$acc || ''; # The "last" value is an empty string
                                    # the first time around

        # We return a list reference, which will be the accumulator 
        # the next time around
        [ @$acc,
          $val =~ /^\Q$last\E/ ? () : ($last), # collapsed, if substring
          $val ]
      }
      [],      # initial acumulator (empty list)
      sort @_; # sorted input list
  }

OK, so I promised myself I’d sketch this in Haskell too. It should be slightly simpler
as the hackish popping off the end of the list is replaced with a nice
pattern match.

  longest :: [String] -> [String]
  longest = foldl aux [] . sort
    where aux []         v = [v]
          aux xss@(x:xs) v = v :
                            (if x `isPrefixOf` v
                                then xs
                                else x:xs)

As often happens when converting an algorithm to Haskell, the result list is
backwards, as we’re consing the new result rather than appending to it. But in
fact, it’s not especially elegant: the conditional concatenation is a bit
clumsy for example. I asked for feedback on #haskell. And, as so often
happens on that channel, I got an altogether more compact version: augustss
suggested something like:

  longest2 = nubBy (flip isPrefixOf) . sortBy (flip compare)

nubBy is precisely the pattern that reduces a list based on whether adjacent elements
are to be collapsed or not. (Apparently you may need to reverse the sense of nubBy in
GHC 6.10 — I’m using 6.6.1 — which simplifies to nubBy isPrefixOf. Nothing
like backwards compatibility…)

Update: sortBy (flip compare) is dolio’s suggested improvement to the original reverse . sort. The original version does read better I think, but flipping the comparison is a bit more efficient than having to reverse the list after sorting it. It also starts to produce values lazily before finishing the sort.

Update: Pumpkin noted that a trie would be more efficient than nub… D’oh! nub, while it looks elegant and compact above is actually losing the benefit of us having sorted the list in the first place (it’s implemented using a set of chinese box filter functions – effectively the same as a linked list of comparisons. If we match the nub, this is very efficient — that’s the outermost box already! However if we’re not a prefix, then we’ll uselessly check if we’re a prefix of every other path, even though we couldn’t possibly be.

What we really need is precisely the semantics of Unix’s uniq, which expects a sorted list, and can therefore do a single pass, like our reduce version. Olathe pointed out a solution with map head . group which is almost what we want… except we need the -By version. Given a new function uniqBy, we just need to substitute it for nubBy and we’re suddenly efficient again!

  uniqBy eq = map head . groupBy eq
  longest3 = uniqBy (flip isPrefixOf) . sortBy (flip compare)

Update 2009-01-27: It occurred to me that instead of all the flipping, we could simplify uniqBy by making it take the last element instead of the head.

  longest4 = uniqBy' isPrefixOf . sort
  uniqBy' eq = map last . groupBy eq

Update: X pointed out that there’s a bug: ["/a", "/aa", "/aaa"] will all get smushed
together as they’re substrings. Actually whether this is a bug to the original specification
is debatable – Joel did mention “strings”, however he did also mention that they are file
paths, so let’s try to make them do the right thing:

In fact the basic core uniqBy' isPrefixOf . sort can remain exactly the same.
But instead of a single string "/foo/bar/baz" we’ll want to be passing
it a list of strings like ["foo","bar","baz"]. As Haskell’s list processing
is completely generic, all the building blocks like isPrefixOf and sort
will Just Work exactly as before! The only complication is splitting and joining the
strings, something that’s trivial in Perl. I
wrote about
splitting words in Haskell previously, but in the mean time Brent Yorgey has created
Data.List.Split
which should do exactly what we want. However I can’t install it on my laptop’s ubuntu packaged
ghc 6.6.1, so for now I’ll fall back to Text.Regex.splitRegex. Then, to join the
path separator again we need to intersperse it, but that doesn’t flatten the list,
so we end up with something like ["foo", "/", "bar"]. Control.Monad‘s
join function, generic as it is, actually does the right thing here. So we end
up with:

  longest5 :: [String] -> [String]
  longest5 = map rejoin . uniqBy' isPrefixOf . sort . map split
      where split   = splitRegex $ mkRegex "/"
            rejoin  = join . intersperse "/"

We can test this against an input like [ "/a", "/aa", "/a/a" ] to check it’s all
correct.

The same approach should work in Perl, except that splitting/joining will be slightly simpler,
while the equivalent isPrefixOf logic is more complex, as it doesn’t have the same
generic list comparisons. I’ll leave that as an exercise to the reader :-)

Talking of which, thanks to Will for the Python/Erlang versions in the
comments, “Anon” for an Ocaml solution, and “Programmer” for a Perl challenge
I’ll come back to if time allows.

Update 2009-01-30: Will pointed out that my “improved” testcase isn’t. Better would be ["/a", "/aa", "/b", "/b/b"] to check that /a and /aa are distinct, but /b is merged into /b/b.

He also sent an improved Erlang version, thanks!

In the OO implementations, Cells would refer to the “Light” (group of adjacent
cells running Across/Down) that they’re in. And the Light would of course refer
to the cells… this idea filled me with terror in Haskell, as it involves
“Tying the Knot”, which seems terribly clever and confusing. As it happens, you
can often get away with having mutual references in Functional Programming, as
they just spontaneously turn out not to be necessary. So far, this seems to be
the case, though I think that if I take it to the point of navigating the grid
from a UI, I may need an explicit structure to manage this, like a zipper.

This is a “literate Haskell” post. You should be able to save it as
“crossword.lhs” and run it with runghc or ghci (calling
the main function to test it).

We start off with some imports: the List and Char modules
(which I’ve naughtily not specified) and the handy join
function to flatten a list.

> import Data.List
> import Data.Char
> import Control.Monad (join)

They say that much of the work in Haskell is defining the types.
Direction is an Enum for the direction of a Light.
Cell is either a Block (a black square) or a Cell (either blank,
or already filled in). I guess I could model Block | Blank | Cell
but don’t yet see an advantage to that.

> data Direction = Across | Down
>     deriving (Show, Eq, Ord)
>
> data Cell = Cell  (Maybe Char) Coord
>           | Block              Coord
>     deriving (Show, Eq)
>
> type Coord  = (Int, Int)
>
> coord (Cell _ c) = c
> coord (Block  c) = c

Directions can be sorted (which may come in useful for showing Across
clues before Down ones), and this can be done automatically by deriving
Eq and Ord. But how would we sort a Cell? We’ll do it by the (x,y)
coordinates, which means I can’t use automatic derivation. Perhaps
I could swap the order of arguments and still use that, but for now I
defined a custom compare.

> instance Ord Cell
>     where compare l r = compare (coord l) (coord r)

Lights (distinct from Clues, which may be spread over 1 or more
Lights) are a list of cells in a given direction. (It would be nice to
specify that the cells really are contiguous, not sure if this is something
that fundeps would be useful for?)

> data Light     = Light [Cell] Direction
>     deriving (Show, Eq, Ord)
>
> -- we'll sometimes want to know the first cell in a Light:
> headC (Light (c:_) _) = c

Of course Lights are numbered… but with the algorithm that I’m using, we
don’t know the number (like 5 Across) at the time we create it. I created
a new type, LightN, but perhaps I should have modeled with a
Maybe Int instead.

> data LightN    = LightN Int Light
>     deriving Show

Now we need some test data. I started with a grid from the wonderful
Araucaria,
Cryptic
Crossword No. 24298.

> grid = textToCells [
>     "TRIPOD#        ",
>     "# # # # # # # #",
>     "PARSIFAL#RESCUE",
>     "# # # # # # # #",
>     "###            ",
>     "# # # # # ### #",
>     "ANNA###        ",
>     "# # # # # # # #",
>     "        ###PARE",
>     "# ### # #U# # #",
>     "         S  ###",
>     "# # # # #E# # #",
>     "      #INFERNAL",
>     "# # # # #U# # #",
>     "FRAGMENT#L     "
>     ]

We’re going to want to output the grid, lights, and other objects, so let’s
define some functions to do that.

> showCell (Block _)         = '#'
> showCell (Cell (Just c) _) = c
> showCell _                 = ' '

> showLightN :: LightN -> String
> showLightN (LightN n l@(Light cs d)) =
>        show n ++ " "
>     ++ show d
>  -- ++ " " ++ show (coord $ headC l)
>     ++ ": "
>     ++ show (map showCell cs)
>     ++ " (" ++ (show $ length cs) ++ ")"
>     

Similarly, we want to parse the list of strings above into a list of
crossword cells. textToCells threads the row and column
number with every character in the grid by zipping the list with the
infinite list [1..], which I think is quite cute, though
there are no doubt more elegant versions (list comprehensions?)

> charToCell :: Char -> Coord -> Cell
> charToCell '#' = Block
> charToCell ' ' = Cell Nothing
> charToCell  c
>     | isAlpha c = Cell (Just c)
>     | otherwise = error $ "Invalid character '" ++ [c] ++ "'"
>
> textToCells :: [[Char]] -> [[Cell]]
> textToCells                     = zipWith  makeRow       [1..]
>     where makeRow  row          = zipWith (makeCell row) [1..]
>           makeCell row col char = charToCell char (row,col)

But working out what cells are is the easy part! We now want to
know which cells form a light — i.e. groups of more than 1 non-block
cell in either direction Across/Down. To get data for both directions,
it’s easiest to run in two passes, one in the normal direction, the
other transposed. (I did consider trying to do both at the
same time, but it hurt my brain: a one pass solution involving magical fumplicative
arroids or somesuch is left as an exercise to the very clever reader).

> lights dir grid = concatMap
>                     (flip lightsInLine dir)
>                     $ rot dir grid
>     where rot Across = id
>           rot Down   = transpose
>
> lightsInLine :: [Cell] -> Direction -> [Light]
> lightsInLine cells dir =
>     let l  = filter isMultiCell
>                $ groupBy areCells cells
>     in  map (\c -> Light c dir) l
>
> areCells x y = isCell x && isCell y
> isCell (Cell _ _) = True
> isCell  _         = False
>
> isMultiCell (x:y:_) | areCells x y = True
> isMultiCell _ = False

So… where have we got with all of this modeling? Well, we can now
find all the Across and Down lights. But then we’ll want to number
them. To do that, we’d have to sort them (by the coordinate). Across and
Down lights can have the same number (like 5 Across and 5 Down in our
example grid) so we want to group by lights that have the same head cell.
Then we can thread the light number again, using the zipWith ... [1..]
trick:

> allLights = join $ zipWith (map . LightN) [1..] gs
>         where gs = groupBy eqHead ls
>               ls = sort $ (lights Across grid)
>                        ++ (lights Down   grid)
>               eqHead l r = (headC l) == (headC r)

And finally, we can see the result of all the hard work, with a list of
all the lights, and their current (partial) solutions:

> main = mapM_ putStrLn $ map showLightN allLights

Obviously this is only a start on the problem. For modeling, we now need a
concept of a Clue (Clue String [Light]) and a solution – should the
solution belong to the clue? or to the [Light]s that it’s made up of.
How do we link the answer grid (where the lights contain the correct characters)
with the play grid, which contains the current letters that the player believes
to be right? And how do we update the cells, lights, and grid while playing
(or creating) a crossword?

Suggestions on these questions, and improvements or advice on the current code
are greatly appreciated!

1. 
   I had a complaint about this from a Planet Haskell reader: and though
   the FAQ does suggest
   that it’s ok, or even encouraged to write about other things, perhaps
   I should also write a little about Haskell… ;-)

   back

Starting with a string of jumbled letters, the goal is to make the longest possible
anagram. I remember the first time I tried to solve anagrams I jumped into the
problem without thinking and got mixed up in all kinds of complicated combinatorial
mess. The actual answer is very simple: let's take two words which are anagrams of
each other:

• monad
• nomad

Both of them contain the same letters, so they are identical in some form of "canonical
representation", for example

• {a:1, d:1, m:1, n:1, o:1} — dictionary mapping letter to number of times used
• "admno" — a string with the letters sorted

So we just need to consider all the subsets of the original jumbled letters in turn, and
compare them against a map of:: canonical representation -> [list of words].

So for example:

pmqnrdzoa... m n d oa...

This function is called a powerset. I'm lazy so I googled
a definition.
We want the longest words first. The definition of powerset I found does a
depth first search so it's not in order of length. What we want to do
is to work on a list like this

list s =                  sortBy (flip $ comparing length)  -- longest first                . nub                -- unique entries only                . powerset           -- all combinations of                 . canonicalize       -- canonical (sorted) string                $ s

where canonicalize is just sort . map toLower . filter isLetter.

comparing is a nice litle utility sub that makes the above effectively the
same as (\a b -> length a `compare` length b). We then flip it to reverse the
ordering (and this is actually a good use for flip ;-).

Ordering by length is potentially inefficient — it checks the length of each
element twice, and unlike Perl (where a string knows its own length), a string is
just a list, so it has to descend the list to find it out. This is easy to optimize
by precalculating the lengths, using a technique that in Perl we call the "Schwartzian
transform", and I'll probably come back to this.

OK, so we have a list of subsets to compare, now we need to find a dictionary of
canonical representations of words. Luckily most unixy distributions ship with
one, often /usr/dict/words, but Ubuntu sticks is elsewhere.

I asked on #haskell, and was told I should use a Data.Map, Haskell's
basic equivalent of a hash or associative array, but implemented using a
Functional Programming friendly tree representation. In actual fact,
quicksilver, mrs, and mmorrow told me the answer straight away, but let's
pretend for the purpose of this post that we're working it out now :-)

Assuming I load that
module, as is common, as M, I'd essentially want to call
M.insertWith (++) on each element. The (++) is the
concatenation operator, and it's the right thing to use because the
dictionary is mapping String -> [String], for example

fromList [("admno", ["nomad","monad","Damon"]),...]

insertWith returns a new copy of the Map each time. It's like an accumulator
which gradually takes on the entries from the list of words. And whenever we think
about accumulators, we can think about folds.

foldl' (\m x -> M.insertWith (++) (canonicalize x) [x] m) mempty listOfWords

mempty is shorthand here for "an empty Data.Map". But we can go one better as
apparently fold/insertWith is so common that there is a shorthand, fromListWith!

fromListWith (++) . map (canonicalize &&& return)

Woah! That's quite compact, and I just introduced some new syntax too: The
&&& is basically saying "let's make a tuple with
the result of calling these 2 functions on my input!" so it's the same as

fromListWith (++) . map (\a -> (canonicalize a, return a))

And return just means "wrap this value in the appropriate Monad". So it's
a scary way of saying [a], because we're "in" the List monad. (In the same way
that mempty above was an empty Data.Map, because it was "in" the Map Monad.)

Whenever I play with Map, I get angry errors about the monomorphism restriction.
The way around that is to add an explicit type signature. If, like me, you're not
quite sure what to put there, you can add a compiler directive to quell the error,
then work out what the signature would be by calling :t my_function from the
GHCI command line. (You'll often find afterwards that you can remove the signatures
if you wanted to, because later on the compiler has more information to work out the
types of things. It's only really during incremental development that you
get the problem.

{-# LANGUAGE NoMonomorphismRestriction #-}-- (that's the compiler directive, you can comment this out later)

makeAnag s = do    d <- dict    return $ take 4 $ getAnagrams s d

dict = do file <- readFile "/etc/dictionaries-common/words"          return $ mkdict $ lines file

mkdict :: [String] -> M.Map String [String]mkdict = M.fromListWith (++) . map (canonicalize &&& return) . filter longEnough

longEnough = (>=3) . length

As you can see, for all the perceived difficulty of doing IO in a pure language
like Haskell, it doesn't seem all that hard in this simple case. readFile
reads the file, and lines splits it into an array of lines.

The final thing is to check each powerset against the dictionary.
To extract the value, we use M.lookup. This function fails if it
can't find a value. So we could do

• For each powerset in the list
• Check if it's present
• And add it to the list if so

Which of course we could do with the Maybe type and a filter.
But we want a list, and in the List type, failure is represented by an empty list
[]. So we can just map and we'd get something like:

[ ["anagram"], [], [], ["anagram 1", "anagram 2"], [] ]

With an empty list for each failure. We can use concatMap to join these together. So it's:

concatMap (\v -> M.lookup v dict) listOfPowersets

Though that actually returns:

[ ["anagram"], ["anagram 1", "anagram 2"], ]

which I hadn't expected. (M.lookup returned a list like ["anagram
1", "anagram 2"].
Quite literally it returned it, which in List context means it
actually passed [["anagram 1", "anagram 2"]], which is why the list isn't completely
flattened by concatMap. I get around this by using join. This is another of those
monadic functions: in List context it does exactly what we want here, flattening this list.

getAnagrams s d = join                 . concatMap (flip M.lookup $ d)                $ filter longEnough  -- 3 or more letters                . sortBy (flip $ comparing length)  -- longest first                . nub                -- unique entries only                . powerset           -- all combinations of                 . canonicalize       -- canonical (sorted) string                $ s

You can look at the final Haskell Countdown code. I'll look at optimizing the sort and the powersets soon, any comments on
other improvements (including better algorithms) very welcome.

First of all, the question of how to model "types" is easily resolved. We bless each
monad into the Monad class or a subclass. These can then have methods for
bind and return etc.

Now I do like the haskell >> and by a stroke of good fortune, Perl allows
us to overload that symbol too.

use overload '>>'   => 'Bind';

I use the string 'Bind' rather than the reference \&Bind, so that
the subclasses can easily override it.

Some default bind methods in Monad.pm and Monad::Maybe etc.,
available here and
we have some simple examples like this one (in test.pl):

my $result =       (Writer 2) >>      L { my $x = shift; (Writer $x*2, "Doubled. ") >>      L { my $y = shift; (Writer $y+1, "Plus 1. ")  >>      L { my $z = shift; (Writer $z*3, "Tripled $z. ")       }}};

Woot! OK, that's not entirely beautiful, but it's been slightly improved by the
overloading of >>.

The L lambda generator is also there for readability. It's basically defined as

sub L (&) { shift }

i.e. it's an identity function, but it's an L (like lambda) and to my mind, lined up on
the left, it looks pleasingly like "and then".

Nests

This didn't just fall straight out of the text editor into fully working code, of course.
A blow-by-blow account of me getting confused wouldn't be especially interesting, but one
big "aha" moment is worth pointing out. I realised that I was thinking of monads as being
a chain of lambdas, each one passing control to the next, like OO chaining:

But that doesn't work, as of course then the $x, $y,
$z of each scope would be separate, whereas in fact, in "later" sections, you
can refer to $x too. This implies that the model is more like a nest of lambdas:

This is made fairly clear in the Perl above, with its delimited braces, if you look at
where the closing "}" are, and which opening "{" they match up with.

This is an interesting mind shift, and one that I still haven't really fully grasped, as
I'll demonstrate a bit later.

Polymorphic functions on monads

In Haskell, you can call "return" in a monadic block to "lift" a value to
the appropriate monad. Similarly, you can call "fail", and the function
will fail in the right way (returning Nothing in a Maybe, throwing an error
in IO). This is a function call, not a method, so how does it know which monad to
behave as?

Of course Haskell does this with its strong inferencing typechecker. The
compiler "knows" that we are in Maybe, so "fail" will be fail :: Maybe.

Perl on the other hand doesn't have a strong type-inferencing compiler…
Right now I'm doing some shonky magic with caller() that works in this
very simple test case (and I believe only in this test case). I think I
could just simplify things and set a dynamic variable "$Monad::current_monad"
on the first occurrence of Bind. Yeah, global variables, yuck. The
final alternative that occurs to me would be to run the whole thing in a Reader
monad which just passes the name of the monad… but I'm fairly sure that's
slightly insane.

So what can it do right now?

The test script shows
the current capabilities. As of r246, I have Writer, Maybe, and List implemented (the
Monad superclass is effectively Identity).

I think Maybe is very useful – with some wrapper functions that raise Perl functions to
monadic ones using a variety of strategies (fail on undef/0/die etc.) it could be a useful
addition to the toolbox, simplifying a nested set of if checks.

The List monad already does list comprehensions, albeit with a rather yucky syntax.
Which is of course the big problem, 'cos Perl programmers (and this statement may surprise
non Perl programmers :-) are often obsessive about syntax.

Making it look pretty

OK, so we already added a bit of sugar with the >> overloading, and the
L function for lambda generators, but it's still rather ugly with the mix of
Perlish argument unpacking (my $x = shift), scope delimiters (}}}) etc.

Source filters!

The original Perl monad
tutorial used a source filter to give a monadic Do notation. It's a fairly
nice one as they go, but I don't really want to treat my program as a string if
I can help it, so let's look at some other techniques first!

Devel::Declare

Matt Trout has been working on some crazy parsing magic in
Devel::Declare.
This isn't a source filter, but (I think) hooks into Perl's parser to change the way that
subroutine declarations are parsed. It'd designed to give us parameter
unpacking, so that we could substitute:

L {my $x = shift; .... }

with:

L ($x) { .... }

In the current version this doesn't work (you can define L like that
easily, but the overloaded >> evidences a minor parsing bug
(you'd have to put the expression between parentheses to get the precedence
right, which loses the syntactic advantage we gain).

Still, hopefully will be fixed in a future release.

Generators

"Valued Lessons" has a beautiful post on Monads
in Python (with nice syntax!). The parenthesis is not hyperbole: the post describes
a monadic do block which looks about as pretty as Haskell's, but which works in a different
way. We spell 'bind' (Haskell's <-) as 'yield'. So a control sub
calls the 'do' block, gets out monadic values one by one as they are yielded back,
and deals with the nitty gritty of binding them to the rest of the generator.

It took quite a while to understand the Python code: in fact I'm not sure I understand
it fully, I really don't buy into the "Python is so easy to read" meme, and certainly
the "@whatever" syntax, which seems to be 'decorators' that modify the subroutine
that follows them, are rather confusing at first. But it's quite impressive, and it took
me a while to replicate in Perl.

First hurdle: Perl doesn't have generators. OK, that shouldn't be an issue, I thought,
because we have the CPAN. And yes, I found Brock Wilcox's
Coro::Generator.

This doesn't quite do what I want though. The yield only works one way, so

my $x = yield (Monad 3);

doesn't actually bind $x to 3. I asked Brock on IRC, and apparently this behaviour is
desired (I'm not quite sure why) so I forked his code to play with it :-)
Also, the coroutine restarts immediately it finishes, which is inconvenient.
Brock suggested yielding undef at the end, which is fine, I can do that from the
control sub.
(The Python version deals with finishing by throwing an exception, so perhaps
it has the same semantics?)

After a lot of ugly pain, I finally got this working, and we can now do:

my $result = Do {    my $x = yield (Just 3);    my $y = yield (Nothing);    my $z = yield (Just 5);    warn "x=$x, y=$y, z=$z";    Just 6;

Why the pain? Failing to understand coroutines while trying to use them to implement monads
(which I understand only very slightly) was a bad start. I found myself using the Do function
to repeatedly take a value from the generator and bind it with the next value (rather than
letting the monadic bind deal with those details). And even when I'd realised that the
sub that I needed to bind was a lambda that would abstract the details of invoking the coroutine,
I still ended up flailing around more or less at random till I finally got it working.

The current code is ugly (declared inline in test.pl rather than modularized) but
the result is pleasantly magical and readable.

Props of course to Python for having powerful techniques like yield and decorators
in core!

Hold the champagne

Of course the final test example, in the List monad doesn't work. Why? The List monad's
bind strategy is to call the function on every element of the list, so the coroutine will get
called repeatedly. And every time it's called, the execution pointer will move on.

I wonder whether the Python version has the same problem? I looked again at
the Coro modules on CPAN, and noted that they are advertised as being able to
implement "(non-clonable) continuations". I think this is the problem: I want to be
able to take the point at which the next Bind will be called, and call exactly that same
point multiple times (for the List monad). I asked various people including Brock again,
and Scott Walters (the authors of Continuity, a
continuation-based web application framework in Perl) and got the answer that Perl
really doesn't do proper continuations. (As far as I understood it, they're more or
less practically impossible, due to the way Perl models its execution context).

So, unless I've misunderstood (and please let me know if I have!) this technique is
limited to monads that only call the bound function once (e.g. most of them except List).
That's a shame though, as the List comprehension semantics would be lovely to express
in a monadic do block.

Meta continuations

The Valued Lesson post does implement continuations monadically… Could we do that
and then implement monadic do using these monadic continuations? I think the answer might be
"Yes but my brain would explode trying to implement it".

Plan B

I think that the most sensible method may be to take the contents of the monadic do
block and use the B:: modules to convert them from what looks like

my $x = bind ...;

to

... >> sub { my $x = shift;

. Which
is pretty much the approach of Greg Buchholz's source filter. But I think a parse
tree transformation may be more elegant. (This said, I don't know the Perl source
or understand the opcodes, so it may just be slightly crazy).

Update: Some discussion on reddit, as Vox still doesn't support OpenID

]]> http://greenokapi.net/blog/2008/06/13/monads-in-perl-take-1/feed/ 0 http://greenokapi.net/blog/2007/11/12/haskell-words-and-perl-split/ http://greenokapi.net/blog/2007/11/12/haskell-words-and-perl-split/#comments Mon, 12 Nov 2007 13:18:11 +0000 admin http://osfameron.vox.com/library/post/haskell-words-and-perl-split.html?_c=feed-rss-full Haskell’s prelude has a function words that splits a string by spaces.

 Prelude> words "nice cup of tea" ["nice","cup","of","tea"]

Apparently the question comes up quite regularly on irc or
haskell-cafe as to why this function is specialised to split only on
whitespace. Perl’s split, for example, can split on any character, or indeed string or regular expression.

As quicksilver has suggested, the split function is more complicated than you might think:

• character/string/regular expression
• include the split token in the list?
• collapse empty tokens?

and therefore perhaps the reason that there is no general function, is that it would require a very complex type.

I thought about this some more, and if I’ve got anything at all
about functional programming, it’s that you can build up progressively
more complicated functions from smaller pieces. I wondered if I could
do the same with split.

After playing a little with unfoldr, I decided I was better
off using a simple recursive solution for now until I understand it
better. But the first thing I need is a function to split a string just
once.

 > splitOne = splitOne' [] >  where splitOne' acc p []         = (acc, Nothing, Nothing)                                                              >        splitOne' acc p xs@(x:xs') =  >            let m = p xs                                                                         >            in case m of                                                                                    >                Just (s, rest) -> (acc, Just s, Just rest)                                                  >                Nothing        -> splitOne' (acc++[x]) p xs'

splitOne takes a function which either returns the separator and the
rest of the string, or Nothing. We iterate the list of characters,
stopping at the first where this function matches. Examples of these
functions:

 > onCharP p xs@(x:xs') | p x    = Just ([x], xs') >                      | otherwise = Nothing                                                                                  > onChar c = onCharP (==c)

 > onSpace = onCharP isSpace > onComma = onChar  ','

At which point we can do:

 *Main> splitOne onSpace "nice cup of tea" ("nice",Just " ",Just "cup of tea") *Main> splitOne onSpace "nice" ("nice",Nothing,Nothing)

So we now need to run for the whole length of the string, which is where the actual split function comes in.

 > split t p [] = [] > split t p xs = let (tok,sep,rest) = splitOne p xs >                    res = t (tok,sep) >                 in  case rest of >                      Nothing    -> res >                      Just rest' -> res ++ split t p rest'

split takes a transformation function as well as a
predicate. This takes the lists of (separator,token) and transforms
them as required.

 > onlyToken :: (t, t1) -> [t] > onlyToken (x,_)  = [x]

 > -- onlyWord ("",_) = [] > onlyWord ([],_) = [] > onlyWord (x, _) = [x]

 > tokenAndSep (t, Nothing) = [t] > tokenAndSep (t, Just s)  = [t,s]

This means that you can write the words function, as well as a function to split on commas, with different behaviours.

 > words  = split onlyWord    onSpace > commas = split tokenAndSep onComma

As quicksilver suggested, split does indeed have a rather complicated type:

 *Main> :t split split :: (([a1], Maybe a2) -> [a]) -> ([a1] -> Maybe (a2, [a1])) -> [a1] -> [a]

but the final function is simple enough. I did promise that we’d be
able to split on words as well as characters, and this is why splitOne
runs the predicate against xs instead of just the head of the list.

 > onPrefix :: Eq a => [a] -> [a] -> Maybe ([a], [a]) > onPrefix = onPrefix' [] > where onPrefix' :: Eq a => [a] -> [a] -> [a] -> Maybe ([a], [a])            >        onPrefix' acc [] s2 = Just (acc, s2) >        onPrefix' acc _  [] = Nothing                                         >        onPrefix' acc s1 s2  >           | (head s1) == (head s2)  >                 = onPrefix' (acc++[head s1]) (tail s1) (tail s2) >           | otherwise = Nothing

Which gives us:

 *Main> split onlyWord (onPrefix "and") "sex and drugs and rock and roll" ["sex "," drugs "," rock "," roll"]

OK, this is still missing two important things from the Perl function:

• split on a regexp. You could use some parser combinator as the splitOne predicate.
• split a certain number of fields and then stop, like so:
  

    DB> x split /,/, "red,green,yellow,blue", 3  0  'red'  1  'green'  2  'yellow,blue'

  This one, I haven’t really thought enough about how to implement, without complicating things.

As usual when I start on Haskell, I’m missing some obvious way to
make the API not suck horribly, so comments and criticism very welcome.

Update Nov 15:

Thanks to everyone who responded here and on reddit (it is a constant source of pleasure and amazement that people find these silly posts worth commenting on :-)

Andrew, vincentk, and geezusfreak commented that splitting a string
is really a form of parsing, and therefore they would use a proper
parser library like Parsec. Good point, though split in Perl is often
“just good enough” as a lightweight solution. I’d like to see a
solution in Parsec or similar though.

Mamie Camacho suggested to use Text.Regex:

I had a play with this and it’s quite simple to do something like:

 > splitRegex (mkRegex "\\s*,\\s*") "eggs,ham, whatever"

Haskell’s string quoting is less pleasant than Perl’s (having to
quote the backtick) and this version doesn’t seem to have the semantics
of keeping the separator in capture brackets. (e.g. if you use the
string “(\\s*,\\s*)“)

Other good suggestions included starting from the source of words and deriving a more general solution from that. Thanks again!

]]> http://greenokapi.net/blog/2007/11/12/haskell-words-and-perl-split/feed/ 1