CODEWITHSUNDEEP
arraysregexperl
Sos
Sos

Reputation: 1949

Manipulating multiple lines with Perl

I have a few-hundreds of lines file of the form

1st  2n  2p  3n  3p  4n  4p
1ABJa  2  20  8  40  3  45
1ABJb  2  40  8  80  3  45
2C3Da  4  50  5  39  2  90
2D4Da  1  10  8  90  8  65

(tab separated file)

From this file, I want to manipulate all lines that have a similar 4 beginning characters in the 1st column (i.e. 1ABJa and 1ABJb) and do:

(note that this can be specified by column position and not name). This would then yield:

1st  2n  2p  3n  3p  4n  4p
1ABJab  4  30  16  60  6  45       
2C3Da  4  50  5  39  2  90
2D4Da  1  10  8  90  8  65

How would you solve this?

This is probably the most complicated way to do this, but here it goes: I am thinking about creating an array of all 4-character unique elements of the 1st column. Then, for that array, running a loop that finds all instances matching those 4 characters. If there are more than 1 instance, identify them, push the columns, and manipulate them. Here's the point that I got until now:

#!/usr/local/bin/perl
use strict;
use warnings;
use feature 'say';
use List::MoreUtils qw(uniq);

my $dir='My\\Path\\To\\Directory';
open my $in,"<", "$dir\\my file.txt" or die;
my @uniqarray; my @lines;

#collects unique elements in 1st column and changes them to 4-character words
while (my $line = <$in>) {
    chomp $line;
    @lines= split '\t', $line;
    if (!grep /$lines[0]/, @uniqarray ){
        $lines[0] =~ s/^(.{4}).*/$1/;
        push @uniqarray,$lines[0];
    }
}

my @l;
#for @uniqarray, find all rows in the input that match them. if more than 1 row is found, manipulate the columns
while (my $something=<$in>) {
    chomp $something;
    @l= split '\t', $something;
    if ( map $something =~ m/$_/,@uniqarray){
        **[DO STUFF]**
    }
}

print join "\n", uniq(@uniqarray);

close $in;

Upvotes: 1

Views: 138

Answers (2)

Borodin
Borodin

Reputation: 126742

This appears to do what you need. It keeps a set of data in a hash for each distinct four-character prefix: a count of the number of records with the same prefix under key n, an array that holds the column totals for that prefix under key totals, and a hash with all the suffixes seen for that prefix under key suffixes.

Prefixes are added to the array @prefixes the first time they are seen, so that the output can be presented in the same order as the input.

It is simply a matter of accumulating the data and then dumping it in the required format, after dividing all the even-numbers columns of the totals array by n.

use strict;
use warnings;

open my $fh, '<', 'data.txt' or die $!;

print scalar <$fh>; # Copy header

my %data;
my @prefixes;

while (<$fh>) {
  chomp;
  my @fields = split /\t/;
  my ($prefix, $suffix) = shift(@fields) =~ /(.{4})(.*)/;
  push @prefixes, $prefix unless $data{$prefix};
  ++$data{$prefix}{n};
  ++$data{$prefix}{suffixes}{$suffix};
  $data{$prefix}{totals}[$_] += $fields[$_] for 0 .. $#fields;
}

for my $prefix (@prefixes) {
  my $val      = $data{$prefix};
  my $totals   = $val->{totals};
  for (my $i = 1; $i < @$totals; $i += 2) {
    $totals->[$i] /= $val->{n};
  }
  my $suffixes = join '', sort keys %{ $val->{suffixes} };
  print join("\t", "$prefix$suffixes", @$totals), "\n";
}

output

1st     2n  2p  3n  3p  4n  4p
1ABJab  4   30  16  60  6   45
2C3Da   4   50  5   39  2   90
2D4Da   1   10  8   90  8   65

Upvotes: 1

Toto
Toto

Reputation: 91488

How about:

my $result;
my $head = <DATA>;
while(<DATA>) {
    chomp;
    my @l = split/\s+/;
    my ($k1,$k2) = ($l[0] =~ /^(....)(.*)$/);
    $result->{$k1}{more} .= $k2 // '';
    $result->{$k1}{nbr}++;

    ;
    $result->{$k1}{n}{2} += $l[1];
    $result->{$k1}{n}{3} += $l[3];
    $result->{$k1}{n}{4} += $l[5];
    $result->{$k1}{p}{2} += $l[2];
    $result->{$k1}{p}{3} += $l[4];
    $result->{$k1}{p}{4} += $l[6];
}

print $head;
foreach my $k (keys %$result) {
    print $k,$result->{$k}{more},"\t";
    for my $c (2,3,4) {
        printf("%d\t",$result->{$k}{n}{$c});
        if (exists($result->{$k}{nbr}) && $result->{$k}{nbr} != 0) {
            printf("%d\t",$result->{$k}{p}{$c}/$result->{$k}{nbr});
        } else {
            printf("%d\t",0);
        }
    }
    print "\n";
}

output:

1st     2n  2p  3n  3p  4n  4p
2D4Da   1   10  8   90  8   65  
1ABJab  4   30  16  60  6   45  
2C3Da   4   50  5   39  2   90

Upvotes: 2

Related Questions