Re: rearrange "columns" of a multi-level hash?

From: Ben Morrow (usenet_at_morrow.me.uk)
Date: 06/14/04 

Date: Mon, 14 Jun 2004 15:20:42 +0000 (UTC)

Quoth hymie@lactose.smart.net (hymie!):
>
> We are processing a file that has information in it:
> customer vendor transType productCode appNumber resultCode
>
> We have to prepare 2 reports from this data.
>
> Without too much detail, the first report is sorted by Customer, then by
> TransactionType, then by ProductCode, and then by resultCode, with a count
> of the number of lines that match each configuration.
>
> The second report is similar, but is sorted by Customer, then by Vendor,
> then by TransType, ProdCode, and resultCode.
>
> Co-worker wrote the script with (I don't know the correct term) a multi-
> level hash:

That term'll do fine... some people here use HoH, for Hash-of-Hash.

> unless( exists $list{ $customer } )
> {
> $list{ $customer } = () ;
> }
> unless( exists $list{ $customer }{ $type } )
> {
> $list{ $customer }{ $type } = () ;
> }
> and so on, down to
> unless( exists $list{$customer}{$type}{$productCode}{$appNo}{$vendor} )
> {
> $list{ $customer }{ $type }{ $productCode }{ $appNo }{ $vendor } =
> { 130 => 0,
> 150 => 0,
> 385 => 0 } ;
> }

None of this is necessary. What was *meant* here, I think, is to create
a new anon hash for each level; in that case it should have been '= {}'
not '= ()'. In any case, if you treat an undefined variable as though
it's got a hashref in it, Perl will create a new anon hash and put a ref
to it in there for you. Also, a hash key that doesn't exist will return
a value of undef, which is zero in numeric context (with a warning you
can turn off)...

> if( exists $list{$customer}{$type}{$productCode}{$appNo}
> {$vendor}{$returnCode} )
> {
> $list{$customer}{$type}{$productCode}{$appNo}{$vendor}{$returnCode} = 1
> }

...so this whole lot can be replaced with the one line

$list{$customer}{$type}{$productCode}{$appNo}{$vendor}{$returnCode} = 1
    if grep $_ == $returnCode, qw/130 150 385/;

If you need the keys of the last hash to be right, or you specifically
need the zeros, you could do

my @validCodes = qw/130 150 385/;

for ($list{$customer}...{$vendor}) {
    @{$_}{@validCodes} = (0) x @validCodes;
    
    grep $_ == $returnCode, @validCodes
        and $_->{$returnCode} = 1;
}

The expression @{$_}{@validCodes} is perhaps a little confusing: the
first {} are for disambiguation, the second are a hash slice. Compare
with @hash{@validCodes}.

Why is the data stored like this at all? Surely it would be better to
store the return code straight in the hash, rather than have another
level with only one (significant) value?

$list{$customer}...{$vendor} = $returnCode
    if grep $_ == $returnCode, qw/130 150 385/;

Also, what happens if the return code *isn't* in the list? Is the list
supposed to be exhaustive (in which case you can simply strip the greps
out of the above)?

> Then he reads the data thusly:

(unnecessary use of -ly: 'thus' means 'like this' all by itself)

> foreach $customer ( keys(%list) )

This is not sorted. Did you simply mean 'grouped by', or should it be

    for $customer (sort keys %list)
?

> {
> print "Customer: $customer\n\n" ;
> foreach $type ( keys(%{$list{ $customer }}) )
> {
> printf "\n Type: %s", $type ;

Don't use printf when interpolation will do.

> foreach $productCode ( keys(%{$list{ $customer }{ $type }}) )
> {
> printf "\n Product: %s\n", $productCode ;
> foreach $appNo (keys(%{$list{ $customer }{ $type }{ $productCode }}))
> {
> foreach $vendor (keys(%{$list{$customer}{$type}
> {$productCode}{$appNo}}))
> {
> if( $list{ $customer }{ $type }{ $productCode }
> { $appNo }{ $vendor }{385})
> {
> $no385++ ;

This should be a hash. Variables with systematically similar names
nearly always should be.

    $no{385}++;

I would use a hash rather than an array even though the keys are
numeric because they are sparse.

> }
> if( $list{ $customer }{ $type }{ $productCode }
> { $appNo }{ $vendor }{150})
> {
> $no150++ ;
> }
> }
> }
> }
> }
> }

This is a mess :). I would recast it with a dispatch table (untested):

my %no;

sub do_keys {
    my $ivalue = shift;
    my $action = shift;

    if ('HASH' eq ref $value) {
        for (keys %$value) {
            $action and $action->($_);
            do_keys $value->{$_}, @_;
        }
    }
    else {
        $action and $action->($value);
    }
}

do_keys \$list,
   sub { print "Customer: $_[0]" },
   sub { print " Type: $_[0]" },
   sub { print " Product: $_[0]" },
   undef,
   undef,
   sub { $no{$_[0]}++ };

> This generates the frst report that is sorted by Customer and Type.
> He wrote a second, almost identical script to re-parse all of the original
> data into a new hash with the variables in customer-vendor-type order.
>
> What I want to know is if there is
> (*) an easier way to re-arrange the first hash (visualize taking a column
> in a spread*** and moving it over, then resorting with the new
> column order)?

The obvious, though maybe not the most efficient, way is to unwrap it
into a big list of records and wrap it up again:

# old order: customer type product appno vendor
# new order: customer vendor type product appno

my %new_list;

# customer is still first, so we can leave that

for my $cust (keys %list) {

    my @records;
    my %me;

    do_keys $list{$cust},
        sub { $me{type} = $_[0] },
        sub { $me{prod} = $_[0] },
        sub { $me{appn} = $_[0] },
        sub { $me{vend} = $_[0] },
        sub { push @records, { %me, code => $_[0] } }

    for (@records) {
        $new_list{ $cust }
                 { $_->{vend} }
                 { $_->{type} }
                 { $_->{prod} }
                 { $_->{appn} } = $_->{code};
    }
}

Ben 

-- 
   Razors pain you / Rivers are damp
   Acids stain you / And drugs cause cramp.                    [Dorothy Parker]
Guns aren't lawful / Nooses give
  Gas smells awful / You might as well live.                   ben@morrow.me.uk