在Perl中使用較少的代碼行實現此算法

Question

我想在Perl中實現此算法。 讓我們接受的是：

• DNA1 = GACTAGGC
• DNA2 = AGCTAGGA

DNA1的

第一要素是G，我們會發現，如果沒有爲G在DNA2並將其指向帶點。我們繼續它直到結束，因此圖像顯示相同的元素交點爲點。

下一步是：連接點。要指向點首先應該在一個小方格的左上角，另一個在右下方（我的意思是線條應該有135度）如果嚴格度是2，這意味着拒絕從2出現的線和少於2個點（這意味着如果嚴格度爲3，則圖像上只會有一條線）。

最後一步是：wordcount。如果wordcount是1（它是一個圖像），這意味着比較元素一個接一個。如果是3，則表示將它們中的3個比較。您可以編寫WORDCOUNT是1，因爲它始終是1

我搜索關於它的程序，這是我所：

$infile1 = "DNA1.txt"; 
$infile2 = "DNA2.txt"; 

$outfile = "plot.txt"; 
$wordsize=0; 
$stringency=0; 

open inf, $infile1 or die "STOP! File $infile1 not found.\n"; 
$sequence1=<inf>; 
chomp $sequence1; 
@seq1=split //,$sequence1; 
close inf; 

open inf, $infile2 or die "STOP! File $infile2 not found.\n"; 
$sequence2=<inf>; 
chomp $sequence2; 
@seq2=split //,$sequence2; 
close inf; 

$Lseq1=$#seq1+1; 
$Lseq2=$#seq2+1; 

open ouf, ">$outfile"; 

for ($i=0;$i<$Lseq1;$i++){ 
print ouf "\n"; 
for ($j=0;$j<$Lseq2;$j++){ 
    $match=0; 
    for ($w=0;$w<=$wordsize;$w++){ 
    if($seq1[$i+$w] eq $seq2[$j+$w]){ 
     $match++; 
    } 
    } 
    if($match > $stringency){ 
    print ouf "1"; 
    } 
    else{ 
    print ouf "0"; 
    } 
} 
} 

您可以檢查有關錯誤，我怎麼可以優化我的代碼Perl中的代碼更少？

PS：我認爲可以每次接受$ wordsize等於$嚴格。

編輯1：我編輯了我的代碼，它適用於只是點。

編輯2：算法是這樣的：

qseq, sseq = sequences 
win = number of elements to compare for each point 
Strig = number of matches required for a point 

for each q in qseq: 
    for each s in sseq: 
    if CompareWindow(qseq[q:q+win], s[s:s+win], strig): 
     AddDot(q, s) 

EDIT 3：這裏是一個更好的算法建議：

osl.iu.edu/~chemuell/projects/bioinf/dotplot.ppt

任何想法，可根據該改進代碼更好的算法是可喜的。

Answer 1

首先，最裏面的for循環是完全沒有必要的。擺脫它會加速你的代碼。

其次，您的代碼不超過0.1

修復等$嚴謹的工作：

use strict; 
use warnings; 

my $s1 = 'GACTAGGC'; 
my $s2 = 'AGCTAGGA'; 
my $stringency = 0; 

my @s1 = split //, $s1; 
my @s2 = split //, $s2; 
my @L; 
for my $i (0..$#s1) { 
    for my $j (0..$#s2) { 
     if ($s1[$i] ne $s2[$j]) { 
     $L[$i][$j] = 0; 
     } elsif ($i == 0 || $j == 0) { 
     $L[$i][$j] = 1; 
     } else { 
     $L[$i][$j] = $L[$i-1][$j-1] + 1; 
     } 

     print $L[$i][$j] <= $stringency ? "0" : "1"; 
    } 
    print("\n"); 
} 

現在我們有一個高效的算法，我們可以調整的實施。

use strict; 
use warnings; 

my $s1 = 'GACTAGGC'; 
my $s2 = 'AGCTAGGA'; 
my $stringency = 0; 

my @s1 = split //, $s1; 
my @s2 = split //, $s2; 
my @L = (0) x @s2; 
for my $i (0..$#s1) { 
    for my $j (0..$#s2) { 
     if ($s1[$i] eq $s2[$j]) { 
     ++$L[$j]; 
     } else { 
     $L[$j] = 0; 
     } 

     print $L[$j] <= $stringency ? "0" : "1"; 
    } 

    print("\n"); 
    pop @L; 
    unshift @L, 0; 
} 

如果你想發生了什麼更好的主意，更換

print $L[$j] <= $stringency ? "0" : "1"; 

與

print $L[$j]; 

你就會得到這樣

01000110 
10001002 
00100000 
00020000 
10003001 
02000410 
01000150 
00200000 

順便說一句，試圖實現的是非常相似的o找到longest common substring。

更新要想從文件$s1和$s2，在一次一行，

open(my $fh1, '<', ...) or die(...); 
open(my $fh2, '<', ...) or die(...); 

for (;;) { 
    my $s1 = <$fh1>; 
    my $s2 = <$fh2>; 

    die("Files have different length\n") 
     if defined($s1) && !defined($s2) 
     || !defined($s1) && defined($s2); 

    last if !defined(($s1); 

    chomp($s1); 
    chomp($s2); 

    ... code to generate graph ... 
}