нужно оптимизировать Сценарий Perl

Question

У меня есть два файла, каждый из примерно 700 000 линий, которые выглядят как:

File1

1 rs58108140 0 10583 A G 
1 rs189107123 0 10611 G C 
1 rs180734498 0 13302 T C 
1 rs144762171 0 13327 C G 
22 rs1001008 0 44928369 G A 

File2

hg19chrc snpid a1 a2 bp info or se p ngt 
1 rs4951859 C G 729679 0.631 0.97853 0.0173 0.2083 0 
1 rs142557973 T C 731718 0.665 1.01949 0.0198 0.3298 0 
22 rs1001008 A G 44928369 0.969 0.98649 0.0107 0.2023 0 

У меня есть сценарий, где я поиск полей, где поля 1 и 4 из файла 1 и поля 1 и 5 из файла 2 совпадают. Затем, если поля 5 и 6 из файла 1 соответствуют полям 3 и 4 из файла 2, я просто распечатываю строку из файла 2. Однако, если поля 3 и 4 (файл2) перевернуты относительно полей 5 и 6 (File1), я беру обратную области 7 из Файл2, и печати линии с этой исправленной областью 7:

#! perl -w                           
use strict; 
use warnings; 

my @kgloci; 
open(my $loci_in, "<", "File1") or die $!; 
while (<$loci_in>) { 
    my ($chr, $snpID, $dist, $bp, $A1, $A2) = split; 
    next if m/Chromosome/; 
    push @kgloci, [$chr, $snpID, $dist, $bp, $A1, $A2]; 
} 
close $loci_in; 

my $filename = shift @ARGV; 
open(my $input, "<", "File2") or die $!; 
while (<$input>) { 
    next if m/hg19chrc/; 
    my ($chr, $snpID, $A1, $A2, $bp, $info, $or, $se, $p, $ngt) = split; 
    foreach my $kglocus (@kgloci) { 
     if ( $chr == $kglocus->[0] 
       and $bp == $kglocus->[3] 
       and $A1 eq $kglocus->[4]){ 
     print "$chr $snpID $A1 $A2 $bp $info $or $se $p $ngt\n"; 
      next; 
     } 
     elsif ($chr == $kglocus->[0] 
      and $bp == $kglocus->[3] 
      and $A1 eq $kglocus->[5]){ 
     my $new_or = 1/$or; 
     print "$chr $snpID $A1 $A2 $bp $info $new_or $se $p $ngt\n"; 
     next; 
     } 
    } 
} 
close($input); 

Как есть, скрипт будет работать в течение нескольких дней. Может ли кто-нибудь указать способ повышения эффективности?

Answer 1

Используйте хэш вместо массива.

Следующий скрипт должен дать тот же результат, как у вас (если А1 и А2 не являются одинаковыми в File1):

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

my %lookup; 
open my $LOCI, '<', 'File1' or die $!; 
while (<$LOCI>) { 
    next if /Chromosome/; 
    my ($chr, $snpID, $dist, $bp, $A1, $A2) = split; 
    $lookup{"$chr:$bp:$A1"} = 1; 
    $lookup{"$chr:$bp:$A2"} = 2; 
} 

open my $IN, '<', 'File2' or die $!; 
while (<$IN>) { 
    next if m/hg19chrc/; 
    my ($chr, $snpID, $A1, $A2, $bp, $info, $or, $se, $p, $ngt) = split; 
    my $new_or = (sub {}, 
        sub { shift }, 
        sub { 1/shift }, 
       )[ $lookup{"$chr:$bp:$A1"} || 0 ]->($or); 
    print "$chr $snpID $A1 $A2 $bp $info $new_or $se $p $ngt\n" 
     if defined $new_or; 
} 

Это, как я создал тестирования данные:

perl -MList::Util=shuffle -wE ' 
    $i = 1; 
    $pos = 1; 
    for (1 .. 10000) { 
     say join " ", $i, "rs$pos", int rand 5, 1000 + int rand 10000, 
      (shuffle(qw(A C T G)))[0,1]; 
     ++$i if rand 1 > .99; 
     $pos += int rand 20; 
    }' > File1 

perl -wE ' 
    $i = 1; 
    $pos = 1; 
    for (1 .. 10000) { 
     say join " ", $i, "rs$pos", (map qw(A C T G)[rand 4],1,2), 
      1000 + int rand 10000, rand 1, rand 5, rand 1, rand 1, 
      int rand 3; 
     ++$i if rand 1 > .99; 
     $pos += int rand 20; 
    }' > File2 

Результаты: старый сценарий занимает 16 секунд, новый - менее 0,1 с. Для больших файлов (700_000 строк) новый скрипт занимает 4 с.