ngoc said:
I have
$hash{1}{2}{3} = 7;
$hash{1}{4}{5} = 6;
I want to get 7 and 6 without using three for loop and keys function
How can I do it?
You could use the following code, which "just hides the loops". The code is
taken out of some more general version I am developing and thus contains
more features than necessary (and it works, as it is, only if you specify
an empty pattern to look for...). Hm.
Graphsearch::matcherFor takes a nested hash as argument and returns an
object/factory/coderef capable of understanding a "Pattern" and returning
an object/Iterator/coderef that extracts every path in the hash matching
the pattern.
BTW: Note the evil goto
<code>
use strict;
use warnings;
my %hash;
$hash{1}{2}{3} = 7;
$hash{1}{4}{5} = 6;
my $matcher = Graphsearch::matcherFor(\%hash);
my $iter = $matcher->([qw//]); # [qw//] is the empty pattern
while(my $path = $iter->()) {
print $path->[-1]; # $path contains [1,2,3,7] and [1,4,5,6]
}
package Graphsearch;
use strict;
use warnings;
sub matcherFor {
my $data = shift;
my $possiblePath = sub { return 0 unless defined ($_[1]);
exists $_[0]->{$_[1]}
};
my $isTerminal = sub { !ref($_[0]->{$_[1]}) };
my $walkpath = sub { $_[0]->{$_[1]} };
my $defaultAction = sub { [keys %{+shift}] };
return sub {
my ($pattern, $requireLength) = @_;
$requireLength ||=0;
my $plength = scalar(@$pattern)-1;
my ($stacks, $olddata, $path, $patternpos, $backtrackfirst)
= ([], [], [], 0, 0);
my ($try, $lengthOk, $nextTry, $consumePattern, $backtrack, $get,
$nextMove);
$lengthOk = sub {
return 1 unless $requireLength; $plength < $patternpos
};
$nextTry = sub {
$try = pop @{$stacks->[-1]}
};
$consumePattern = sub {
my $action = $pattern->[$patternpos] || $defaultAction;
push @$stacks, $action->($data);
++$patternpos;
goto $nextTry;
};
$nextMove = sub {
goto defined($nextTry->())?$get:$backtrack
};
$backtrack = sub {
return undef unless(scalar(@$olddata));
pop @$stacks;
pop @$path;
$data = pop(@$olddata);
--$patternpos;
goto $nextMove;
};
$get = sub {
if ($backtrackfirst or !$possiblePath->($data, $try)) {
$backtrackfirst = 0;
goto $nextMove;
}
else {
if ($isTerminal->($data, $try)) {
if($lengthOk->()) {
$backtrackfirst = 1;
return [@$path, $try, $data->{$try}];
}
else { goto $nextMove }
}
else {
push @$olddata, $data;
push @$path, $try;
$data = $walkpath->($data, $try);
$consumePattern->();
goto $get;
}
}
};
$consumePattern->();
return bless $get, __PACKAGE__;
};
}
__END__
