#!/usr/bin/perl -w
use strict; use warnings;
my $ar=[
{sex=>'m',occupation=>'programmer',state=>'CA'},
{sex=>'m',occupation=>'blah1',state=>'CA'},
{sex=>'m',occupation=>'blah1',state=>'NY'},
{sex=>'m',occupation=>'blah2',state=>'NY'},
{sex=>'f',occupation=>'blah1',state=>'NY'},
{sex=>'f',occupation=>'blah2',state=>'NJ'},
];
printer(counter($ar,['sex']));
printer(counter($ar,['sex','state']));
printer(counter($ar,['sex','occupation']));
printer(counter($ar,[]));
exit;
sub printer{
use Data::Dumper;
my $ref=shift;
local $Data::Dumper::Deepcopy=1;
local $Data::Dumper::Purity=1;
local $Data::Dumper::Sortkeys=1;
local $Data::Dumper::Indent=2;
print Dumper($ref)."\n";
} # printer
sub counter {
my $arin=shift;
my $arparts=shift;
my $res={};
my $size1=scalar(@$arparts)-1;
return $res unless ($size1 >=0);
my $size2=$size1-1;
for my $hash (@$arin){
my @parts=();
for my $key (@$arparts){
my $val=$hash->{$key};
if (!defined ($val)) {$val='.'}
push @parts,$val;
}
my $reshead=$res;
for my $n (0..$size2) {
my $val=$parts[$n];
unless ($reshead->{$val}) {$reshead->{$val}={};}
$reshead=$reshead->{$val};
}
$reshead->{$parts[$size1]}++;
} # hash
return $res;
} # counter
####
$VAR1 = {
'f' => 2,
'm' => 4
};
$VAR1 = {
'f' => {
'NJ' => 1,
'NY' => 1
},
'm' => {
'CA' => 2,
'NY' => 2
}
};
$VAR1 = {
'f' => {
'blah1' => 1,
'blah2' => 1
},
'm' => {
'blah1' => 2,
'blah2' => 1,
'programmer' => 1
}
};
$VAR1 = {};
##
##
printer(counter($ar,['state','sex','occupation']));
##
##
$VAR1 = {
'CA' => {
'm' => {
'blah1' => 1,
'programmer' => 1
}
},
'NJ' => {
'f' => {
'blah2' => 1
}
},
'NY' => {
'f' => {
'blah1' => 1
},
'm' => {
'blah1' => 1,
'blah2' => 1
}
}
};