user1987607
user1987607

Reputation: 2157

perl match multiple column names in two files

I have two tab-delimited text files for which I want to match multiple columns.

This is the structure of table 1. It can have a variable number of columns. So I want to use the header to make a match with table2

a    x    y    b    c    d   z
1    .    .    1    1    1   .
2    .    .    2    2    2   .
3    .    .    6    6    3   .
4    .    .    4    4    4   . 

This is the structure of table2. Number of columns & number of lines will always be the same. First line is a header

a   b   c   d   e   f
1   1   1   1   yes  no
2   2   2   2   no   no
3   3   3   3   no   yes

Now if there is a match between the values in column a, b, c and d from both tables, I want to add two extra columns to table2, with the values of columns 'e' and 'f' from table2.

I normally use perl for this & work with hashes

This is what I have

my %hash = ();
while(<$table2>){
    chomp;
    my @cols = split(/\t/);
    my $keyfield = $cols[0];
    my $keyfield2 = $cols[1];
    my $keyfield3 = $cols[2];
    my $keyfield4 = $cols[3];
    push @{ $hash{$keyfield} }, $keyfield2, $keyfield3, $keyfield4;
    }
seek $table1,0,0; #cursor resetting
while(<$table1>){
    chomp;
    my @cols = split(/\t/); 
    my $keyfield = $cols[...]; #how can I make a match here based on the column names
    if (exists($hash{$keyfield})){
        print ... #how can I add two extra columns to the existing $table1?
    }
    else {
        print ...
    }
}

So I have two questions:

how can I make a match here based on the column names

how can I add two extra columns to the existing $table1?

The output should look like this:

a    x    y    b    c    d    z    e    f
1    .    .    1    1    1    .    yes  no
2    .    .    2    2    2    .    no   no
3    .    .    6    6    3    .    'empty'    'empty'
4    .    .    4    4    4    .    'empty'    'empty'

So $table1 has two extra columns, with the values from 'e' and 'f' when there is a match. And empty (so no value) when there is no match.

Upvotes: 0

Views: 484

Answers (1)

Sobrique
Sobrique

Reputation: 53478

The trick here would be to read your first data into a hash, and key the 'data' with the 'lookup'.

Then, run through the reference table - you an use a hash slice, so you can look up by named keys. If present; print. If not, replace with the desired result. E.g. something like this:

#!/usr/bin/env perl
use strict;
use warnings;

use Data::Dumper;

open( my $table1, '<', 'data1.txt' ) or die $!;
open( my $table2, '<', 'data2.txt' ) or die $!;

chomp( my @header = split /\t/, <$table2> );
my %lookup;
while (<$table2>) {
   print;
   chomp;
   my @row = split /\t/;
   #put values into lookup hash, keying on 4 values, to retrieve 'e' and 'f'
   #could do this like the below, if you wanted to use named values. 
   $lookup{ $row[0] }{ $row[1] }{ $row[2] }{ $row[3] } = [ $row[4], $row[5] ];
}
print Dumper \%lookup;

#read one line - the header row - and split it into an array.
chomp( my @header_for_table1 = split /\t/, <$table1> );
print join "\t", @header_for_table1, "e", "f", "\n";
while (<$table1>) {
   chomp;
   my %row;
   @row{@header_for_table1} = split /\t/;
   print join ( "\t", @row{@header_for_table1},
                      @{ $lookup{ $row{a} }{ $row{b} }{ $row{c} }{ $row{d} }
                           // [ "empty", "empty" ] }), "\n";
}

Note // operator is perl 5.10+. You can use || in this case, but be slightly more cautious if you might have zero or empty strings stored. (because 0 is false, but is defined, which is different).

Upvotes: 2

Related Questions