First, I'll second grep's suggestion to indent your code properly. The lack of indenting discouraged me from understanding your code, and therefore from providing in-depth comments on your code. :(

The most important optimization is to realize that anagrams only need to be tested once, because it's the set of letters that matters, not their order. For example, starting with 'topsy', if you drop the 'y' the next word could be 'post', or 'stop', or 'tops', etc., but you only need to try one of those words.

I implemented this by putting the words in a hash where the key is the sorted letters in a word. For each set of letters, I keep only the first word found, just to save memory. I also push each set of letters onto an array, grouped by length.

Once that's done, I can start looking for add-a-grams, beginning with the longest words. The first step is to set up a stack of attempted solutions. Then, in a loop, I pop an attempt off the stack and try to branch the last set of letters. Testing each branch is as simple and as fast as looking for the set of letters in the hash. Testing the few possible branches and looking for a matching word is much, much faster than testing all the words and looking for a matching branch. (Okay, so maybe that's the most important optimization. :)

For each match, push an attempt onto the stack. I stuck in an additional optimization here; if none of the branches work, I remove the original set of letters from the stack. That way I won't waste time trying the same dead end later.

Once an attempt gets down to three letters, I print the solution. I continue finding solutions at the same length. However, I don't try the shorter lengths after that, since the object is to find the longest possible solution.

My script ran in a few minutes and found 6640 add-a-grams with a word of 16 letters. I'm sure the code could be cleaned up, but I should be getting to bed.

#!/usr/local/bin/perl -w

use strict;

$| = 1;

use Getopt::Std;

use vars qw($opt_w);

getopts('w:') or die "usage: words.pl [-w <wordlist>] ";

my $wordlist = $opt_w || 'wordlist';

open(DICT, $wordlist) or                 # open word list
    die "Unable to open $wordlist: $!\n";

my(%words, @letters);

while (<DICT>) {
    chomp;
    my $letters = join '', sort split //;
    if (not exists $words{$letters}) {
        $words{$letters} = [$_, 1];
        push @{ $letters[length] }, $letters;
    } else {
        # just for fun, keep track of the word count for each set of l
+etters
        $words{$letters}[1]++;
    }
}

my(@solutions, @stack, $found);

my $i = $#letters;
while ($i > 3 and !$found) {
    print "Trying length $i.\n";

    # try each word at this length
    for my $letters (@{ $letters[$i] }) {
        @stack = [ $letters ];
        while (@stack) {

            # advance the next attempt
            my $test = pop @stack;

            if (length $test->[-1] == 3) {
                # found a solution!
                # note it, print it, go back to look for more
                $found = 1;
                print_solution($test);
                next;
            }

            # look for branches from the last set of letters
            my $continue;
            for my $branch (branch($test->[-1])) {

                if (exists $words{$branch}) {
                    # found a branch!
                    # note it and push it on the stack
                    $continue = 1;
                    push @stack, [ @$test, $branch ];
                }
            }

            if (!$continue) {
                # no branches found; prune the dead end
                delete $words{ $test->[-1] };
            }

        }
    }

    # all done with this length; go one shorter
    $i--;
}

# given a set of letters, return all possible branches
#   (set minus one letter)
sub branch {
    my($letters) = @_;

    # get all possible branches
    my @branches = map { my $x = $letters; substr($x, $_, 1) = ''; $x 
+}
                       0 .. length($letters) - 1;

    # remove duplicate branches
    my %uniq;
    @uniq{@branches} = ();

    return sort keys %uniq;
}

sub print_solution {
    my($solution) = @_;
    for my $letters (@$solution) {
        print "$words{$letters}[0] ($words{$letters}[1]) ";
    }
    print "\n";
}

__END__
[download]

Thanks alot. I took most of grep's issues to heart, but extreme incompitance prevented me from realizing that when you pass values to a subroutine they are passed by reference so passing a reference to $l and %wordspl would not really slow anything down. It will take a little time for me to really parse your code, but thanks alot. I did post a better formatted and documented version of my program as a response to grep, if you want to have a look at it. Thanks again!

sub word {
    my $word;
    foreach $word ( @{ $wordpl{$l} } ) {
        my $oword=$word; #define original word
        my $p=$l-1;
        word1($p, $word);
    }
}
[download]

Sorry about all the problems, I really am a newbie. I reformatted the code and the comments, I hope this helps. I didn't think I was using any globals besides $l, and I hadn't planed to, but didnt want to pass it every time i jumped between subroutines. I dont really understand what you mean by single element arrays slices, if you would go into a litttle more detail that would be great. Here is the updated code (mostly superfical updates):

use Strict;
$dict="<untitled:Desktop Folder:WORD.LST";
$adda=">untitled:Desktop Folder:addagram.lst";

####
#Open the dictionary file and read each word into @words
####

open (DICT, $dict) or die ("Can't open $dict: $!\n");
while(defined($line=readline(*DICT))) {
    chomp $line;
    push @words, $line;
}
close (DICT);

####
#Create a hash (%wordpl) of arrays, where each element in each array i
+s
#the same length, and the keys represent those lengths
####

foreach $word (@words) {
    push @{ $wordpl{length($word)} }, $word;
}

####
#Read the keys of %wordpl, i.e. the lengths of the elements in the arr
+ay
#@{ $wordpl{length($word)} } in @lengths and sort @length numerically
#in descending order
####

foreach $k (keys %wordpl ) {
    push @lengths, $k;
}
@lengths = sort {$b <=> $a} @lengths;

####
#Start a loop where $l is the length, or the key, for %wordpl.
####


foreach $l (@lengths) {
    word();
}

####
#Start a loop where you pick the a word in @{ $wordpl{$l} }
#and pass that word and $l-1 (index of array of words with one
#less character then aforementioned word) to word1()
####

sub word {
    my $word;
    foreach $word ( @{ $wordpl{$l} } ) {
        $oword=$word; #define original word
        my $p=$l-1;
        word1($p, $word);
    }
}

####
#Split $word from sub word into an @a, do the same for the word
#picked by WO. If the two words differ by one character, and the
#newest word ($sword) is greater then 3 characters, pass $sword
#and $p-1 (index of array of words with one less character then
#aforementioned word) to word2(). When word2() exits, exit WO
#and return to word(). If the newest word is equal to three 
#characters in length, push that word into the array of 
#add-a-grams and exit WO to word() to restart process
####


sub word1 {
    my $p=@_[0];
    my @a=split(//,@_[1]);
    my $sword;
    WO: foreach $sword ( @{ $wordpl{$p} } ) {
        my @b=split(//,$sword);
        my %seen = ();
        my @aonly = ();
        my $item;
        @seen{@b}=();
        foreach $item (@a) {
            push (@aonly, $item) unless exists $seen{$item};
        }
        if (length(@aonly)==1) {
            if ($p==3) {
                push @addw, $oword;
                last WO;
            }
            $p--;
            word2($p, $sword);
            last WO;
        }
    }
}


####
#Split $sword from sub word1 into an @a, do the same for the word
#picked by WT. If the two words differ by one character, and the
#newest word ($sword) is greater then 3 characters, pass $sword
#and $p-1 (index of array of words with one less character then
#aforementioned word) to word1(). When word1() exits, exit WT
#and return to word(). If the newest word is equal to three 
#characters in length, push that word into the array of 
#add-a-grams and exit WT to word() to restart process
####

sub word2 {
    my $p=@_[0];
    my @a=split(//,@_[1]);
    my $sword;
    WT: foreach $sword ( @{ $wordpl{$p} } ) {
        @b=split(//,$sword);
        %seen = ();
        @aonly = ();
        @seen{@b}=();
        foreach $item (@a) {
            push (@aonly, $item) unless exists $seen{$item};
        }
        if (length(@aonly)==1) {
            if ($p==3) {
                push @addw, $oword;
                last WT;
            }
            $p--;
            word1($p, $sword);
            last WT;
        }
    }
}

####
#determine the longest add-a-gram and print it and the
#others to a file
####


$lo="";
foreach $i (@addw) {
    if ( length($lo)<length($i) ) {
        $lo=$i;
    }
}




open (ADD, $adda) or die ("Cant open $adda: $!\n");
foreach $i (@addw) {
    if ($i ne $lo) {
        print ADD "$i\n";
    } else {
        print ADD "longest: $i\n";
    }
}
close (ADD);
[download]

a single element array slice is my @a=split(//,@_[1]);. @_[1] should be written $_[1]. This is spelled out when you use warnings or (-w).

Just putting use strict; (not Strict, leading upper case is generally used for modules, 'strict' is a pragma) at the top does not make your script run under 'use strict;'. The script you just posted will not even compile.

Please turn on warnings ('-w' on the shebang or 'use warnings;') and 'use strict;'. Then go through your code make it run without giving a warnings. If you have a problem, grab the section you are having a problem with and post the snippet here and ask for help.

I apoligize for not answering all of your questions outright, but you'll do much better in the long run if you go though these things yourself instead of me answering them for you. Hope you understand.

Some nodes to help you out:
• On asking for help
• How to ReadTheFineManual


Update: also chipmunk posted some good code and one of the best things to do is take some good code like chipmunk's and go through it until you understand it. (I get to thank merlyn for letting me do that to his code :) )

grep

grep> chown linux:users /world

Running on an ancient PII 266 this takes less than a minute to process the standard unix dictionary. It uses a fairly efficient algorithm. Basically we bulid a hash which has the sorted letters of the words as its keys and the corresponding words (as an array ref) as its values. Thus we have a hash like:

...
'aet' => [ ate eat ]
...
[download]

As we have represented all the words as their sorted letters in a hash we make the search quick and easy. We work from the longest keys to the shortest and use recursion to test all the possibilities. We keep a list of 'winners' - any word which is in a winning list need not be tested again when we descend to it's level.

#!usr/bin/perl -w
use strict;

# get words into an array and a hash keyed on sorted letters
open DICT, "c:/windows/desktop/unixdict.txt" or die "Oops $!\n";
my (%words,%winners);
while(<DICT>) {
    chomp;
    my $sort = join '', (sort split'',$_);
    push @{$words{$sort}}, $_; 
}

# test the words by length - longest first, don't repeat known winners
for my $word (sort {length $b <=> length $a} keys %words) {
    defined $winners{$word} ? next : test($word);
} 

sub test {
    my $word = $_[-1];
    if (length $word <=3) { winner(@_); return; }   
    my @letters = sort split '', $word;
    for my $i (0..$#letters) {
        my @temp = @letters;
        $temp[$i] = '';
        my $short = join '', @temp;
        test(@_,$short) if exists $words{$short};
    }
}

sub winner {
    local $, = "  ";
    for (@_) {
        $winners{$_}++;
        print @{$words{$_}}, "\n";
    }
    print "\n";
}

__DATA__
planetarium
manipulate
aluminate
laminate
matinal
animal  manila
milan
main
min

[blah]
[download]

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

The keys are to keep logic simple, avoid redundant work at all steps, avoid calling functions where not needed...(OK, I could speed up some more by removing the one remaining function, but that would be more trouble than I think it is worth.)

#! /usr/bin/perl -w
use strict;
use Getopt::Std;
getopts('v');
use vars qw($opt_v);

# Read the input into an array of hashes from normalized to denormaliz
+ed
# words
my @denorm_word;
print "Scanning input\n" if $opt_v;
while (<>) {
  chomp;
  $denorm_word[ length($_) ]{ join '', sort split //, $_ } = $_;
}

my $longest_seq = [];
my $longest_chrs = [];

# Find what the shortest word length is so we can break out of the
# reasoning early.
my $shortest = 0;
$shortest++ until $denorm_word[$shortest];

# Let's walk unvisited words by length first, and do depth first
# searches of sequences.  Clearing as we go of course.
LEN: foreach my $i (reverse 0...$#denorm_word) {
  if (not $denorm_word[$i]) {
    # No words
    next;
  }
  if ($i-$shortest < @$longest_seq) {
    print "Length $i to shortest $shortest can't improve, aborting\n"
      if $opt_v;
    last LEN;
  }

  print "Working on length $i\n" if $opt_v;
  foreach my $word (values %{$denorm_word[$i]}) {
    my ($seq, $chrs) = find_seq_chrs($word);
    if (@$longest_seq < @$seq) {
      $longest_seq = $seq;
      $longest_chrs = $chrs;
      print "  New longest:\n", map "    $_\n", @$seq
        if $opt_v;
    }
    if ($i-$shortest < @$longest_seq) {
      print "Length $i to shortest $shortest can't improve, aborting\n
+"
        if $opt_v;
      last LEN;
    }
  }
}

# And dump it.
foreach my $i  (0..$#$longest_chrs) {
  print "$longest_seq->[$i] + $longest_chrs->[$i] =\n";
}
print uc ($longest_seq->[-1]) .
  " (length " . (scalar @$longest_seq) . ")\n";

# Takes
sub find_seq_chrs {
  my $word = shift || return;
  my $best_seq = [$word];
  my $best_chrs = [];

  my ($out_chr, @end_list, @begin_list) = sort split //, $word;
  my $len = scalar @end_list;

  while (@end_list) {
    if (my $subword = 
      delete($denorm_word[$len]{ join '', @begin_list, @end_list })) {

      my ($seq, $chrs) = find_seq_chrs($subword);
      if (@$best_seq <= @$seq) {
        push @$seq, $word;
        push @$chrs, $out_chr;
        $best_seq = $seq;
        $best_chrs = $chrs;
      }
    }
    push @begin_list, $out_chr;
    $out_chr = shift @end_list;
  }
  return ($best_seq, $best_chrs);
}
__END__
[download]

bash-2.01$ time perl add_chain.pl /etc/dictionary 
at + r =
tar + t =
tart + s =
start + i =
traits + n =
transit + e =
straiten + o =
stationer + i =
iterations + c =
recitations + n =
interactions + d =
INDOCTRINATES (length 12)

real    0m6.708s
user    0m6.090s
sys     0m0.180s
[download]

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

my @word;

while(<>) {
 chomp;
 my $key = join '', sort split '';
 push @{$word[length]{$key}}, $_;
}


my @ana;
for my $i (reverse 3..$#word) {
  my $got_it;
  for my $key (keys %{$word[$i]}) {
    if (my @chain = find_chain($key)) {
      push @ana, @chain;
      $got_it = 1;
    }
  }
  last if $got_it;
}

for my $chain (@ana) {
  for my $key (@$chain) {
    my $len = length $key;
    print "[ @{$word[$len]{$key}} ]\n";
  }
  print "\n";
}

sub find_chain {
  my $key = shift;
  my $len = length($key)-1;
  return [ $key ] if $len < 3;
  my @rtn;
  my $old_chr = '';
  for my $i (0..$len) {
    my $tmp = $key;
    next if (my $chr = substr($tmp, $i, 1, '')) eq $old_chr;
    $old_chr = $chr;
    next unless exists $word[$len]{$tmp};
    if (my @chain = find_chain($tmp)) {
      unshift @$_, $key for @chain;
      push @rtn, @chain;
    }
  }
  delete $word[$len]{$key} unless @rtn;
  @rtn;
}
[download]

 # Use of uninitialized value, <DICT> chunk 41.
File 'untitled:Desktop Folder:Will's Stuff:Applications:MacPerl ƒ:add-
+a-gram redux'; Line 15
# Use of uninitialized value, <DICT> chunk 41.
File 'untitled:Desktop Folder:Will's Stuff:Applications:MacPerl ƒ:add-
+a-gram redux'; Line 16
[download]

#!/usr/bin/perl -w
use strict;
my ($dict, $adda, $line, @words, $word, %wordpl, $k, @lengths, $l, @ad
+dw, $oword, $lo, $i, %wordr);
$dict="<untitled:Desktop Folder:WORD.LST";

####
#Open the dictionary file and Create a hash (%wordpl) of a hash,
#where each key in 2nd hash is the same length, and the keys for
#the 1st hash represent those lengths
####

open (DICT, $dict) or die ("Can't open $dict: $!\n");
while (<DICT>) {
    chomp;
    push @{ $wordr{sort {lc($a) cmp lc($b)} $_} }, $_;
    $wordpl{length()}{sort {lc($a) cmp lc($b)} $_}++;
}
close (DICT);

####
#Read the keys of %wordpl, i.e. the lengths of the elements in the 2nd
+ hash
#in descending order Start a loop where $_ is the length, or the key,
#for %wordpl.
####

foreach (sort { $b <=> $a } keys %wordpl) {
    push (@addw, word(%wordpl, $_, $oword, @addw));
}

####
#Start a loop where you pick the a word in keys %{ $wordpl{$l} }
#and pass that word and $l-1 (index of hash of words with one
#less character then aforementioned word) to word1()
####

sub word {
    my ($word, $l, %wordpl, $oword, $p, @addw, $oword);
    %wordpl=$_[0];
    $l=$_[1];
    $oword=$_[2];
    @addw=$_[3];
    foreach $word ( keys %{ $wordpl{$l} } ) {
        $oword=$word; #define original word
        my $p=$l-1;
        word1($p, $word, %wordpl, $l, $oword, @addw);
    }
    return @addw;
}

####
#Split $word from sub word into an @a, do the same for the word
#picked by WO. If the two words differ by one character, and the
#newest word ($sword) is greater then 3 characters, pass $sword
#and $p-1 (index of hash of words with one less character then
#aforementioned word) to word2(). When word2() exits, exit WO
#and return to word(). If the newest word is equal to three 
#characters in length, push that word into the array of 
#add-a-grams and exit WO to word() to restart process
####


sub word1 {
    my ($p, @a, %wordpl, $l, $sword, @b, %seen, @aonly, $item, @addw, 
+$oword);
    $p=$_[0];
    @a=split(//,$_[1]);
    %wordpl=$_[2];
    $l=$_[3];
    $oword=$_[4];
    @addw=$_[5];
    WO: foreach $sword ( keys %{ $wordpl{$p} } ) {
        @b=split(//,$sword);
        %seen = ();
        @aonly = ();
        @seen{@b}=();
        foreach $item (@a) {
            push (@aonly, $item) unless exists $seen{$item};
        }
        if (length(@aonly)==1) {
            if ($p==3) {
                push @addw, $oword;
                last WO;
            }
            $p--;
            word2($p, $sword, %wordpl, $l, $oword, @addw);
            last WO;
        }
    }
}


####
#Split $sword from sub word1 into an @a, do the same for the word
#picked by WT. If the two words differ by one character, and the
#newest word ($sword) is greater then 3 characters, pass $sword
#and $p-1 (index of hash of words with one less character then
#aforementioned word) to word1(). When word1() exits, exit WT
#and return to word(). If the newest word is equal to three 
#characters in length, push that word into the array of 
#add-a-grams and exit WT to word() to restart process
####

sub word2 {
    my ($p, @a, %wordpl, $l, $sword, @b, %seen, @aonly, $item, @addw, 
+$oword);
    $p=$_[0];
    @a=split(//,$_[1]);
    %wordpl=$_[2];
    $l=$_[3];
    $oword=$_[4];
    @addw=$_[5];
    WT: foreach $sword ( keys %{ $wordpl{$p} } ) {
        @b=split(//,$sword);
        %seen = ();
        @aonly = ();
        @seen{@b}=();
        foreach $item (@a) {
            push (@aonly, $item) unless exists $seen{$item};
        }
        if (length(@aonly)==1) {
            if ($p==3) {
                push @addw, $oword;
                last WT;
            }
            $p--;
            word2($p, $sword, %wordpl, $l, $oword, @addw);
            last WT;
        }
    }
}

####
#print all the anagrams
####

foreach $i (@addw) {
    foreach $lo (@{ $wordr{$i} }) {
        print "$lo\n";
    }
}
[download]

One minor thing. The word file on the website contains NO uppercase letters nor any characters besides a-z (as a 'grep "^a-z"' of the file shows). So the lc is useless in this particular instance.

Thanks alot. I actually didnt realize that, i just found that particular piece of code in Programming Perl, and didnt consider the dictionary file. I was about to take it out when i thought i would leave it, just incase I decided to use a different dictionary, etc. etc. So unless I am wrong in thinking lc is pretty effiecient I think I will leave it. Then again there are ~170,000 words in that dictionary file, so 680000 lc calls might slow it down a little! :) Thanks again!

You know, I looked at that challenge a couple weeks ago, and thought nothing of it. After all, they're looking for C++ and LISP programmers (I think). It wasn't until this very afternoon that I thought about it again, and started working on it. I had a good start on it before I left work, and I was going to pick back up on it tomorrow. That is, until I read all this. It's like having the ending of a good movie ruined. *sigh* :p

"We're experiencing some Godzilla-related turbulence..."

Hey, they still have the 9 9's problem that nobody has ruined yet.

Good luck getting it to run in under 1 minute. :-)

use Quantum::Superpositions;
$nines[1] = any(9);
for $i ( 1..8 ){
        $nines[$i+1] = any eigenstates any map{
                $nines[$_]+$nines[$i-$_+1],
                $nines[$_]-$nines[$i-$_+1],
                $nines[$_]*$nines[$i-$_+1],
                $nines[$_]/any grep{$_!=0}eigenstates $nines[$i-$_+1]
        } 1..$i;
        print $nines[$i+1],"\n";
        for( $_=1;;$_++){ last unless $_ eq $nines[$i+1] }
        print "$_\n";
}
[download]

Hey, they still have the 9 9's problem that nobody has ruined yet.

Good luck getting it to run in under 1 minute. :-)

Well, I got it running in about one hour (on my ancient 200MHz 486), which is better than the few days I thought it was going to take at first :-)
(So if I run it on some new fangled 12Ghz system, it might break a minute,
right? ;-)

What matters, of course, is how many iterations it takes, and what it came down to (in my solution) was how many ways to order the 4 operators eight in a row (4**8 => 65536), times how many ways to put 9 duplicate balls in eight different buckets (which is alot, until I realized each bucket only needs to hold at most two balls, and then I filtered most of the redundant and invalid combinations from that which resulted in only 64 combinations), which resulted in about 4 million iterations of the main loop.

I'm not going to spoil the answer here (and I hope I haven't given away too much already, and only provoke "what the hell is he talking about?" responses from most people), since the add-a-gram has been done to death both here and on comp.lang.perl.misc, and I'd hate to see the same done to the 9 nines, but anyone that can filter the problem space even further has my ++'s...(hmm, wonder if I can get a job in Cambridge, MA now...)

Update: Damn! While I took a completely different approach, it'll never beat tilly's (and I suppose its not even worth pointing out that my implementation was broken, and that the corrected version will take about 2 hours to run :-)

#!perl
use strict;
use Data::Dumper;
$|++;

my %WordTree = ();
my %WordLengths = ();
my $LongWordLength = 1;

open (DATA, "Word.txt");
while (<DATA>) {
    chomp;
    my $Word = $_;
    my $Length = length($_);
    next if $Length < 3;
    $LongWordLength = $Length if ($LongWordLength < $Length);
    push (@{$WordLengths{$Length}}, $Word);
}
print "Finished reading Data\n";
close (DATA);

for (my $CurrentLength = 3; $CurrentLength <= $LongWordLength; $Curren
+tLength++) {
    print "Working on words of length $CurrentLength\n";
    my ($Word) = "";
    foreach $Word (@{$WordLengths{$CurrentLength}}) {
        my (@SortedLetters) = sort split //, $Word;
        if ($CurrentLength > 3) {
            my $TempWord = "";
            my @SplicedLetters = "";
            my $MatchFlag = 0;
            for (my $Splice = 0; $Splice <= $#SortedLetters; $Splice++
+)  {
                @SplicedLetters = @SortedLetters;
                splice(@SplicedLetters, $Splice, 1);
                $TempWord = join '', @SplicedLetters;
                if (exists($WordTree{$#SortedLetters}->{$TempWord})) {
                    if (! exists($WordTree{$CurrentLength}->{join '', 
+@SortedLetters})) {
                        push (@{$WordTree{$CurrentLength}->{join '', @
+SortedLetters}}, $Word);
                        push (@{$WordTree{$CurrentLength}->{join '', @
+SortedLetters}},
                              @{$WordTree{$CurrentLength - 1}->{join '
+', @SplicedLetters}});
                    }
                    last;
                }                    
            }
        } else {
            if (! exists($WordTree{3}->{join '', @SortedLetters})) {
                push (@{$WordTree{3}->{join '', @SortedLetters}}, $Wor
+d);
            }
        }
    }
}

my (@LongestMatch) = sort {$a<=>$b} keys %WordTree;

my $NotFoundLongest = 1;
while ($NotFoundLongest && $#LongestMatch > 1) {
    if (keys %{$WordTree{$LongestMatch[$#LongestMatch]}} > 0) {
        print "The longest length is $LongestMatch[$#LongestMatch]\n";
        print Dumper $WordTree{pop @LongestMatch};
        $NotFoundLongest = 0;
    }
    pop @LongestMatch;
}
[download]