Geek asks and answers

Help walking / sorting a complex Perl data structure (HoH with loss of AoH)

I’ve been banging my head on the wall for several hours.

I have a data structure that looks like this (output from "Data :: Dumper"). This is my own mistake, I am creating a data structure as I am parsing some data.

print Dumper $data;

___OUTPUT___
$VAR = { 'NAME' => {
                    'id' => '1234',
                    'total' => 192,
                    'results' =>  { 
                                     'APPLE'   => 48 ,
                                     'KUMQUAT' => 61 ,
                                     'ORANGE'  => 33 ,
                                  }
                   }

       }
  • There are thousands of "NAME" keys.
  • There is only one id and total.
  • A "hash" of results can have one or more key / value pairs.

I want to print a comma separated list, first sorted by "total", and then by the value of each hash in the "results" array.

The following code was used to print the CSV from an already saved data structure.

use strict;
use warnings;
# [...lots of other stuff...]

open (my $fh, >out.csv);
print $fh "Name, ID, Label, Count, Total\n";

foreach ( sort { $data->{$b}->{total} <=> $data->{$a}->{total} }
    keys %{$data} )
{
    my $name = $_;
    foreach (
        sort {
            $data->{$name}->{results}->{$a} <=> $data->{$name}->{results}
              ->{$b}
        } values %{ $data->{$name}->{results} }
      )
    {

        print $fh $name . ","
          . $data->{$name}->{id} . "," . "'"
          . $_ . ","
          . $data->{$name}->{results}->{$_} . "," . "\n";
    }
    print $fh $name . ","
      . $data->{$name}->{id} . "," . "," . ","
      . $data->{$name}->{total} . "\n";
}

close($fh);

( , Perl).

:

Name, ID,  Label,   Count, Total
foo, 1234, ORANGE,    33,
foo, 1234, APPLE,     48,
foo, 1234, KUMQUAT,   61,
foo, 1234,     ,        ,  142
bar, 1101, BIKE,      20,
bar  1101,     ,        ,  20

! , ( "" ), , "" ...

print Dumper $data;

___OUTPUT___
$VAR = { 'NAME' => {
                    'id' => '1234',
                    'total' => 192,
                    'results' => [
                                   { 'APPLE'   => 48 },
                                   { 'KUMQUAT' => 61 },
                                   { 'ORANGE'  => 33 },
                                   { 'APPLE'   => 50 },
                                 ]
                   }
       }
  • "NAME".
  • "id" "total" .
  • "results" .
  • "results" /.

, , , , ...; -)

sort/print.

use strict;
use warnings;
# [...lots of other stuff...]

open (my $fh, >out.csv);
print $fh "Name, ID, Label, Count, Total\n";

foreach ( sort { $data->{$b}->{total} <=> $data->{$a}->{total} }
    keys %{$data} )
{
    my $name = $_;
    foreach (
        sort {
            $data->{$name}->{results}->{$a} <=> $data->{$name}->{results}
              ->{$b}
        } values %{ $data->{$name}->{results} }
      )
    {
    # .... HELP ME FOR THE LOVE OF ALL THAT IS GOOD IN THE WORLD! ....
    # I'm at the point now where my brain is starting to slowly dribble from my
    # ears...
    }
    print $fh $name . "," 
      . $data->{$name}->{id} . "," . "," . ","
      . $data->{$name}->{total} . "\n";
}

close($fh);

, . , .

- , , , ! ( , ... "" , . ( Perl) .)

+3
3

, : ,

, , . . , . .

30 . , .

, (, !), RESULT, , , .

, , RESULTS , ( ) . , . , , .

#! /usr/bin/env perl

use warnings;
use strict;
use feature qw(say);
use Data::Dumper;


my %hash;
my $obj;

$obj = structure->new();
$obj->Name("foo");
$obj->Total("foo", 142);
$obj->Id("foo", 1234);
$obj->Push(qw(foo  ORANGE  33));
$obj->Push(qw(foo  APPLE   48));
$obj->Push(qw(foo  APPLE   50));
$obj->Push(qw(foo  KUMQUAT 61));
$obj->SortResults("foo");

$obj->Name("bar");
$obj->Total("bar", 20);
$obj->Id("bar", 1100);
$obj->Push(qw(bar BIKE    20));
$obj->SortResults("bar");

say Dumper($obj);
exit 0;

########################################################################
package structure;

use Data::Dumper;

#
# New Structure containing all data
# 
sub new {
    my $class = shift;

    my $self = {};

    bless $self, $class;
    return $self;
}

#
# Either adds a new name object or returns name object;
#
sub Name {
    my $self = shift;
    my $name = shift;

    if (not defined $self->{$name}) {
        $self->{$name}->{ID} = undef;
        $self->{$name}->{TOTAL} = undef;
        $self->{$name}->{RESULTS} = [];
    }
    return $self->{$name};
}

#
# Returns a list of Names
#
sub NameList {
    my $self = shift;

    return keys %{$self};
}
#
# Either returns the id or sets $name id
#
sub Id {
    my $self = shift;
    my $name = shift;
    my $id = shift;

    my $nameObj = $self->Name($name);
    if (defined $id) {
        $nameObj->{ID} = $id;
    }
    return $nameObj->{ID};
}

#
# Either returns the total for $name or sets $name total
#
sub Total {
    my $self = shift;
    my $name = shift;
    my $total = shift;

    my $nameObj = $self->Name($name);
    if (defined $total) {
        $nameObj->{TOTAL} = $total;
    }
    return $nameObj->{TOTAL};
}

#
# Pushes new product and amount on $name result list
#
sub Push {
    my $self = shift;
    my $name = shift;
    my $product = shift;
    my $amount = shift;

    my $nameObj = $self->Name($name);
    my @array = ("$name", "$amount");
    push @{$nameObj->{RESULTS}}, \@array;
    return @array;
}

#
# Pops product and amount on $name result list
#
sub Pop {
    my $self = shift;
    my $name = shift;

    my $nameObj = $self->Name($name);
    my $arrayRef = pop @{$nameObj->{RESULTS}};
    return @{$arrayRef};
}

sub SortResults {
    my $self = shift;
    my $name = shift;

    my $nameObj = $self->Name($name);
    my @results = @{$nameObj->{RESULTS}};
my @sortedResults = sort {$a->[1] <=> $b->[1]} @results;
my $nameObj->{RESULTS} = \@sortedResults;
    return @sortedResults;
}

$obj->SortResults , . , :

my @sortedItems = sort {$obj->Total($a) <=> $obj->Total($b)} $obj->NameList();

, , . ( ).

, , , , , . , , , , , , 30 , .

+5
use strict;
use warnings;
# [...lots of other stuff...]

open (my $fh, '>', 'out.csv');
print $fh "Name, ID, Label, Count, Total\n";

my $data = {
    'NAME' => {
        'id' => '1234',
        'total' => 192,
        'results' => [
            { 'APPLE'   => 48 },
            { 'KUMQUAT' => 61 },
            { 'ORANGE'  => 33 },
            { 'APPLE'   => 50 },
        ]
    }
};

# sort names by total, descending
for my $name ( sort { $data->{$b}{total} <=> $data->{$a}{total} } keys %{$data} )
{
    # sort results by count, ascending; is this what you want?
    for my $result ( sort { (%$a)[1] <=> (%$b)[1] } @{ $data->{$name}{results} } ) {
        my ($label, $count) = %$result;
        print $fh join(',', $name, $data->{$name}{id}, $label, $count, ''), "\n";
    }
    print $fh join(',', $name, $data->{$name}{id}, '', '', $data->{$name}{total}), "\n";
}

close($fh);
+3

You can probably reduce the level of complexity with a data structure like this:

$VAR = [
         {
           'name' => 'foo',
           'id' => '1234',
           'total' => 192,
           'results' => [
                          { 'label' => 'APPLE', 'score' => 48 },
                          { 'label' => 'KUMQUAT', 'score' => 61 },
                          { 'label' => 'ORANGE', 'score' => 33 },
                          { 'label' => 'APPLE', 'score' => 50 },
                        ]
         },
       ];

So, if I remember my Perl, you would look at something like:

foreach my $row ( sort( $a->{'total'} <=> $b->{'total'} ) @data ) {

    foreach my $result ( sort( $a->{'score'} <=> $b->{'score'} ) @{$row->{'results'}} ) {

    }

}
+2
source

More articles:


All Articles