> > (Demonstrating the limitations of each is the most valuable outcome for me.)
> Really. That limitation is already well documented:
better phrased "The limitations on workarounds or alternatives in core".
The following code is tested and can handle sub-hashes of arbitrary length.
But using hashes and each is in the end a bad idea ... too inflexible, too many limitations, too risky in newer Perl-versions.
Using generated iterators OTOH could handle nested data-structures of any kind.
use Data::Dump qw'dd pp';
use strict;
use warnings;
use constant DEBUG =>0 ;
use feature 'say';
sub gen {
my $ref=shift;
keys %$ref;
my @path=();
return sub {
while (1) {
while (my ($k,$v) = each %$ref ) {
if ( ref $v eq "HASH") {
push @path,$ref;
$ref =$v;
keys %$ref;
next;
}
return $k,$v,scalar @path;
}
return unless @path;
$ref = pop @path;
}
}
}
sub sameFringe {
my ($h1,$h2)=@_;
say "-------\n\n",pp $h1,$h2 if DEBUG;
if ( $h1 != $h2 ){
my $iter1=gen(shift);
my $iter2=gen(shift);
while ((my ($k1,$v1,$l1) = $iter1->()) + (my ($k2,$v2,$l2) = $iter
+2->()) ) {
unless (defined $v1 and defined $v2 and $v1 eq $v2) {
say "ne: ",pp {$l1,[$k1,$v1]},{$l2,[$k2,$v2]} if DEBUG >0;
return "Different Fringe!";
}
say "eq: ",pp [$l1,[$k1,$v1]],[$l2,[$k2,$v2]] if DEBUG >1;
}
}
return 'Same Fringe!';
}
my $a = { l=> 1, r=>{ l=> 2, r=> { l=>3, r=> { l=>4, r=>5 } } } };
my $b = { l=> 1, r=> { l=> { l=> 2, r=> 3 }, r=> { l=> 4, r=> 5 }
+} };
my $c = { l=> { l=> { l=> { l=> 1, r=> 2 }, r=> 3 }, r=> 4 }, r=>
+5 };
say sameFringe($a,$a);
say sameFringe($a,$b);
say sameFringe($b,$c);
say sameFringe($a,$c);
my $x = { l=> 1, r=> { l=> 2, r=> { l=> 3, r=> { l=> 4, r=> { l=>
+5, r=> 6 } } } } };
my $y = { l=> 0, r=> { l=> { l=> 2, r=> 3 }, r=> { l=> 4, r=> 5 }
+} };
my $z = { l=> 1, r=> { l=> 2, r=> { l=> { l=> 4, r=> 3 }, r=> 5 }
+} };
say sameFringe( $a, $x );
say sameFringe( $a, $y );
say sameFringe( $a, $z );
say sameFringe( $b, $x );
say sameFringe( $b, $y );
say sameFringe( $b, $z );
say sameFringe( $c, $x );
say sameFringe( $c, $y );
say sameFringe( $c, $z );
I'll try to show a functional solution and a gather/take implementation in the coming days...
Cheers Rolf
( addicted to the Perl Programming Language)
|