Perl, Haskell, stuff
Dave Rolsky (autarch) is one of the core Moose devs, as well as the author of DateTime and HTML::Mason among others. We'd really like him to talk at the IPW, but there's just the small matter of paying his airfare from the States... Luckily, he's willing to give a special paid day's training on Moose, probably on Wednesday 21st October, the day before the conference. If we can get enough participants, we'll be able to invite him for the workshop too...
All the details are in this announcement, but I'd just like to point out:
use MooseX::Declare;
class MyApp::Status {
has 'user' => (
isa => Maybe[ MyApp::User ],
predicate => 'is_logged_in',
is => 'rw',
coerce => 1,
);
coerce 'MyApp::User'
=> from 'Str'
=> via { return MyApp::User->from_name($_) };
coerce 'MyApp::User'
=> from 'Int'
=> via { return MyApp::User->from_id($_) };
... # other global status things
}
This way we get lots of modern/enlightened/whatever Perl OO niceties
like coercion, and methods built for free, like is_logged_in.
We could also provide a custom accessor that didn't allow the user to be
updated if it's already been set, etc.
/client1/documents/invoices/23might build a chain like this:
method handle client1_documents_invoices ($invoice_number) {
$self->login or return;
$self->check_is_admin or return;
my %client_args = $self->do_client1_customizations;
my %template_args = (
$self->document_template_setup(%client_args),
$self->invoice_template_setup (%client_args),
$self->fetch_invoice( $invoice_number ),
);
$self->process_template( %template_args );
}
That would be ridiculous, as you'd have hundreds of such methods... one
of the major selling points of a framework is to allow you to combine
these little pieces flexibly and elegantly. So you end up with the
elements in the chain as separate actions... But how do we manage the
flow of data between these items (the %template_args and %client_args in
my contrived example above, for example) ?
We use the stash of course! So each action can read the values it needs
from the stash, and write things later actions will need back into it.
method an_action_in_a_long_chain () {
my $foo = $c->stash->{foo};
my $bar = do_something_to( $foo );
$c->stash->bar( $bar );
}
Hurray! Except that you may have noticed that we've reinvented passing
formal parameters and return values using global data. Welcome to 1959,
enjoy your stay in COBOL!
And of course, if we get parameters via the stash, we lose the benefits
of typing. And we have to be really certain that the bit of global data
we want has been set by the time our action gets called. And, because
we have a global namespace, we have to hope that some other action in
the meantime hasn't set the value to the wrong sort of data.
It also leads to us thinking about our data as singletons. When we
realise later that we need to call an action on two separate objects,
what do we do? We only have one global slot for the parameter name, so
we now have to set it twice (or localize it), and we have to squirrel
away the first return value before it gets overwritten (yuck)!
Spaghetti and action-at-a-distance may not be the intent of the stash,
but they do feel like the logical progression of the concept to me.
$c->stash = {
# set by a navigation component
breadcrumb => [ 'client1', 'documents', 'invoices' ],
menu_items => [ 'save', 'edit', 'delete' ],
# set by the login action
username => 'osfameron',
usertype => 'admin',
# set by the invoice action
invoice_data => $MyApp::Model::Invoice,
...
};
Again though, what's to prevent one action from stomping over the
other's data? Will the template die if it gets a hash for
invoice_data instead of a MyApp::Model::Invoice
object? What happens if some data it was expecting never got set?
What's the alternative? I suspect that a "widget" approach might be
saner, and I have to confess I still haven't looked at Reaction yet:
perhaps that's what I'm looking for?
Here's a question that came up while I've been trying to implement currying in Perl: is Currying monadic? I've tried a couple of times, but not managed to explain what I mean very well on #haskell, so let's see if a longer writeup explains it better.
My simplistic understanding of monads is that they take various things that are nests of nested expressions, and allow you to reason about them, and given them a pretty syntax that makes it look like they are in fact a sequence of commands.
For example: (pseudocode)
let a = 1
let b = 2
output a+b
(let a = 1
(let b = 2
(output a+b )))
(if file exists
(if file is readable
(if reading the file gave a string
(if the string matches a username
(do some action with the username)))))
do check file exists
check file is readable
string <- read from file
check string matches username
do something with the username
(for each i in list 1
(for each j in list 2
(is i the same as j?
(output i))))
do i <- list 1
j <- list 2
check i == j
output i
function add3 (a, b, c) {
return a+b+c
}
function add3 (a) {
return function (b) {
return function (c) {
return a+b+c
}
}
}
let add3 = do
a <- get first parameter
b <- get second parameter
c <- get third parameter
return a+b+c
(I don't understand Reader at all in fact. I must bang my head against it again, but I find it very confusing - how the monad is represented, what the functions are, and how they get magically applied.)
So, I did attempt to implement it using my Perl module
Acme::Monads. This test
shows that this sort of works:
my $add = mdo (2) {
mbind $x = Curry shift;
mbind $y = Curry shift;
return $x+$y;
};
say $add->(1)->(2); # 3, yay!
Did this explanation make any sense? Please let me know, and any comments on whether it's possible/sane to do this (writing currying as a monad) are appreciated!
"Currying" is a simple idea that is surprisingly powerful on the one hand, and which was surprisingly hard (at least for me) to get my head around - possibly because the concept didn't exist natively in the languages I learnt first.
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;
}
my $answer = add (1, 3); # 4
my $answer = add(1) # a function with $left bound to 1
->(3) # now executed with $right bound to 3
sub add {
my $left = shift;
return sub {
my $right = shift;
return $left + $right;
};
}
curry add ($left, $right) {
return $left + $right;
}
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;
}
package My::Class;
use base 'Class::Accessor';
__PACKAGE__->add_accessor('foo');
__PACKAGE__->add_accessor('bar');
__PACKAGE__->add_accessor('baz');
My::Class->add_accessor('foo');
...
package My::Class;
use Moose;
has 'foo' => ...
has 'bar' => ...
has 'baz' => ...
*{CALLER::has} = \&has;
*{CALLER::has} = has($CALLER); # assuming a currying 'has'
add = (+) -- alias
add 1 2 -- result is 3
(+) 1 2 -- also 3
add2 = (+ 2)
halve = (/ 2)
reciprocal = (1.0 /)
curry divide ($left, $right) {
$left / $right
}
my $reciprocal = divide(1); # 1 / $ARG
my $halve = flip(divide)->(2); # $ARG / 2
my $add2 = op(+ 2);
my $halve = op(/ 2);
my $contains_foo = op(=~ 'foo');
my $greet = op("Hello " .);
say $greet->('World');
I'll be doing a 3rd version of my Functional Pe(a)rls talk, about Haskell-inspired craziness in Pure Perl. And Matt Trout and Ian Norton will be talking about OO Database design, and Maildir migration, so there's something for everyone.
Please come and say hello! Perl meetups are quite informal and friendly, and we'll be meeting up for drinks at the Salisbury Pub afterwards (Perl talk strictly optional. Come for the beer, or to tell us how much you prefer C#, or that you'd rather be at PHPNW just down the road... d'oh!)
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' => {}
}
};
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;
}
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;
}
}
sub kv_list {
my $hashref = shift;
map { [$_ => $hashref->{$_}] } keys %$hashref;
}
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
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
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:
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:
And we can implement it like this:my $longest_list = longest qw( /foo /qux/wibble /foo/bar/baz /qux /foo/bar );
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:
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...)longest2 = nubBy (flip isPrefixOf) . sortBy (flip compare)
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!
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.uniqBy eq = map head . groupBy eq longest3 = uniqBy (flip isPrefixOf) . sortBy (flip compare)
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:longest4 = uniqBy' isPrefixOf . sort uniqBy' eq = map last . groupBy eq
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 "/"
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!
One assistant checked my phone in for repair, but even though I'd indicated possible water damage didn't preventatively arrange the insurance cover. The assistant the weekend later said this was a "training issue", oops, and my phone would be delivered on the 23rd of December.
Handily that was when I was travelling back from my work Christmas party. The next day would be fine, but apparently the booking system can't actually handle choosing the correct date for a delivery. But that's ok! All we had to do was game the system: pencil in a delivery for the 23rd, and get me to call back to get it booked to the 24th (the phone delivery elves work on Christmas Eve after all). Worryingly, my several phone calls were met with confusion as to why I was calling now and not the 24th (er, because that's the day after my delivery is booked), the 23rd (er, because the phone might already be out for delivery), and finally the 22nd; also with denial of there being any note left by the shop on my records to warn them that a change of date would be required. But finally, I was told to not worry: the phone would go out for delivery on the 23rd, but the company would make 3 attempts to deliver, so I'd get it on the 24th anyway. Phew.
Vodasanta did not come down my chimney on the 24th.
I went into the shop after Christmas, and was told that the delivery company had been waiting for me to call them to arrange delivery on the 24th, why didn't I call? (Apparently there were no notes on my records about the calls I did make. Naughty elves.)
So, after going into town to visit the Liverpool vodafone store 3 times, making several calls and waiting in for a whole day for a failed delivery (8:30-5:30 is apparently a decent delivery "slot"), the best they can do is arrange to deliver the handset to me. Again. The next available date is the 30th, when I'm at my parents: and they can't do better than that same time range, so if my family have other plans for the day (hardly unreasonable) then I will have to put off the delivery way into the new year.
Of course they couldn't make a reasonable offer at retaining customer satisfaction by, say, offering me an equivalent handset. This is because the insurance people already have the N95 8Gb in stock (how nice for them). I pushed this point and said I would let this lie and be happy if they could substitute me for an E71 right now in store (it was my original second choice of handset) but apparently that's "not allowed" as it's a PDA style phone. It's very important, apparently, for them only to offer a "standard" service: messing me about for 2 weeks comes as standard; actually delivering the phone that I've paid an insurance premium for does not.
The one gesture that Vodafone have made is to refund the £25 excess on the insurance claim. That's appreciated of course, but I had to ask for it after expressing my clear frustration both in the shop and over the phone to the insurance team.
Ho ho ho.
Edit (20 Jan 2009) I got a reply from a James from Vodafone on 31st December suggesting I should get in touch and he would try to resolve. Good news right? Sadly, all I got from the online form submission (including a reference I'd assumed would dispatch the query to him) was a confused reply from a generic customer service representative. I emailed James direct and heard nothing - I'm currently assuming he was an impostor pretending to be from Vodafone for comic effect.
I've since made an official written complaint to Vodafone head office, the insurance service, and the Liverpool store. I've had once reply so far from the insurance, which is fairly generic, though it does mention "On checking our records we can see that you did not make contact until 27 December 2008" - apparently it is far more likely that I lied about calling 3 times than that their record keeping is at fault.
Edit (26 Jan 2009) (Been a bit busy with long weekend away to write this up till now.) Got an email from Paul at Vodafone's customer service on the 22nd. Apparently James is not an impostor, but merely failed to get my messages because a) the code I typed in my response didn't work (apparently I shouldn't have put it in parentheses, which seems a bit silly) and b) didn't receive the email I sent (to the address he left on my comment form). Apparently the refusal to substitute the N95 8Gb with another model is because it "was and still is an expensive handset", which I do agree makes sense for their logistics, but which clearly doesn't for me as a customer.
Paul has made a credit for 2 months' free line rental, which is at least a reasonable gesture: thanks.
Every year or so I come back to the problem of writing a crossword puzzle compiler/player. I think Javascript would be the most promising for a web-based player, though I've given it a go in Java and Perl too. Modeling the problem is interesting in an Object Oriented language - I would find myself getting bogged down with "Lines" and the similarities between rows (Across) and columns (Down). I have a suspicion that OO Roles might be a more expressive way to model this. Anyway, given that I've not been writing much about Haskell 1, this is a good time to redress the balance.
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) = cDirections 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:_) _) = cOf 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 ShowNow 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 _ = FalseSo... 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 allLightsObviously 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!
Osfameron's blog on Haskell, Perl programming, stuff.