Print a Perl hash of hashes - arrays

I am building a hash of hashes. How can I use while to get each value?
my %users = ();
while ( my $row_ref = $select_sth->fetchrow_hashref() ) {
$id = $row_ref->{uid};
$name = $row_ref->{name};
my $loc = $row_ref->{loc };
$users{$loc}{$name} = $id;
}
while ( my ($user, $val) = each(%users) ) {
# how to get name, loc, id?
my $uname = ??
my $uloc = ??
my $uid = ??
}

Iterate over the two levels of the hash in nested loops.
for my $loc (keys %users) {
for my $name (keys $users{$loc}->%*) {
say "loc: $loc -- name: $name -- id: $users{$loc}{$name}";
}
}
Hint: use Data::Dumper or similar to visualise a nested data structure.

Related

Perl Hash : get keys if the value is in-between a range

I have a two dimensional hash with 100K keys(primary) like this and I need to get the primary key - the name of the fruit only if a particular condition is satisfied;
like - if the price is between 35 and 55; Desired output is Orange and Grape.
And there is a list (hundreds in count) of unique price ranges for which I need a list of fruits within each range.
Iterating through hash again and again for each price range takes a lot of time.
Is there a way we can do it quickly instead of looping through the entire hash for each price range?
Hash format :
$fruits{"Mango"}{color}=Yellow
$fruits{"Mango"}{price}=80
$fruits{"Orange"}{color}=Orange
$fruits{"Orange"}{price}=40
$fruits{"Grape"}{color}=Green
$fruits{"Grape"}{price}=50
Here is an example of how you can do a single scan through the fruits by sorting the the prices in numerical order. This should be faster than scanning the whole hash once for each price range:
package Main;
use v5.20.0;
use feature qw(say);
use strict;
use warnings;
use experimental qw(signatures);
{
my %fruits;
$fruits{Mango}{color} = "Yellow";
$fruits{Mango}{price} = 80;
$fruits{Orange}{color} = "Orange";
$fruits{Orange}{price} = 40;
$fruits{Grape}{color} = "Green";
$fruits{Grape}{price} = 50;
my #ranges = ( [35, 55], [45, 55], [2, 85] );
my $self = Main->new(
fruits => \%fruits,
ranges => \#ranges
);
$self->init_mapping_arrays();
my $names = $self->get_fruit_names_for_all_ranges();
}
sub init_mapping_arrays( $self ) {
my #prices;
my #names;
for my $fruit (keys %{ $self->{fruits} }) {
push #names, $fruit;
push #prices, $self->{fruits}{$fruit}{price};
}
my #idx = map { $_->[0] }
sort { $a->[1] <=> $b->[1] } map { [$_, $prices[$_]] } 0..$#prices;
$self->{prices} = [#prices[#idx]];
$self->{names} = [#names[#idx]];
}
sub get_fruit_names_for_all_ranges ($self) {
my #names;
my $prices = $self->{prices};
my $ranges = $self->{ranges};
for my $i (0..$#$prices) {
for my $range (0..$#$ranges) {
if ( ($ranges->[$range][0] <= $prices->[$i])
&& ($ranges->[$range][1] >= $prices->[$i]))
{
push #{$names[$range]}, $self->{names}[$i];
}
}
}
return \#names;
}
sub new( $class, %args ) { bless \%args, $class }
If this is not fast enough, the get_fruit_names_for_all_ranges() sub can be optimized further by also sorting the ranges.
If the fruits are sorted, two binary searches would find the fruits quickly.
sub search_cmp
my #fruits = (
{ name => "Orange", price => 40, ... },
...
);
my #ranges = (
[ 35, 55 ],
...
);
my #sorted_fruits = sort { $a->{price} <=> $b->{price} } #fruits;
for my $range (#ranges) {
my $i = binsearch { $a <=> $b->{price} } $range[0], #sorted_fruits, 0;
$i = ~$i if $i < 0;
my $j = binsearch { $a <=> $b->{price} } $range[1], #sorted_fruits, $i;
$j = ~$j - 1 if $j < 0;
say "[$range->{min}, $range->{max}]: #fruits[$i..$j]";
}
sub _unsigned_to_signed { unpack('j', pack('J', $_[0])) }
sub binsearch(&$\#;$$) {
my $compare = $_[0];
#my $value = $_[1];
my $array = $_[2];
my $min = $_[3] // 0;
my $max = $_[4] // $#$array;
return -1 if $max == -1;
my $ap = do { no strict 'refs'; \*{caller().'::a'} }; local *$ap;
my $bp = do { no strict 'refs'; \*{caller().'::b'} }; local *$bp;
*$ap = \($_[1]);
while ($min <= $max) {
my $mid = int(($min+$max)/2);
*$bp = \($array->[$mid]);
my $cmp = $compare->()
or return $mid;
if ($cmp < 0) {
$max = $mid - 1;
} else {
$min = $mid + 1;
}
}
return _unsigned_to_signed(~$min);
}
Performance analysis
The best possible worst case is O(R * F) because every range could match every fruit.
The naive approach described by the OP asked to replace is O(R * F). So is it as fast as it can be? No, because the naive approach always adopts its worse case.
In practice, if we can assume that each range matches just a few fruits, we can get far far better results on average from the above: O( ( F + R ) log F )

Push array to a certain hash within an array in Perl

I want to dynamically push values of hashes into an array of hashes in Perl.
I have this code block to create and push classHash to an array classList.
$courseName = <STDIN>;
$section = <STDIN>;
my $classHash = {};
$classHash->{courseName} = $courseName;
$classHash->{section} = $section;
push #classList, $classHash;
Now, I want to add a studentHash to the classHash.
for my $i ( 0 .. $#classList ) {
#I want to add the studentHash to a specific classHash in the classList
if($courseName1 eq $classList[$i]{courseName} && $section1 eq $classList[$i]{section}){
$studName = <STDIN>;
$studNum = <STDIN>;
my $studHash = {};
$studHash->{studName} = $studName;
$studHash->{studNum} = $studNum;
push #studList, $studHash;
push #{$classList[$i]}, \#studList; #but this creates an array reference error
}
}
Ignoring the interactive bits... here is how you can add the student to the class:
#!/usr/bin/env perl
use warnings;
use strict;
use Data::Dumper;
my #classList = (
{
courseName => 'Algebra',
section => 101,
students => [],
},
{
courseName => 'Geometry',
section => 102,
students => [],
},
);
my $studName = 'Alice';
my $studNum = 13579;
my $desiredClass = 'Geometry';
my $desiredSection = 102;
for my $class (#classList) {
if ($class->{courseName} eq $desiredClass and
$class->{section} eq $desiredSection) {
# Add student to the class
my $student = {
studName => $studName,
studNum => $studNum,
};
push #{ $class->{students} }, $student;
}
}
print Dumper \#classList;
# Printing out the students for each class
for my $class (#classList) {
my $course = $class->{courseName};
my $section = $class->{courseSection};
my $students = $class->{students};
my $total_students = scalar #$students;
my $names = join ', ', map { $_->{studName} } #$students;
print "There are $total_students taking $course section $section.\n";
print "There names are [ $names ]\n";
}
Output
VAR1 = [
{
'students' => [],
'section' => 101,
'courseName' => 'Algebra'
},
{
'students' => [
{
'studNum' => 13579,
'studName' => 'Alice'
}
],
'section' => 102,
'courseName' => 'Geometry'
}
];
There are 0 students taking Algebra section 101.
There names are [ ]
There are 1 students taking Geometry section 102.
There names are [ Alice ]

perl array not populating, despite hours of tinkering

Um...I have the following code snippet, and was wondering why the second subroutine, search($$) fails to yield results...while the first routine, search_item($$$), performs admirably (imo).
########################
# generate and return a list of users which match only
# one criteria (eg: eyes=2)
#
# $users is a reference to an array of 6-digit hexidecimal user IDs (eg: 000001, 000002, etc)
# $name is the name of the key (or field) to find (eg: 'eyes')
# $value (eg: 2) is compared with the value stored in the key
# if $value matches what's in the $name'd key, then add the uid to a list
sub search_item($$$) {
my ($users, $name, $value) = #_;
my #searched;
foreach my $uid (#$users) {
my %ustats = user::getUserStats($uid);
if ($ustats{$name} eq $value) { push #searched, $uid; }
}
return #searched;
}
########################
# generate and return a list of users which match
# many criteria (eg: eyes=2, hair=1, etc)
#
# $users is a reference to an array of user IDs (eg: 000001, 000002, etc)
# $terms is a reference to an array of search terms (eg: $terms[0] = "eyes=2";)
sub search($$) {
my $users = $_[0]; # an array reference
my $terms = $_[1]; # an array reference
my #searched;
my $first = 1;
foreach my $term (#$terms) {
# since #$terms is an array of scalars, in the format of 'name=value' pairs
my $name = $term; $name =~ s/=(.)*//;
my $value = $term; $value =~ s/$name=//;
if ($first) {
# search the given list reference ($users)
#searched = search_item($users, $name, $value);
$first = 0; # set to 0 cause now we gotta use #searched
} else {
# otherwise use a reference to #searched
#searched = search_item(\#searched, $name, $value);
}
}
return #searched;
}
i have setup the data so the code should return 1 hit. the data is correct and underlying functions (eg: getUserStats($)) also perform flawlessly.
both user 000001 and 969696 have eyes=2 all others eyes=1 and
user ID 000001 is gender=1, all others gender=0
so...if i write:
my #users = getUsers();
foreach my $uid (search_item(\#users, 'eyes', 2)) {
print "$uid<br>\n";
}
i get 2 hits of a total of 6 users in my database (this IS a correct result, of course). satisfied with those results, I run the search routine.
my #terms = ('eyes=2', 'gender=1'); # gender=0 is a boy. 1 is a girl
my #sResults = search(\#users, \#terms);
if (#sResults) {
foreach my $uid (#sResults) {
print "$uid<br>\n";
}
} else {
print "nothing found!<br>\n";
}
i always see "nothing found!" when i pray and hope to see "000001" instead... :(
this seems like legit code....so....whud am i doin wrong guys??? am i not derefencing something correctly? or...is the dereferencing / referencing the source of my dilema? i loath pointers...however incredibly useful :p
Your code does actually work if you pass correct parameters. My best guess is that the strings like eyes=2 that you're using contain spurious whitespace such as a trailing newline
Here's the test program that I used to work on your subrouitines
use strict;
use warnings;
use 5.010;
my %users = (
'000001' => { eyes => 2, gender => 1 },
'000002' => { eyes => 1, gender => 0 },
'000003' => { eyes => 1, gender => 0 },
'000004' => { eyes => 1, gender => 0 },
'969696' => { eyes => 2, gender => 0 },
);
sub user::getUserStats {
my ( $uid ) = #_;
%{ $users{$uid} };
}
########################
# generate and return a list of users which match only
# one criteria (eg: eyes=2)
#
# $users is a reference to an array of 6-digit hexidecimal user IDs (eg: 000001, 000002, etc)
# $name is the name of the key (or field) to find (eg: 'eyes')
# $value (eg: 2) is compared with the value stored in the key
# if $value matches what's in the $name'd key, then add the uid to a list
sub search_item($$$) {
my ( $users, $name, $value ) = #_;
my #searched;
foreach my $uid ( #$users ) {
my %ustats = user::getUserStats( $uid );
if ( $ustats{$name} eq $value ) { push #searched, $uid; }
}
return #searched;
}
########################
# generate and return a list of users which match
# many criteria (eg: eyes=2, hair=1, etc)
#
# $users is a reference to an array of user IDs (eg: 000001, 000002, etc)
# $terms is a reference to an array of search terms (eg: $terms[0] = "eyes=2";)
sub search($$) {
my $users = $_[0]; # an array reference
my $terms = $_[1]; # an array reference
my #searched;
my $first = 1;
foreach my $term ( #$terms ) {
# since #$terms is an array of scalars, in the format of 'name=value' pairs
my $name = $term;
$name =~ s/=(.)*//;
my $value = $term;
$value =~ s/$name=//;
if ( $first ) {
# search the given list reference ($users)
#searched = search_item( $users, $name, $value );
$first = 0; # set to 0 cause now we gotta use #searched
}
else {
# otherwise use a reference to #searched
#searched = search_item( \#searched, $name, $value );
}
}
return #searched;
}
my $users = [ keys %users ];
say for search( $users, [ 'eyes=2', 'gender=1' ] );
output
000001
Here's how I would write similar subroutines that behave identically and take the same parameters, but there is a lot in the design of this application that is less that optimal
sub search_item {
my ( $users, $name, $value ) = #_;
grep {
my %ustats = user::getUserStats( $_ );
$ustats{$name} eq $value;
} #$users;
}
sub search {
my ($users, $terms) = #_;
my #searched;
for my $term ( #$terms ) {
my ($name, $value) = split /=/, $term;
#searched = search_item( $users, $name, $value );
$users = \#searched;
}
#searched;
}
but I think user::getUserStats should be called User::get_user_stats (because Perl reserves capital letters for global identifiers such as package names) and it should return a reference to a hash instead of just a list

Iterate through a hash and an array in Perl

I have an array and a hash:
#arraycodons = "AATG", "AAAA", "TTGC"... etc.
%hashdictionary = ("AATG" => "A", "AAAA" => "B"... etc.)
I need to translate each element of the array for the corresponding value in hashdictionary. However, I obtain a wrong translation.....
To see the problem, I have printed $codon (each element of the array), but each codon is repeated several times..... and It shouldn't.
sub translation() {
foreach $codon (#arraycodons) {
foreach $k (keys %hashdictionary) {
if ($codon == $k) {
$v = $hashdictionary{$k};
print $codon;
}
}
}
}
I don't know if I've explained my problem well enough, but I can't go on with my code if this doesn't work...
Many thanks in advance.
You appear to be looping through the keys of your hash (also known as a "dictionary") to find your desired key. This defeats the purpose of a hash (also known as a "dictionary") - the primary advantage of which is ultra fast lookups of a key.
Try, instead of
foreach $codon (#arraycodons) {
foreach $k (keys %hashdictionary) {
if ($codon == $k) {
$v = $hashdictionary{$k};
print $codon;
}
}
}
this:
foreach $codon (#arraycodons) {
my $value = $hashdictionary{$codon};
print( "$codon => $value\n" );
}
or:
foreach my $key ( keys %hashdictionary ) {
my $value = $hashdictionary{$key};
print( "$key => $value\n" );
}
my #mappedcodons = map {$hashdictionary{$_}}
grep (defined $hashdictionary{$_},#arraycodons);
or
my #mappedcodons = grep ($_ ne "", map{$hashdictionary{$_} || ""} #arraycodons);
my #words = ("car", "house", "world");
my %dictionary = ("car" => "el coche", "house" => "la casa", "world" => "el mundo");
my #keys = keys %dictionary;
foreach(#words) {
my $word = $_;
foreach(#keys) {
if($_ eq $word) { # eq, not ==
my $translation = $dictionary{$_};
print "The Spanish translation of $word is $translation\n";
}
}
}

perl hash of arrays

I am trying to access elements of an array which is part of a hash.
for my $idx ( 0 .. $#vss ) {
push (#{$vsnhash->{$vss[$idx]}}, $vsports[$idx]);
}
print Dumper(\%$vsnhash);
($VAR1 = {
'name2' => [
'8001',
'8002'
],
'name1' => [
'8000'
]
};
I an able to access the keys with a foreach loop:
foreach my $key ( keys %$vsnhash ) {
print "$key\n";
}
How do I access the array of port numbers ('8001' , '8002') within the hash?
Thank you for the help!
while (my ($k, $v) = each %$vsnhash) {
print "$k: #$v\n";
}
foreach my $key ( keys %$vsnhash ) {
print "$key\n";
foreach my $port (#{$vsnhash->{key}}){
print "Port $port\n";
}
}
$vsnhash{name2}->[0]; #8001
$vsnhash{name2}->[1]; #8002
$vsnhash{name1}->[0]; #8000
Code wise:
foreach my $key (sort keys %vsnhash) {
foreach my $index (0..$#{$key}) {
print "\$vsnhash{$key}->[$index] = " . $vsnhash{$key}->[$index] . "\n";
}
}
The $#{$key} means the last entry in the array #{$key}. Remember that $key is a reference to an array while #{$key} is the array itself.

Resources