Common roots

This morning, Ranguard asked an interesting question on #london.pm:

 11:27 <@ranguard> What's the best way of finding the common root of two paths, 
                   e.g. for /a/b/c/d/e, /a/b/c/1/2/3 I want /a/b/c/ returned,
                   Path::Class::Dir has 'contains', but I'm not sure that's quite right?

In my copious free lunchtime, I thought I'd write a version of it in Haskell. Though Ranguard was very sensibly using Path::Class in Perl, I decided to just work on a list of values (in this case, characters).

First of all, let's zip the list of paths, together with a boolean indicating whether we matched or not:

 > zipWith (\a b -> (a==b, a)) 

We'll want to only take the ones from the beginning for which the tuple contains True in its first element:

 > takeWhile fst

And we only want the second element

 > map snd

So we just build a pipeline of these by composing the functions with the dot operator:

 > commonPrefix = map snd .    
 >               takeWhile fst .:
 >               zipWith (\a b -> (a==b, a)) 

Of course I've cheated here. The map and the takeWhile are expecting just one argument, so can be composed fine in this pipeline, but zipWith takes two arguments. I've seen people rewrite their pipelines to accomodate this, but I think it's horrible and derived a function to compose a 1-arg function with a 2-arg one. Saizan suggested the conventional name (.:) and roconnor gave a cuter implementation than mine:

 > infixr 8 .:
 > (.:) = (.).(.)

(The infixr declaration is because (.) is infixr 9, but I couldn't get it to compile like that so played around with it at random. Yes, very scientific.)

 > x = commonPrefix "abcde" "abc123"

I asked lambdabot for a points-free version of the lambda expression I pass to zipWith, but it came up with utter horrors. EvilTerran suggested the very clever looking:

 > flip ((&&& id) . (==))
 > -- or alternatively:
 > ((,) =<<) . (==)

Vincenz came up with another, perhaps more sensible option.

 >  commonPrefix = map fst . takeWhile (uncurry (==)) .: zip

This just zips all the elements together, and takes only the equal ones.

Meanwhile, back in the Perl world, Ranguard posted a solution, which Ilmari modified to use the lovely List::MoreUtils:

#!/usr/bin/perl -l

 use strict;
 use warnings;
 use File::Spec::Functions qw(catdir splitdir);
 use List::MoreUtils qw(all each_arrayref);

 my $paths = each_arrayref map { [ splitdir $_ ] } (
    '/v/f/d/index.html',
    '/v/f/d/i/a/s/s.gif',
    '/v/f/a/s/s.gif',
 );

 my @root;
 while (my ($part, @rest) = $paths->()) {
    last unless all { $_ eq $part } @rest;
    push @root, $part;
 }

 print catdir(@root);

Unlike the Haskell version, it takes any number of paths.

Which suggests an additional exercise: modify or create a Haskell function to find the longest common root of an arbitrary number of lists. Do let me know if you try this, and post your code (if you can get it past Vox's comments system ;-).