VIER/NEUN problem

[Greg Bacon]

According to <URL:http://members.home.net/js.graham/vierneun.html>:

    VIER and NEUN represent 4-digit squares, each letter denoting a
    distinct digit. You are asked to find the value of each, given the
    further requirement that each uniquely determines the other.

Here's a solution from map/grep Hell:

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

    # VIER/NEUN problem

    use strict;

    use POSIX qw/ ceil floor /;

    my $expr = qr/
        ^

        (.)                     # V
        ((?!\1)             .)  # I
        ((?!\1|\2)          .)  # E
        ((?!\1|\2|\3)       .)  # R

        ((?!\1|\2|\3|\4)    .)  # N
        \3                      # E
        ((?!\1|\2|\3|\4|\5) .)  # U
        \5                      # N

        $
    /x;

    my $lo = ceil  sqrt 1000;
    my $hi = floor sqrt 9999;

    my %seen;

    $" = '';
    my @list = map  { $_->[0] }
               grep { $_->[1] == 2 }
               map  { [ $_, $seen{$_->[0]} + $seen{$_->[1]} ] }
               grep { ++$seen{$_->[0]} && ++$seen{$_->[1]} }
               grep { "@{$_}[0,1]" =~ /$expr/ }
               map  { $% = $_;  map { [ $_ * $_, $% ] } $lo .. $hi }
               grep { /^(.)..\1$/ }
               map  { $_ * $_ }
               $lo .. $hi;

    if (@list != 1) {
        $_ = @list;
        warn "$0: expected one result, got $_:\n";

        for (@list) {
            print "VIER = $_->[0], NEUN = $_->[1]\n";
        }
    }

    my($soln) = @list;
    print "VIER = $soln->[0], NEUN = $soln->[1]\n";

Enjoy,
Greg