I keep thinking that this can be done using string-wise boolean operations, but I cannot see how?
Like this:
sub compatible {
my( $l, $r ) = @_;
# underscores are insignificant
tr/_/\0/ for $l, $r;
# cancel out identical values
my $xor = $l ^ $r;
# convert to bitmasks
tr/\0/\377/c for $l, $r;
my $mask = $l & $r;
# masked chars must be identical
return !1 if ( $xor & $mask ) =~ tr/\0//c;
# and there may not be dupes of non-identical characters
return 0 == grep {
my $char = substr( $xor, $_, 1 );
$char ne "\0" and index( $xor, $char, $_ + 1 ) != -1
} 0 .. length( $xor ) - 1;
}
Test suite in the readmore.
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
my @testcase = (
1 => [
'_8__3__19',
'48____7__',
],
1 => [
'_8__3__19',
'48__3_7__',
],
!1 => [
'_8__3__19',
'4_8___7__',
],
!1 => [
'____3__19',
'3________',
],
!1 => [
'____3__19',
'________8',
],
!1 => [
'_8__3__19',
'48_____7_',
],
!1 => [
'__8_3__19',
'84____7__',
],
);
plan tests => @testcase / 2;
while( my( $result, $strings ) = splice @testcase, 0, 2 ) {
my $testname = join "\n" . ( " " x 18 ), (
( $result ? 'compatible' : 'conflicting' ) . ':',
@$strings
);
is( compatible( @$strings ), $result, $testname );
}
Makeshifts last the longest.