Algorithm-Accounting
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Algorithm/Accounting.pm view on Meta::CPAN
field 'report_class' => 'Algorithm::Accounting::Report::Text';
sub reset {
$self->fields([]);
$self->field_groups([]);
$self->occurrence_array([]);
$self->occurrence_hash({});
}
sub result {
my $field = shift;
if($field && grep /^$field$/,@{$self->fields}) {
return $self->occurrence_hash->{$field};
}
return $self->occurrence_array;
}
sub group_result {
my ($group,@fv) = @_;
my $occ = $self->group_occurrence;
return unless($group =~ /\d+/ && defined($occ->[$group]));
# Exact match;
my $cmp = Array::Compare->new;
if(@fv == @{$self->field_groups->[$group]}) {
for(keys %{$occ->[$group]}) {
my @fv_ = thaw($_);
next unless($cmp->compare(\@fv, \@fv_));
return $occ->[$group]{$_};
}
}
# Slurp whole thing, convert to multi-level hash.
my $rv = {};
for(keys %{$occ->[$group]}) {
# would this be dangerous ?
eval "\$rv->".join('',map {"{'$_'}"} thaw($_))."= $occ->[$group]{$_}";
}
return $rv;
}
sub append_data {
my $data = shift;
$self->update_single_field($data);
$self->update_group_field($data);
}
sub report {
my $class = $self->report_class;
my $obj;
eval qq{
require $class;
\$obj = $class->new;
};
die"report() error\n" if $@;
$obj->process(
$self->occurrence_hash,
$self->field_groups,
$self->group_occurrence
);
}
sub update_group_field {
my $data = shift;
my $groups = $self->field_groups || return;
my $gocc = $self->group_occurrence;
for my $i (0..@$groups-1) {
my @index = $self->position_of($self->fields,$groups->[$i]);
for my $row (@$data) {
my $permutor = Algorithm::Accounting::Array::Iterator::LOL->new([@$row[@index]]);
my %exclude;
while(my $permutation = $permutor->getNext) {
my @_row = map {(ref($_) ? $_->[0] : $_)||''} @$permutation;
my $__row = freeze(@_row);
# One value-tuple would shows only one time,
# So it's excluded upon extra permutations.
unless($exclude{$__row}) {
$gocc->[$i]->{freeze(@_row)}++;
$exclude{$__row}++;
}
}
}
}
$self->group_occurrence($gocc);
}
sub update_single_field {
my $data = shift;
my $aocc = $self->occurrence_array;
my $hocc = $self->occurrence_hash;
my $fields = $self->fields;
for my $i (0..@$fields-1) {
my $occ = $aocc->[$i] || {};
for(@$data) {
last unless exists $_->[$i];
if('ARRAY' eq ref($_->[$i])) {
for my $v (@{$_->[$i]}) {$occ->{$v}++}
} else {
$occ->{$_->[$i]}++;
}
}
$aocc->[$i] = $occ;
$hocc->{$fields->[$i]} = $occ;
}
$self->occurrence_array($aocc);
$self->occurrence_hash($hocc);
}
# Find the position of wanted values in an array
sub position_of {
my ($arr,$wanted) = @_;
my @index;
for my $w (@$wanted) {
for my $i (0..@$arr-1) {
push @index,$i if($arr->[$i] eq $w);
}
}
return @index;
}
package Algorithm::Accounting::Array::Iterator::LOL;
use Array::Iterator::Reusable;
use Clone qw(clone);
sub new {
my $class = $self;
$self = {};
bless $self,$class;
my $lol = shift;
my @lolp; # list of Array::Iterator::Reusable
for (@$lol) {
if(ref($_)) {
push @lolp, Array::Iterator::Reusable->new($_);
} else {
push @lolp, Array::Iterator::Reusable->new([$_]);
}
}
$self->{lol} = $lol;
$self->{lolp} = \@lolp ;
$self->reset();
return $self;
}
sub reset {
$_->reset for @{$self->{lolp}};
my @lov;
push @lov, $self->{lolp}->[0]->peek;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.003 second using v1.00-cache-2.02-grep-82fe00e-cpan-b63e86051f13 )