making presence/absence table from a hash of arrays

[reubs85]

Hello Monks,

Please impart some Perl wisdom to a poor and pitiful Monkling...

Allow me to paint a simplistic picture of my conundrum: I have an array with (for arguments sake) 5 elements, thus:

one two three four five

And I have a hash where the keys are row numbers and the values are references to an array; this array having a varying number of elements that are equal to the headers in the table, but not necessarily in the same order, like so:

row_1 = one five two
row_2 = four two
row_3 = three one five four
etc...

What I would dearly like is to print a table where each cell is filled with a 1/0 presence/absence binary, depending on if the column header in question is present in the array, thus for the hypothetical example above, we would get:

one two three four five
row_1 = 1 1 0 0 1
row_2 = 0 1 0 1 0
row_3 = 1 0 1 1 1
etc...

Any tips or pointers would be massively appreciated,

Thanks very much!

[jwkrahn]

$ perl -le'
my @array = qw/ one two three four five /;
my %hash  = (
    row_1 => [ qw/ one five two / ],
    row_2 => [ qw/ four two / ],
    row_3 => [ qw/ three one five four / ],
    );

print "@array";

for my $key ( sort keys %hash ) {
    print "$key = ", join " ", map { my $elem = $_; grep( $_ eq $elem,
+ @{ $hash{ $key } } ) ? 1 : 0 } @array;
    }
'
one two three four five
row_1 = 1 1 0 0 1
row_2 = 0 1 0 1 0
row_3 = 1 0 1 1 1

[Anonymous Monk]

The grep can be simplified with a smart match:

for my $key (sort keys %hash) {
    say "$key = ", join ' ', map $_ ~~ $hash{$key} ? 1 : 0, @array;
}

[Anonymous Monk]

Hi

If you a hash and an array, why are you posting a word question (ie homework)?

How do I post a question effectively?, PerlMonks FAQ: Is PerlMonks a good place to get answers for homework?

[reubs85]

Thanks for the responses everyone,

Incidentally, it is not 'homework'; I am a PhD genome biologist still getting to grips with the finer details of Perl - I am going to use the code as part of a script that will allow me to count genes which are shared across different species. The example I wrote was merely for ease of readership.

So whilst its true that I should learn more about the grep and map functions (although asking questions is part of learning, I think), I'm not skipping my way through some homework assignment.

Thanks again!

[Marshall]

It is certainly possible to get a lot done without fancy map statements. There is certainly something to be said for doing something straightforward with foreach loops. Don't worry about being compact/terse - do something that is easy for you to understand - worry about more complex constructs when you are writing a lot more Perl.

See code below. Perl is great at translating one thing into another thing - the hash table. So I just make a hash table table to translate the column name into an array index. This also perhaps could have been just statically declared, but I wanted to make this flexible. For each row in the table, I just zero out an array and use the name2Index translator to turn on the appropriate elements and then print that row.

#!/usr/bin/perl -w
use strict;
use Data::Dump qw(pp);

my $header_row= 'one two three four five';
my %table = (  row_1 => [qw(one five two)],
               row_2 => [qw(four two)],
               row_3 => [qw(three one five four)],
            );
                            
my %name2Index;              

my $col=0;   
foreach my $col_head (split ' ',$header_row)
{
   $name2Index{$col_head} = $col++;
}

print "name2Index table = ",pp(\%name2Index),"\n\n";

foreach my $row (sort keys %table)
{
   my @bitmap = (0) x keys %name2Index;
   
   foreach my $col_name (@{$table{$row}})
   {
      $bitmap[$name2Index{$col_name}] = 1; 
   }
   
   print "$row = @bitmap\n";
}

__END__
name2Index table = { five => 4, four => 3, one => 0, three => 2, two =
+> 1 }

row_1 = 1 1 0 0 1
row_2 = 0 1 0 1 0
row_3 = 1 0 1 1 1

[Anonymous Monk]

You clearly want to use a regular expression:

#!/ichigo/perl

use v5.12;
use warnings;
use strict;

my @array = qw/ one two three four five /;
my %hash  = (
    row_1 => [ qw/ one five two / ],
    row_2 => [ qw/ four two / ],
    row_3 => [ qw/ three one five four / ],
);

my $row = "@array";
say $row;

for my $key (sort keys %hash) {
    my $re = join '|', @{$hash{$key}};
    say "$key = ", grep s/\b($re)\b|\w+/$#-/g, "$row";
}