Re: Comparison by position and value

[steves]

Update: I didn't read closely enough. This doesn't account for the case where the same digit appears in different positions in each sequence -- i.e., I'm only comparing each individual position.

Update 2: Here's a more complicated version that accounts for what I missed, the assumption still being that a given digit can only appear once in a sequence.

sub compatible
{
    my ($s1, $s2) = @_;
    my %hashed;
    my $diff = 0;

    my ($one, $two);
    my @counts;
    my $n = 10;

    #
    # Hash so that each $s1 value is a key with its corresponding
    # $s2 value as the hashed value.
    #
    @hashed{map {($_ eq '_') ? $n++ : $_} split("", $s1)} =
      map {($_ eq '_') ? $n++ : $_} split("", $s2);

    #
    # Compare each $s1->$s2 pair
    #
    while (($one, $two) = each %hashed)
    {
        next if ($one == $two);

        last if (($diff = (++$counts[$one] - 1)) > 0);
        last if (($diff = (++$counts[$two] - 1)) > 0);

        $diff = 0;
        next if ( ($one >= 10) || ($two >= 10) );

        last if (($diff = ($one - $two)) != 0);
    }

    print "$s1\n$s2\n", ($diff == 0) ? "compatible" : "incompatible", 
+"\n\n";
}

Revised output:

_8__3__19
48____7__
compatible

_8__3__19
4_2___7__
compatible

_8__3__19
4_8___7__
incompatible

__8_3__19
48____7__
incompatible

__8_3__19
84____7__
incompatible

_8__3__19
48_____7_
incompatible

I'm not sure how fast this is compared to the other methods, but here's a way to do it using a hash and a short circuited loop comparison of each hashed key/value:

use strict;

sub compatible
{
    my ($s1, $s2) = @_;
    my %hashed;
    my $diff = 0;
    my ($one, $two);

    #
    # Hash so that each $s1 value is a key with its corresponding
    # $s2 value as the hashed value.
    #
    @hashed{split("", $s1)} = split("", $s2);

    #
    # Compare each $s1->$s2 pair
    #
    while (($one, $two) = each %hashed)
    {
        next if ( ($one eq '_') || ($two eq '_') );
        last if (($diff = ($one - $two)) != 0);
    }

    print "$s1\n$s2\n", ($diff == 0) ? "compatible" : "incompatible", 
+"\n\n";
}

my @tests =
(qw/
     _8__3__19
     48____7__

     _8__3__19
     4_2___7__

     _8__3__19
     4_8___7__

     __8_3__19
     48____7__

     __8_3__19
     84____7__

     _8__3__19
     48_____7_
   /
);

my ($s1, $s2);
while (defined($s1 = shift(@tests)))
{
    $s2 = shift(@tests);
    compatible($s1, $s2);
}

Output:

_8__3__19
48____7__
compatible

_8__3__19
4_2___7__
compatible

_8__3__19
4_8___7__
compatible

__8_3__19
48____7__
compatible

__8_3__19
84____7__
compatible

_8__3__19
48_____7_
incompatible