try to print mixed hash element in perl - perl

I try to print hash key and value in tree form. my perl code is given below.
use strict ;
use warnings ;
my %hash = (
first => {
a => "one",
b => "two",
c => "three",
},
second => {
d => "four",
e => "five",
f => "six",
},
third => "word",
);
foreach my $line (keys %hash) {
print "$line: \n";
foreach my $elem (keys %{$hash{$line}}) {
print " $elem: " . $hash{$line}->{$elem} . "\n";
}
}
output error message:
second:
d: four
f: six
e: five
third:
Can't use string ("word") as a HASH ref while "strict refs" in use at C:\Users\Dell\Music\PerlPrac\pracHash\hshofhsh_net.pl line 19.
here, under third key value not print. how can i do it?

You can't dereference a string ($hash{third}, i.e. word). You can test whether a particular scalar is a reference or not using ref:
for my $line (keys %hash) {
print "$line: \n";
if ('HASH' eq ref $hash{$line}) {
for my $elem (keys %{ $hash{$line} }) {
print " $elem: $hash{$line}{$elem}\n";
}
} else {
print " $hash{$line}\n";
}
}

Related

Perl Program Issue, how to print scalar and array values together of hash

I also faced the same issue and I used this solution. It helped a lot, but it is useful when all values are scalar but my program contains both array and scalar values. so I am able to print scalar values but unable to print array values. Please suggest what we need to add?
Code:
#!/grid/common/bin/perl
use warnings;
require ("file.pl");
while (my ($key, $val) = each %hash)
{
print "$key => $val\n";
}
Non-scalar values require dereferencing, otherwise you will just print out ARRAY(0xdeadbeef) or HASH(0xdeadbeef) with the memory addresses of those data structures.
Have a good read of Perl Data Structure Cookbook: perldoc perldsc
as well as Perl References: perldoc perlref
Since you did not provide your data, here is an example:
#!/usr/bin/env perl
use warnings;
use strict;
my %hash = ( foo => 'bar',
baz => [ 1, 2, 3 ],
qux => { a => 123, b => 234 }
);
while (my ($key, $val) = each %hash) {
my $ref_type = ref $val;
if ( not $ref_type ) {
# SCALAR VARIABLE
print "$key => $val\n";
next;
}
if ('ARRAY' eq $ref_type) {
print "$key => [ " . join(',', #$val) . " ]\n";
} elsif ('HASH' eq $ref_type) {
print "$key => {\n";
while (my ($k, $v) = each %$val) {
print " $k => $v\n";
}
print "}\n";
} else {
# Otherstuff...
die "Don't know how to handle data of type '$ref_type'";
}
}
Output
baz => [ 1,2,3 ]
qux => {
a => 123
b => 234
}
foo => bar
For more complicated structures, you will need to recurse.
Data::Printer is useful for dumping out complicated structures.

Perl Sort Perl hash of hash like structure by values

I have this structure:
'$self' => {
'stepTimePercentage' =>{
'id12' => {
'percentage' => '1.00'
},
'id15' => {
'percentage' => '30.00'
},
'id4' => {
'percentage' => '20.00'
},
'id9' => {
'percentage' => '15.00'
},
}
}
I want to sort this structure by the values of the 'percentage'. I tryed the following but i get the : "Use of uninitialized value in numeric comparison (<=>)".
foreach my $key (sort{ $self->{stepTimePercentage}->{percentage}{$b} <=> $self->{stepTimePercentage}->{percentage}{$a} } keys %{$self->{stepTimePercentage}}) {
print "$key - $self->{stepTimePercentage}->{$key}->{percentage} % \n";
}
Then I tryed this (and i get "Global symbol "$key" requires explicit package name"):
foreach my $key (sort{ $self->{stepTimePercentage}{key}{$b} <=> $self->{stepTimePercentage}{$key}{$a}} keys %{$self->{stepTimePercentage}}) {
print ("$key - $self->{stepTimePercentage}->{$key}->{percentage} % \n");
}
You're almost there. The key you are sorting on is at the second level of a three-level hash, so you want:
foreach my $key (sort {
$self->{stepTimePercentage}{$b}{percentage}
<=>
$self->{stepTimePercentage}{$a}{percentage}
} keys %{$self->{stepTimePercentage}}) {
print "$key - $self->{stepTimePercentage}->{$key}->{percentage} % \n";
}

Find key for greatest value in hash of hashes in Perl

I have a hash of hashes containing keys, values, and counts of the form ((k1, v1), c1). I am trying to write a subroutine that returns the value of the key passed as a parameter with the greatest count. For example, if I had:
%hash = (
"a" => {
"b" => 2,
"c" => 1,
},
"d" => {
"e" => 4,
},
);
and made the call:
print &function("a");
it should print "b" because key "a" has the highest count of 2 with "b" as its value. Here is the code I have so far:
sub function() {
$key = $_[0];
if(exists($hash{$key})) {
while (my ($value, $count) = each %{$hash{$key}}) {
#logic goes here
}
} else {
return "$key does not exist";
}
}
The sub doesn't need to know anything about the outer hash, so it makes far more sense to call the sub as follows:
print key_with_highest_val($hash{a});
The sub simply needs to iterate over all the elements of that hash, keeping track of the highest value seen, and the key at which it was seen.
sub key_with_highest_val {
my ($h) = #_;
my $hi_v;
my $hi_k;
for my $k (keys(%$h)) {
my $v = $h->{$k};
if (!defined($hi_v) || $v > $hi_v) {
$hi_v = $v;
$hi_k = $k;
}
}
return $hi_k;
}
As Chris Charley points out, List::Util's reduce can simply this function. With the calling convention I recommended above, the reduce solution becomes the following:
use List::Util qw( reduce );
sub key_with_highest_val {
my ($h) = #_;
return reduce { $h->{$a} >= $h->{$b} ? $a : $b } keys(%$h);
}
Both versions return an arbitrary key among those that tied when there's a tie.
Use the reduce function from List::Util (which is part of core perl).
#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw/reduce/;
my %hash = (
"a" => {
"b" => 2,
"c" => 1,
},
"d" => {
"e" => 4,
},
);
my $key = 'a';
print "For key: $key, max key is ", max_key($key, %hash), "\n";
sub max_key {
my ($key, %hash) = #_;
return "$key does not exist" unless exists $hash{$key};
my $href = $hash{$key};
return reduce { $href->{$a} > $href->{$b} ? $a : $b } keys %$href;
}
You should always include use strict and use warnings at the top of your programs to catch errors so you can find and fix them. This requires declaring of your variables with my, like my $key = 'a';, for example and my %hash = ...
This program prints:
For key: a, max key is b
This code makes the following assumptions:
The values of your nested hashes are always numeric.
You don't have duplicate values.
Anything else is left as an exercise for the reader.
use strict;
use warnings;
use Data::Dump;
use List::Util qw(max);
my %hash = (
a => {
b => 2,
c => 1,
},
d => {
e => 4,
},
);
dd(max_hash_value(\%hash, $_)) for 'a' .. 'd';
sub max_hash_value {
my ($hash_ref, $search_key) = #_;
return unless $hash_ref->{$search_key};
my %lookup;
while (my ($key, $value) = each(%{$hash_ref->{$search_key}})) {
$lookup{$value} = $key;
}
return $lookup{max(keys(%lookup))};
}
Output:
"b"
()
()
"e"

HASH(0x1970c80) in Perl script

I have the following code:
#!/usr/bin/perl
use warnings;
use strict;
my $count;
my #chomp;
my $length;
my %hash;
my $orf;
open FILE, "<", $ARGV[0];
while ( my $line = <FILE> ) {
if ( $line =~ /LOCUS/ ) {
$count++;
$line =~ s/ +/\t/g;
#chomp = split( /\t/, $line );
$length = $chomp[2];
$hash{$count}->{length} = $length;
}
elsif ( $line =~ /misc_feature (\w+)\.\.(\w+)/ ) {
$orf = $2 - $1;
if ( !defined $hash{$count}->{orf} or $hash{$count}->{orf} < $orf ) {
$hash{$count}->{orf} = $orf;
}
}
}
for my $key (%hash) {
print $key. "\n";
# print $hash{$key}->{"orf"}."\t".$hash{$key}->{"length"}."\n";
}
that gives the following output:
HASH(0x140ae60)
13891
HASH(0x18d4060)
5056
HASH(0x15c4968)
15612
HASH(0x1970c80)
18787
HASH(0x1a98448)
7684
I do not understand why is it? It should print $count value (for example 1, 2, 3...). In fact, it is printed, but with that HASH(0x over there.
You should use
for my $key (keys %hash)
{ ... }
You need to deference since it's a hash of hashes:
use warnings;
use strict;
for my $length (keys %hash) {
print "$length\n";
for my $count (keys %{$hash{$length}}) {
print "$count\n";
}
}
That's because you're building a hash-of-hashes:
$hash{$count}->{length} = $length;
when you print out $hash{whatever}, you're trying to print out that "inner" hash, which is where your HASH(0xXXXXXXX) output it coming from.
for my $key (keys %hash) {
print $key."\n";
# print $hash{$key}->{"orf"}."\t".$hash{$key}->{"length"}."\n";
}
As many others says, you need to use keys if you want get the keys. So:
for my $key (keys %hash)
^^^^
here
the full example:
use strict;
use warnings;
use feature 'say';
use Data::Dumper;
my %hash = (
cnt13 => {
'length' => 'len13'
},
'cnt12' => {
'orf' => 'orf12',
'length' => 'len12'
},
'cnt11' => {
'length' => 'len11'
},
'cnt10' => {
'orf' => 'orf10',
'length' => 'len10'
}
);
for my $key (keys %hash) {
say "key is CNT: $key";
for my $subkey (keys %{$hash{$key}} ) {
say "\tGot a subkey: $subkey with a value: $hash{$key}->{$subkey}";
}
}
say Dumper \%hash;
prints:
key is CNT: cnt11
Got a subkey: length with a value: len11
key is CNT: cnt13
Got a subkey: length with a value: len13
key is CNT: cnt12
Got a subkey: orf with a value: orf12
Got a subkey: length with a value: len12
key is CNT: cnt10
Got a subkey: length with a value: len10
Got a subkey: orf with a value: orf10
$VAR1 = {
'cnt11' => {
'length' => 'len11'
},
'cnt13' => {
'length' => 'len13'
},
'cnt12' => {
'orf' => 'orf12',
'length' => 'len12'
},
'cnt10' => {
'length' => 'len10',
'orf' => 'orf10'
}
};

Perl Working On Two Hash References

I would like to compare the values of two hash references.
The data dumper of my first hash is this:
$VAR1 = {
'42-MG-BA' => [
{
'chromosome' => '19',
'position' => '35770059',
'genotype' => 'TC'
},
{
'chromosome' => '2',
'position' => '68019584',
'genotype' => 'G'
},
{
'chromosome' => '16',
'position' => '9561557',
'genotype' => 'G'
},
And the second hash is similar to this but with more hashes in the array. I would like to compare the genotype of my first and second hash if the position and the choromosome matches.
map {print "$_= $cave_snp_list->{$_}->[0]->{chromosome}\n"}sort keys %$cave_snp_list;
map {print "$_= $geno_seq_list->{$_}->[0]->{chromosome}\n"}sort keys %$geno_seq_list;
I could do that for the first array of the hashes.
Could you help me in how to work for all the arrays?
This is my actual code in full
#!/software/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Benchmark;
use Config::Config qw(Sequenom.ini);
useDatabase::Conn;
use Data::Dumper;
GetOptions("sam=s" => \my $sample);
my $geno_seq_list = getseqgenotypes($sample);
my $cave_snp_list = getcavemansnpfile($sample);
#print Dumper($geno_seq_list);
print scalar %$geno_seq_list, "\n";
foreach my $sam (keys %{$geno_seq_list}) {
my $seq_used = $geno_seq_list->{$sam};
my $cave_used = $cave_snp_list->{$sam};
print scalar(#$geno_seq_list->{$_}) if sort keys %$geno_seq_list, "\n";
print scalar(#$cave_used), "\n";
#foreach my $seq2com (# {$seq_used } ){
# foreach my $cave2com( # {$cave_used} ){
# print $seq2com->{chromosome},":" ,$cave2com->{chromosome},"\n";
# }
#}
map { print "$_= $cave_snp_list->{$_}->[0]->{chromosome}\n" } sort keys %$cave_snp_list;
map { print "$_= $geno_seq_list->{$_}->[0]->{chromosome}\n" } sort keys %$geno_seq_list;
}
sub getseqgenotypes {
my $snpconn;
my $gen_list = {};
$snpconn = Database::Conn->new('live');
$snpconn->addConnection(DBI->connect('dbi:Oracle:pssd.world', 'sn', 'ss', { RaiseError => 1, AutoCommit => 0 }),
'pssd');
#my $conn2 =Database::Conn->new('live');
#$conn2->addConnection(DBI->connect('dbi:Oracle:COSI.world','nst_owner','nst_owner', {RaiseError =>1 , AutoCommit=>0}),'nst');
my $id_ind = $snpconn->execute('snp::Sequenom::getIdIndforExomeSample', $sample);
my $genotype = $snpconn->executeArrRef('snp::Sequenom::getGenotypeCallsPosition', $id_ind);
foreach my $geno (#{$genotype}) {
push #{ $gen_list->{ $geno->[1] } }, {
chromosome => $geno->[2],
position => $geno->[3],
genotype => $geno->[4],
};
}
return ($gen_list);
} #end of sub getseqgenotypes
sub getcavemansnpfile {
my $nstconn;
my $caveman_list = {};
$nstconn = Database::Conn->new('live');
$nstconn->addConnection(
DBI->connect('dbi:Oracle:CANP.world', 'nst_owner', 'NST_OWNER', { RaiseError => 1, AutoCommit => 0 }), 'nst');
my $id_sample = $nstconn->execute('nst::Caveman::getSampleid', $sample);
#print "IDSample: $id_sample\n";
my $file_location = $nstconn->execute('nst::Caveman::getCaveManSNPSFile', $id_sample);
open(SNPFILE, "<$file_location") || die "Error: Cannot open the file $file_location:$!\n";
while (<SNPFILE>) {
chomp;
next if /^>/;
my #data = split;
my ($nor_geno, $tumor_geno) = split /\//, $data[5];
# array of hash
push #{ $caveman_list->{$sample} }, {
chromosome => $data[0],
position => $data[1],
genotype => $nor_geno,
};
} #end of while loop
close(SNPFILE);
return ($caveman_list);
}
The problem that I see is that you're constructing a tree for generic storage of data, when what you want is a graph, specific to the task. While you are constructing the record, you could also be constructing the part that groups data together. Below is just one example.
my %genotype_for;
my $record
= { chromosome => $data[0]
, position => $data[1]
, genotype => $nor_geno
};
push #{ $gen_list->{ $geno->[1] } }, $record;
# $genotype_for{ position }{ chromosome }{ name of array } = genotype code
$genotype_for{ $data[1] }{ $data[0] }{ $sample } = $nor_geno;
...
return ( $caveman_list, \%genotype_for );
In the main line, you receive them like so:
my ( $cave_snp_list, $geno_lookup ) = getcavemansnpfile( $sample );
This approach at least allows you to locate similar position and chromosome values. If you're going to do much with this, I might suggest an OO approach.
Update
Assuming that you wouldn't have to store the label, we could change the lookup to
$genotype_for{ $data[1] }{ $data[0] } = $nor_geno;
And then the comparison could be written:
foreach my $pos ( keys %$small_lookup ) {
next unless _HASH( my $sh = $small_lookup->{ $pos } )
and _HASH( my $lh = $large_lookup->{ $pos } )
;
foreach my $chrom ( keys %$sh ) {
next unless my $sc = $sh->{ $chrom }
and my $lc = $lh->{ $chrom }
;
print "$sc:$sc";
}
}
However, if you had limited use for the larger list, you could construct the specific case
and pass that in as a filter when creating the longer list.
Thus, in whichever loop creates the longer list, you could just go
...
next unless $sample{ $position }{ $chromosome };
my $record
= { chromosome => $chromosome
, position => $position
, genotype => $genotype
};
...