foreach my $itemIndex (1 .. $items->Count)
{
    my ($body) = $items->Item($itemIndex)->Body =~ /MessageBody>(.*)<\
+/Mess/s;

    if ($body !~ /\S/)
    {
        die "Some appropriate error on index $itemIndex.";
    }

    CACHE_CHECK:
    foreach my $cachedItem (@cache)
    {
        my $compare = $cachedItem->[0];
        my $len = length($body) > $length($compare) ? length($body) : 
+length($compare);

        if (distance($body, $compare) / $len < $threshold)
        {
            @toBeMoved[$itemIndex, $cachedItem->[1]] = (1, 1);
            last CACHE_CHECK;
        }
    }
}
[download]

The primary differences here are:

1. I have made @toBeMoved into kind of a bit-flag. You loop through that list later and only deal with the items marked true
2. Once I find a match, I stop looking.

The second item is the major speed-up. You might not agree with it. If not, then get rid of the last. My thought was that your operation is transitive, or if A & B work and B & C work, then A & C will work. If that's not the case, then change it.

I have to say that I seriously doubt that Text::Levenshtein is the right tool for this job.

The problems are

• the algorithm is designed for contrasting phrases, two at a time.

  The numerical results of comparing A <-> B, and A <-> C, are not themselves comparable in any meaningful fashion. Even comparing two identical phrases with different amounts of whitespace between the words, or different case or just capitalisation, will result in differing scores, even though the human eye would perceive them as being similar.

• The 'score' will be affected by every character, case, whitepsace, markup, length etc.

  Simple transpositions of characters in a word, words in a sentance, or whole sentances will cause dramatic differences to be scored.

  print distance( 'the quick brown fox jumps over the lazy dog', 'jumps 
  +over the lazy dog the quick brown fox jumps' );
  
  # print '42';
  [download]

  There are an infinite number of completely unrelated pairs of sentances -- they could be on a different subject, the same subject using different words, the same words mispelt, or in an entirely different language -- that would produce a "match" for this score of 42.

You might get somewhere by applying the Levenshtein algorithm, but using the words (or their index in a lookup table) instead of characters, case-folded, excluding whitespace and markup, but you would still be fooled by simple typos and such.

The Levenshtein algorithm is all about comparative positions of similar elements. The results of any one comparision are not themselves comparable with any other.

It would be an interesting exercise to devise an algorithm that would not only compare bodies of text for similarity, but also produce a metric for each peice of text that could be compared directly with that from another.

It might work by producing a list of indices for the words (sans whitespace, markup, case etc) in a table. Then use the word indices to look up a prime number.

If 'A' was the first word in your table, it's index would be 0, that would then map to the prime 2. If 'an' was the second, that would be mapped to the prime 3, and so on.

You then multiply the prime for each word by the frequency of its occurance and sum the results.

You end up with a (huge) number that reflects both the words found and their frequencies in a semi unique way. You've thrown away 'extraneous' information, like case, whitespace etc, but also relative position. It still doesn't handle typos or foriegn languages, and it doesn't in anyway reflect the meaning of the text. The results might be interesting though.

It might be worth looking up expertise and algorithms for plagerism detection, though again, I think that these will tend to only detect similarity between two bodies of text, not produce a value by which more than two bodies can be cross related, nor scores that can themselves can be directly compared.

my @things = qw/homer bart marge maggie lisa kramer 
                jerry george elaine marge lisa/;

my %seen;

foreach my $thing ( @things ) {
    next if exists $seen{$thing};
    $seen{$thing}++;
    # Do your stuff here.
}
[download]

The above snippet keeps track of whether or not something's been seen already, and if it has, it skips to the next thing. If it hasn't seen it before, it makes a note of that thing, and then lets you do whatever processing you want.

The hash lookup is much faster than grep on an array.

The bulk of your speed problem is inherent to the notion of comparing the text of each message with the text of each other message. If you could redesign your algorithm to analyse each message once and create some sort of numeric index, sort the messages by their index, and then only compare the actual text of ones that are "close", you can speed it up to maybe O(n^2) or perhaps O(n log n) time. A modern system can probably handle that for a few thousand messages. O(n!) time, however, is right out of the question, as you will discover if you try to run it.

$;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}}
split//,".rekcah lreP rehtona tsuJ";$\=$ ;->();print$/
[download]

As can be seen, this is going to run in O((n-1)!)

I think that's actually O(N^2) which, although not blazingly fast, is much, much faster than O(N!).

-sauoq
"My two cents aren't worth a dime.";

I think that's actually O(N^2)

You may be right; I wasn't careful with my analysis of the speed of the algorithm, other than in terms of how to improve it.

which, although not blazingly fast, is much, much faster than O(N!)

No joking.

---

$;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}}
split//,".rekcah lreP rehtona tsuJ";$\=$ ;->();print$/
[download]

No joking.

Heh. Nevermind 7000 messages... 17 would be intractable. :-)

-sauoq
"My two cents aren't worth a dime.";

I'm not familiar with Text::Levenshtein, but if it can work by returning some kind of a hash or a "score" of the message, then you can do something like:

foreach my $message (...) {
   ...
   my $score_range = floor($score/$threshold);
   $index{$score_range} ||= [];
   push @{$index{$score_range}}, $message;
}
[download]

It seems you could do a great deal better by altering your approach a bit.

The method would go something like this... You start with a list of emails and you compare the first against all the rest, saving the list of distances. Sort your emails by their distance from the 'first' email. Then you sort of compress the list making further comparisons only between emails with similar distances from the original email.

This is based on the assumption that two emails which have dissimilar distances from a third can't themselves be similar. (I think this is a safe assumption with Text::Levenshtein, but I really don't have any experience with it.) If it is a safe assumption, you can probably approach a linear time solution.

-sauoq
"My two cents aren't worth a dime.";

is going to run in O((n-1)!) (if my 5 year old math is right)