in reply to Re^4: Challenge: Perl 5: lazy sameFringe()?
in thread Challenge: Perl 5: lazy sameFringe()?

> > (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)