#!/usr/bin/perl -w

use constant INTERESTING => 8; # minimum chunking threshold
use strict;

sub min_chunks {
    my ($x, $y) = @_;
    my @chunks;
    my $c = 0;
    die "Can't use arguments to min_chunks" if $x =~ /\W/o or $y =~ /\W/o;

    # Build a list of all possible chunks of $x.
    for (my $i = 0; $i < length $x; $i++ ) {
	for (my $j = 1; $j <= length($x) - $i; $j++ ) {
	    push @chunks, substr($x, $i, $j);
	}
    }

    # Make a regex out of them, largest first.
    my $regex = join "|", sort { length $b <=> length $a } @chunks;
    print $regex, "\n";

    # Count the chunks.
    print($y, "\n"), $c++ while $y =~ s/($regex)/" " x length $1/ies;
    return $c;
}

my (%sorted, %anagram);

while (<>) {
    chomp;
    next if /[\d\W]/;

    # Case-insensitively sort the letters in $_ into $s, and hash $_ by $s.
    my $s = join "", sort map(lc($_), split("", $_)); 
    push @{$sorted{$s}}, $_;
}

for ( values %sorted ) {
    my @words = sort @$_; # case sensitive, this time!
    next if @words == 1;
    my $head = $words[0];

    # We're only interested in pair of mutual anagrams.
    if (@words == 2) {
	my $c = min_chunks( @words );
	next unless $c >= INTERESTING;
	$anagram{ "@words" } = $c;
    }
}

# Display the interesting anagrams found, sorted by chunk score.
for ( sort { $anagram{$b} <=> $anagram{$a} } keys %anagram ) {
    print "$_ ($anagram{$_})\n";
}

__END__

