Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

HoH problem

by tamaguchi (Pilgrim)
on Nov 07, 2006 at 12:15 UTC ( [id://582620]=perlquestion: print w/replies, xml ) Need Help??

tamaguchi has asked for the wisdom of the Perl Monks concerning the following question:

I have a hash of hashes..: 
#!/usr/bin/perl-w

my %hoh;


$hoh{'FILENAME1'}{'A'}{'weight'}=3000;
$hoh{'FILENAME1'}{'A'}{'intensity'}=2;

$hoh{'FILENAME1'}{'B'}{'weight'}=4000;
$hoh{'FILENAME1'}{'B'}{'intensity'}=3;

$hoh{'FILENAME2'}{'D'}{'weight'}=2000;
$hoh{'FILENAME2'}{'D'}{'intensity'}=7;

$hoh{'FILENAME2'}{'C'}{'weight'}=5000;
$hoh{'FILENAME2'}{'C'}{'intensity'}=3;

$hoh{'FILENAME3'}{'C'}{'weight'}=1000;
$hoh{'FILENAME3'}{'C'}{'intensity'}=4;

$hoh{'FILENAME3'}{'A'}{'weight'}=6000;
$hoh{'FILENAME3'}{'A'}{'intensity'}=3;

[download]
I would like print this hash sorted by the values of 'weight' so that the outprint looks:

weight: 1000 intensity: 4 Filename: FILENAME3
weight: 2000 intensity: 7 Filename: FILENAME2
weight: 3000 intensity: 2 Filename: FILENAME1
weight: 4000 intensity: 3 Filename: FILENAME1
weight: 5000 intensity: 3 Filename: FILENAME3
weight: 6000 intensity: 3 Filename: FILENAME3

..is there an elegant way to do this? Thank you.

Replies are listed 'Best First'.
Re: HoH problem
by liverpole (Monsignor) on Nov 07, 2006 at 12:32 UTC
    Hi tamaguchi,

    I would do something like the following ... 

                                                                        
my %weight = ( );
foreach my $filename (keys %hoh) {
    my $psubhash = $hoh{$filename};
    foreach my $letter (keys %$psubhash) {
        my $weight    = $psubhash->{$letter}->{'weight'};
        my $intensity = $psubhash->{$letter}->{'intensity'};
        $weight{$weight} = [ $intensity, $filename ];
    }
}
                                                                      
+          
my @weight = sort { $a <=> $b } keys %weight;
foreach my $weight (@weight) {
    my $p = $weight{$weight};
    my ($intensity, $filename) = @$p;
    printf "weight: %4d intensity: %d Filename: %s\n",
        $weight, $intensity, $filename;
}

    [download]

    Which gives: 

    weight: 1000 intensity: 4 Filename: FILENAME3
weight: 2000 intensity: 7 Filename: FILENAME2
weight: 3000 intensity: 2 Filename: FILENAME1
weight: 4000 intensity: 3 Filename: FILENAME1
weight: 5000 intensity: 3 Filename: FILENAME2
weight: 6000 intensity: 3 Filename: FILENAME3

    [download]

    Update:  Fixed reversed values for weight and intensity.

    s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
[reply]
[d/l]
[select]
Re: HoH problem
by BrowserUk (Patriarch) on Nov 07, 2006 at 12:35 UTC

    I don't think this can be classed as 'elegant' :) 

    printf "weight:%d intensity: %d filename: %s\n",
    $hoh{ $_->[ 0 ] }{ $_->[ 1 ]}{ weight },
    $hoh{ $_->[ 0 ] }{ $_->[ 1 ]}{ intensity },
    $_->[ 0 ]
    for sort{
        $hoh{ $a->[0] }{ $a->[1] }{weight}
        <=>
        $hoh{ $b->[0] }{ $b->[1] }{weight}
    } map{
        my $hash = $_;
        map{
             [ $hash, $_ ]
        } keys %{ $hoh{ $_ } }
    } keys %hoh;;

weight:1000 intensity: 4 filename: FILENAME3
weight:2000 intensity: 7 filename: FILENAME2
weight:3000 intensity: 2 filename: FILENAME1
weight:4000 intensity: 3 filename: FILENAME1
weight:5000 intensity: 3 filename: FILENAME2
weight:6000 intensity: 3 filename: FILENAME3

    [download]

    Update: The above simplifies somewhat by using a half-ST, and in the process becomes a bit more efficient which never hurts: 

    printf "weight:%d intensity: %d filename: %s\n",
    @{ $_ }[ 0, 1, 2 ]
    for sort{
        $a->[ 0 ]  <=> $b->[ 0 ]
    } map{
        my $key = $_;
        map{
             [ 
                 $hoh{ $key }{ $_ }{ weight }, 
                 $hoh{ $key }{ $_ }{ intensity }, 
                 $key, 
                 $_ 
             ]
        } keys %{ $hoh{ $key } }
    } keys %hoh;;

    [download]

    Update2: And that can be further simplified using values instead of keys which allows the removal of several dereferences and a piece of redundant information from the final arrays: 

    printf "weight:%d intensity: %d filename: %s\n", @$_
    for sort{
        $a->[ 0 ]  <=> $b->[ 0 ]
    } map{
        my $key = $_;
        map{
             [ $_->{ weight }, $_->{ intensity }, $key ]
        } values %{ $hoh{ $key } }
    } keys %hoh;;

    [download]

    If you didn't need the filename in the output, you could use values in the outer map and simplify things further.

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
Re: HoH problem
by jwkrahn (Abbot) on Nov 07, 2006 at 14:53 UTC 
    $ perl -e'
my %hoh = (
    FILENAME1 => { A => { weight => 3000, intensity => 2 },
                   B => { weight => 4000, intensity => 3 } },
    FILENAME2 => { D => { weight => 2000, intensity => 7 },
                   C => { weight => 5000, intensity => 3 } },
    FILENAME3 => { C => { weight => 1000, intensity => 4 },
                   A => { weight => 6000, intensity => 3 } },
    );

print map "weight: $_->[0] intensity: $_->[1] Filename: $_->[2]\n",
      map [ unpack q[NNA*], $_ ],
      sort
      map {
          my $file = $_;
          map pack( q[NNA*], @{$hoh{$file}{$_}}{qw/weight intensity/},
+ $file ), keys %{ $hoh{ $file } }
          }
      keys %hoh;
'
weight: 1000 intensity: 4 Filename: FILENAME3
weight: 2000 intensity: 7 Filename: FILENAME2
weight: 3000 intensity: 2 Filename: FILENAME1
weight: 4000 intensity: 3 Filename: FILENAME1
weight: 5000 intensity: 3 Filename: FILENAME2
weight: 6000 intensity: 3 Filename: FILENAME3

    [download]
[reply]
[d/l]
      That's really neat! jwkrahn++

      Cheers,

      JohnGG

[reply]
Re: HoH problem
by wfsp (Abbot) on Nov 07, 2006 at 12:47 UTC
    Here's my go!

    I've just flattened it into an array and sorted it.

    my @flat_data;

for my $file (keys %hoh){
  for my $letter (keys %{$hoh{$file}}){
    my $weight    = $hoh{$file}{$letter}{weight};
    my $intensity = $hoh{$file}{$letter}{intensity};
    push @flat_data, 
      "weight: $weight intensity $intensity Filename: $file";
  }
}

print "$_\n" for sort @flat_data;

    [download]
    output: 
    ---------- Capture Output ----------
> "c:\perl\bin\perl.exe" _new.pl
weight: 1000 intensity 4 Filename: FILENAME3
weight: 2000 intensity 7 Filename: FILENAME2
weight: 3000 intensity 2 Filename: FILENAME1
weight: 4000 intensity 3 Filename: FILENAME1
weight: 5000 intensity 3 Filename: FILENAME2
weight: 6000 intensity 3 Filename: FILENAME3

> Terminated with exit code 0.

    [download]
[reply]
[d/l]
[select]
      That won't work if one weight is 120 and another is 1000. Fix: 
      my @flat_data;

for my $file (keys %hoh){
  for my $letter (keys %{$hoh{$file}}){
    my $weight    = $hoh{$file}{$letter}{weight};
    my $intensity = $hoh{$file}{$letter}{intensity};
    push @flat_data, [ $weight, $intensity, $file ];
  }
}

printf "weight: %d intensity %d Filename: %s\n", @$_
   for sort {  $a->[0] <=> $b->[0]
            || $a->[1] <=> $b->[1]
            || $a->[2] cmp $b->[2] }
       @flat_data;

      [download]
[reply]
[d/l]
[select]
Re: HoH problem
by johngg (Canon) on Nov 07, 2006 at 14:47 UTC
    I think the first thing to make more elegant was the initialisation of %hoh to save some of the repeat typing and eliminate the key quoting. For the sorting I have tried a Schwartzian Transform but I wouldn't say it was particularly elegant because you have to jump through hoops to get at the second-level keys.

    use strict;
use warnings;

my %hoh;

$hoh{FILENAME1} =
   {
      A => {weight => 3000, intensity => 2},
      B => {weight => 4000, intensity => 3},
   };

$hoh{FILENAME2} =
   {
      C => {weight => 5000, intensity => 3},
      D => {weight => 2000, intensity => 7},
   };

$hoh{FILENAME3} =
   {
      A => {weight => 6000, intensity => 3},
      C => {weight => 1000, intensity => 4},
   };

print
   map
   {
       sprintf qq{weight %d intensity %d Filename %s\n},
          $hoh{$_->[0]}->{$_->[1]}->{weight},
          $hoh{$_->[0]}->{$_->[1]}->{intensity},
          $_->[0];
   }
   sort
   {
       $hoh{$a->[0]}->{$a->[1]}->{weight}
       <=>
       $hoh{$b->[0]}->{$b->[1]}->{weight}
   }
   map
   {
       my $item = $_;
       my @keyPairs;
       push @keyPairs, [$item, $_]
          for keys %{$hoh{$_}};
       @keyPairs;
   }
   keys %hoh;

    [download]

    This produces the desired output

    weight 1000 intensity 4 Filename FILENAME3
weight 2000 intensity 7 Filename FILENAME2
weight 3000 intensity 2 Filename FILENAME1
weight 4000 intensity 3 Filename FILENAME1
weight 5000 intensity 3 Filename FILENAME2
weight 6000 intensity 3 Filename FILENAME3

    [download]

    I hope this is of interest.

    Cheers,

    JohnGG

    Update: Changed array @keyList to more meaninfully named @keyPairs in map.

[reply]
[d/l]
[select]
Re: HoH problem
by imp (Priest) on Nov 07, 2006 at 22:21 UTC
    In the spirit of TMTOWTDI here's an alternative solution that uses Sort::Key to improve readability.

    To further improve the readability (without too much memory being wasted) this version also creates a partially flattened collection of [filename, letter, dataref] chunks. <p. It could be simplified further, but I kept the letter key capturing enabled in case it was neccesary for solving the problem with actual data (versus the example data). 

    #!/usr/bin/perl
use strict;
use warnings;
use Sort::Key qw(ikeysort);

my %hoh;

$hoh{'FILENAME1'}{'A'}{'weight'}=3000;
$hoh{'FILENAME1'}{'A'}{'intensity'}=2;

$hoh{'FILENAME1'}{'B'}{'weight'}=4000;
$hoh{'FILENAME1'}{'B'}{'intensity'}=3;

$hoh{'FILENAME2'}{'D'}{'weight'}=2000;
$hoh{'FILENAME2'}{'D'}{'intensity'}=7;

$hoh{'FILENAME2'}{'C'}{'weight'}=5000;
$hoh{'FILENAME2'}{'C'}{'intensity'}=3;

$hoh{'FILENAME3'}{'C'}{'weight'}=1000;
$hoh{'FILENAME3'}{'C'}{'intensity'}=4;

$hoh{'FILENAME3'}{'A'}{'weight'}=6000;
$hoh{'FILENAME3'}{'A'}{'intensity'}=3;



# Create a list of sets
# $set[0] = filename
# $set[1] = letter
# $set[2] = reference to the data for this filename-letter combination
my @sets;
for my $filename (keys %hoh) {
    push @sets, [$filename, $_,$hoh{$filename}{$_}] for keys %{$hoh{$f
+ilename}}
}
for my $set (ikeysort { $_->[2]{weight} } @sets) {
    my ($filename,$letter,$data) = @$set;
    my $weight    = $data->{weight};
    my $intensity = $data->{intensity};
    printf "weight: %4d intensity: %d Filename: %s\n",$weight,$intensi
+ty,$filename;
}

    [download]
[reply]
[d/l]
[select]
Re: HoH problem
by GrandFather (Saint) on Nov 07, 2006 at 21:25 UTC

    What constitutes elegant?

    use strict;
use warnings;

my %hoh = (
        FILENAME1 => {
            A => {weight => 3000, intensity => 2},
            B => {weight => 4000, intensity => 3},
        },
        FILENAME2 => {
            D => {weight => 2000, intensity => 7},
            C => {weight => 5000, intensity => 3},
        },
        FILENAME3 => {
            C => {weight => 1000, intensity => 4},
            A => {weight => 6000, intensity => 3},
        },
    );

my @lines = map {$_->[1]} sort {$a->[0] <=> $b->[0]} map {
        my $fn = $_;
        map {
            my $h = $hoh{$fn}{$_};
            [$h->{weight}, "$fn $_ $h->{intensity}: $h->{weight}"]
        } keys %{$hoh{$fn}}
    } keys %hoh;

print join "\n", @lines;

    [download]

    Prints:

    FILENAME3 C 4: 1000
FILENAME2 D 7: 2000
FILENAME1 A 2: 3000
FILENAME1 B 3: 4000
FILENAME2 C 3: 5000
FILENAME3 A 3: 6000

    [download]
    DWIM is Perl's answer to Gödel
[reply]
[d/l]
[select]
Re: HoH problem
by j3 (Friar) on Nov 07, 2006 at 20:22 UTC

    Oh my. There's a lot of Perl gunslingers around here. Here's my Perl baby-talk approach. Nobody laugh! :) 

    #!/usr/bin/perl

use strict;
use warnings;

my %hoh;

$hoh{'FILENAME1'}{'A'}{'weight'}=3000;
$hoh{'FILENAME1'}{'A'}{'intensity'}=2;

$hoh{'FILENAME1'}{'B'}{'weight'}=4000;
$hoh{'FILENAME1'}{'B'}{'intensity'}=3;

$hoh{'FILENAME2'}{'D'}{'weight'}=2000;
$hoh{'FILENAME2'}{'D'}{'intensity'}=7;

$hoh{'FILENAME2'}{'C'}{'weight'}=5000;
$hoh{'FILENAME2'}{'C'}{'intensity'}=3;

$hoh{'FILENAME3'}{'C'}{'weight'}=1000;
$hoh{'FILENAME3'}{'C'}{'intensity'}=4;

$hoh{'FILENAME3'}{'A'}{'weight'}=6000;
$hoh{'FILENAME3'}{'A'}{'intensity'}=3;

# Let's flatten %hoh out, and store what we care about in this
# array of references to arrays.
my @by_weights = ();

# Populate @by_weights.
for my $key_in_hoh (keys %hoh) {
    for my $key_in_fin (keys %{$hoh{$key_in_hoh}}) {
        for my $key_in_let (keys %{$hoh{$key_in_hoh}{$key_in_fin}}) {
            # We'll fix the intensity value later.
            if ($key_in_let eq 'weight') {
                push @by_weights, [ $key_in_let,
                                    $hoh{$key_in_hoh}{$key_in_fin}{$ke
+y_in_let},
                                    'intensity',
                                    0, # Fill in correct value later.
                                    $key_in_fin,
                                    $key_in_hoh,
                                  ];
            }
        }
    }
}

# Correct the intensity values.
for (@by_weights) {
    my ( $key_in_hoh, $key_in_fin ) = ( $_->[5], $_->[4] );
    $_->[3] = $hoh{$key_in_hoh}{$key_in_fin}{intensity};
}

# Now, sort by weight.
@by_weights = sort { $a->[1] <=> $b->[1] } @by_weights;

for (@by_weights) {
    print "${$_}[0]: ${$_}[1] $_->[2]: ${$_}[3] filename: $_->[5]\n";
}

    [download]
[reply]
[d/l]
Re: HoH problem
by smokemachine (Hermit) on Nov 07, 2006 at 16:50 UTC
    something like this?! 
    my %hoh;


$hoh{FILENAME1}{A}{weight}=3000;
$hoh{FILENAME1}{A}{intensity}=2;

$hoh{FILENAME1}{B}{weight}=4000;
$hoh{FILENAME1}{B}{intensity}=3;

$hoh{FILENAME2}{D}{weight}=2000;
$hoh{FILENAME2}{D}{intensity}=7;

$hoh{FILENAME2}{C}{weight}=5000;
$hoh{FILENAME2}{C}{intensity}=3;

$hoh{FILENAME3}{C}{weight}=1000;
$hoh{FILENAME3}{C}{intensity}=4;

$hoh{FILENAME3}{A}{weight}=6000;
$hoh{FILENAME3}{A}{intensity}=3;

for $key (keys %hoh){
        push @sorted, {%{$hoh{$key}{$_}}, FILENAME => $key} for keys %
+{$hoh{$key}}
}
print "weight: ",$_->{weight}," intensity: ", $_->{intensity}, " FILEN
+AME: ", $_->{FILENAME}, "\n
" for sort {$a->{weight} <=> $b->{weight}} @sorted

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://582620]
Approved by willyyam
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2024-04-23 09:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found