哪位大哥能把这个gava脚本改写为Perl脚本？

长生天一

<script>
function pairaln(seq1, seq2){
        // scoring scheme
       
        var MATCH    =  1; // +1 for letters that match
        var MISMATCH = -1; // -1 for letters that mismatch
        var GAP      = -1; // -1 for any gap
        // initialization
       
        var score=[[]];
        var pointer=[[]];
        score[0][0]   = 0;
        pointer[0][0] = 0;
        var l1=seq1.length
        var l2=seq2.length
       
        for(var j = 1; j <= l1; j++) {
               
                    score[0][j]   = GAP * j;
                    pointer[0][j] = 2;
        }
        for (var i = 1; i <= l2; i++) {
               
                score[i]=[];
                pointer[i]=[];
                    score[i][0]   = GAP * i;
                    pointer[i][0] = 3;
        }
        // fill
       
        for(var i = 1; i <= l2; i++) {
                var letter2 = seq2.charAt(i-1);

                    for(var j = 1; j <= l1; j++) {
                           
                        var diagonal_score, left_score, up_score;
                        // calculate match score
                       
                        var letter1 = seq1.charAt(j-1);                        
                       
                        if (letter1 == letter2) {
                           
                                    diagonal_score = score[i-1][j-1] + MATCH;
                        }
                       
                        else {
                                    diagonal_score = score[i-1][j-1] + MISMATCH;
                        }
                        // calculate gap scores
                       
                        up_score   = score[i-1][j] + GAP;
                        left_score = score[i][j-1] + GAP;
                        // choose best score
                       
                        if (diagonal_score >= up_score) {
                                   
                                    if (diagonal_score >= left_score) {
                                       
                                        score[i][j]   = diagonal_score;
                                        pointer[i][j] = 1;
                                    }
                               
                                else {
                                        score[i][j]   = left_score;
                                        pointer[i][j] = 2;
                                    }
                       
                        } else {
                                   
                                    if (up_score >= left_score) {
                                       
                                        score[i][j]   = up_score;
                                        pointer[i][j] = 3;
                                    }
                                   
                                    else {
                                        score[i][j]   = left_score;
                                        pointer[i][j] = 2;
                                    }
                        }
                    }
        }
        // trace-back
       
        var align1 = [];
        var align2 = [];
        // start at last cell of matrix
        var j = l1;
        var i = l2;
        while (1) {
   
                    if(pointer[i][j] == 0)break // ends at first cell of matrix
                    if (pointer[i][j] == 1) {
        
                        align1[align1.length] = seq1.charAt(j-1);
                        align2[align2.length] = seq2.charAt(i-1);
                        i--;
                        j--;
                    }
                   
                    if (pointer[i][j] == 2) {
        
                        align1[align1.length] = seq1.charAt(j-1);
                        align2[align2.length] = "-";
                        j--;
                    }
                   
                    if (pointer[i][j] == 3) {
        
                        align1[align1.length] = "-";
                        align2[align2.length] = seq2.charAt(i-1);
                        i--;
                    }   
        }
        align1 = align1.reverse();
        align2 = align2.reverse();
return "序列：<p>"+seq1+"<br>"+seq2+"<p>比对结果：<table><tr><td>"+align1.join("</td><td>")+"</td></tr><tr><td>"+align2.join("</td><td>")+"</tr></table>"
}
document.write(pairaln('CTGGGCTGACTGA', 'GACTAGCTAGACTGA'))
</script>

nsnake

LZ是想完成自己作业的吧

长生天一

回复 2# nsnake


    这是动态规划的一个算法，用java写的，我没学过java，现在也没时间学，看不懂，谁要能以perl改写一下，我就能看懂了。在此我也想学一下perl的高级数据结构该怎么用。

climby

源码是javascript的，跟java还是差别很大的。{:3_193:}

climby

我帮你翻译了一下，初看看不出来该脚本是做什么的，但我运行了我翻译的perl脚本，看结果我知道了。
这个脚本是求出2个字串中匹配程度最高的子串。
翻译其实没有什么技术含量，多半就是变量名前加$.(估计这也是很多人不屑动手的原因{:3_189:})
perl代码：

1. 
   
2. #!/usr/bin/perl
   
3. 
   
4. sub pairaln {
   
5.     my ( $seq1, $seq2 ) = @_;
   
6. 
   
7.     my $MATCH    = 1;     # +1 for letters that match
   
8.     my $MISMATCH = -1;    #-1 for letters that mismatch
   
9.     my $GAP      = -1;    # -1 for any gap
   
10. 
    
11.     # initialization
    
12.     my $score   = [];
    
13.     my $pointer = [];
    
14.     $score->[0] = [] unless ( defined $score->[0] );
    
15.     $score->[0]->[0] = 0;
    
16.     $pointer->[0] = [] unless ( defined $pointer->[0] );
    
17.     $pointer->[0]->[0] = 0;
    
18.     my $l1 = length $seq1;
    
19.     my $l2 = length $seq2;
    
20. 
    
21.     for ( my $j = 1; $j <= $l1; $j++ ) {
    
22. 
    
23.         $score[0][$j]   = $GAP * $j;
    
24.         $pointer[0][$j] = 2;
    
25.     }
    
26. 
    
27.     for ( my $i = 1; $i <= $l2; $i++ ) {
    
28. 
    
29.         $score->[$i] = [] unless ( defined $score->[$i] );
    
30.         $pointer->[$i] = [] unless ( defined $pointer->[$i] );
    
31.         $score->[$i]->[0]   = $GAP * $i;
    
32.         $pointer->[$i]->[0] = 3;
    
33.     }
    
34. 
    
35.     # fill
    
36. 
    
37.     for ( my $i = 1; $i <= $l2; $i++ ) {
    
38.         my $letter2 = substr( $seq2, $i - 1, 1 );
    
39. 
    
40.         for ( my $j = 1; $j <= $l1; $j++ ) {
    
41. 
    
42.             my ( $diagonal_score, $left_score, $up_score );
    
43. 
    
44.             # calculate match score
    
45. 
    
46.             my $letter1 = substr( $seq1, $j - 1, 1 );
    
47. 
    
48.             if ( $letter1 eq $letter2 ) {
    
49. 
    
50.                 $diagonal_score = $score->[ $i - 1 ]->[ $j - 1 ] + $MATCH;
    
51.             }
    
52. 
    
53.             else {
    
54.                 $diagonal_score = $score->[ $i - 1 ]->[ $j - 1 ] + $MISMATCH;
    
55.             }
    
56. 
    
57.             # calculate gap scores
    
58. 
    
59.             $up_score   = $score->[ $i - 1 ]->[$j] + $GAP;
    
60.             $left_score = $score->[$i]->[ $j - 1 ] + $GAP;
    
61. 
    
62.             # choose best score
    
63. 
    
64.             if ( $diagonal_score >= $up_score ) {
    
65. 
    
66.                 if ( $diagonal_score >= $left_score ) {
    
67. 
    
68.                     $score->[$i]->[$j]   = $diagonal_score;
    
69.                     $pointer->[$i]->[$j] = 1;
    
70.                 }
    
71. 
    
72.                 else {
    
73.                     $score->[$i]->[$j]   = $left_score;
    
74.                     $pointer->[$i]->[$j] = 2;
    
75.                 }
    
76. 
    
77.             }
    
78.             else {
    
79. 
    
80.                 if ( $up_score >= $left_score ) {
    
81. 
    
82.                     $score->[$i]->[$j]   = $up_score;
    
83.                     $pointer->[$i]->[$j] = 3;
    
84.                 }
    
85. 
    
86.                 else {
    
87.                     $score->[$i]->[$j]   = $left_score;
    
88.                     $pointer->[$i]->[$j] = 2;
    
89.                 }
    
90.             }
    
91.         }
    
92.     }
    
93. 
    
94.     # trace-back
    
95. 
    
96.     my $align1 = [];
    
97.     my $align2 = [];
    
98. 
    
99.     # start at last cell of matrix
    
100.     my $j = $l1;
     
101.     my $i = $l2;
     
102.     while (1) {
     
103. 
     
104.         last if ( $pointer->[$i]->[$j] == 0 );  # ends at first cell of matrix
     
105.         my $len_align1 = scalar(@$align1);
     
106.         my $len_align2 = scalar(@$align2);
     
107.         if ( $pointer->[$i]->[$j] == 1 ) {
     
108. 
     
109.             $align1->[$len_align1] = substr( $seq1, $j - 1, 1 );
     
110.             $align2->[$len_align2] = substr( $seq2, $i - 1, 1 );
     
111.             $i--;
     
112.             $j--;
     
113.         }
     
114. 
     
115.         if ( $pointer->[$i]->[$j] == 2 ) {
     
116. 
     
117.             $align1->[$len_align1] = substr( $seq1, $j - 1, 1 );
     
118.             $align2->[$len_align2] = "-";
     
119.             $j--;
     
120.         }
     
121. 
     
122.         if ( $pointer->[$i]->[$j] == 3 ) {
     
123. 
     
124.             $align1->[$len_align1] = "-";
     
125.             $align2->[$len_align2] = substr( $seq2 . $i - 1, 1 );
     
126.             $i--;
     
127.         }
     
128.     }
     
129.     my @re_align1 = reverse @$align1;
     
130.     my @re_align2 = reverse @$align2;
     
131.     my $result    = "";
     
132.     $result .= "序列：\n$seq1\n$seq2\n比对结果：\n@re_align1\n@re_align2";
     
133.     return $result;
     
134. 
     
135. }
     
136. 
     
137. my $output = &pairaln( 'CTGGGCTGACTGA', 'GACTAGCTAGACTGA' );
     
138. print $output;
     
139. 
     

复制代码

运行结果：

1. 
   
2. 序列：
   
3. CTGGGCTGACTGA
   
4. GACTAGCTAGACTGA
   
5. 比对结果：
   
6. - - T G G C T - A C T G A
   
7. 1 1 T - G C T 1 A C T G A
   

复制代码

长生天一

回复 5# climby


   这位大哥，我有几处不明白的地方，想请您解释一下，主要是二维的数据结构没理解。
1.   my $score   = [];
      my $pointer = [];
      $score->[0] = [] unless ( defined $score->[0] );
      $score->[0]->[0] = 0;
my $score   = [];这是什么意思？是定义一个多维的匿名数组？我print它，看结果好像$score是一个数组地址。我不懂怎么定义一个多维数组，并对其初始化？
$score->[0] = [] unless ( defined $score->[0] );这句我也不懂为什么要加上它似乎defined $score->[0]肯定是假，所以前面的肯定执行。
2. while (1) {}；这里我也没看明白，难道这不是一个无穷循环吗？执行起来不是，但看起来是。
3.  my $result    = "";这是什么意思？我完全不理解？什么都没有，把它赋给一个标量，这是为什么呀？
    $result .= "??:\n$seq1\n$seq2\n????:\n@re_align1\n@re_align2";这里的一对问号和冒号是什么意思呀，我从来没见过。
    我最想知道的是怎么在前面定义一个以后要用的多维数组（我不知它可能是多少维）？怎么初始化或暂不初始化？
    我编程一般都加-w和use strict；好像前面用 my $score   = [];定义后，后面用$score[0][$j]时，他报错说数组没明确定义；但对$score->[0]->[0]，他为什么不报错呀？$score[0][$j]和$score->[0]->[0]不是同样的意思吗？这两种写法的本质区别是什么呀？
    高级结构我看的是intermediate perl，主要在讲引用，感觉对这些细节讲的少，又是英文，我看的不太懂；大骆驼感觉翻译的太差，也没理解实质，所以想请大哥开导一下我，解答一下这些问题，小弟不胜感激！
    还有，我觉得javascript的代码好像比perl的代码少且精炼，是javascript比perl强大么？perl是不是老了点？

climby

回复 6# 长生天一
针对你所提的问题一一回答：

1.   my $score   = [];
      my $pointer = [];
      $score->[0] = [] unless ( defined $score->[0] );
      $score->[0]->[0] = 0;
my $score   = [];这是什么意思？是定义一个多维的匿名数组？我print它，看结果好像$score是一个数组地址。

A: my $score   = []; 就是定义了一个匿名的数组， $score是这个匿名数组的引用。至于这是否是定义了一个多维数组，要看该数组中保存的内容了。如果数组元素是具体的数字，字符，那就是一维数组，如果数组元素保存的另外数组的引用，就是多维数组了。

我不懂怎么定义一个多维数组，并对其初始化？

A: 以下就是一个多维数组初始化的例子

1.   
   
2.       my $score   = [];
   
3.       $score->[0] = [] unless ( defined $score->[0] );   # 在此定义了$score的第0个元素保存的也是数组引用，因此整体相当于2维数组了
   
4.       $score->[0]->[0] = 0;    # 初始化为0
   

复制代码

$score->[0] = [] unless ( defined $score->[0] );这句我也不懂为什么要加上它似乎defined $score->[0]肯定是假，所以前面的肯定执行。

A: 该定义处于循环体中，使用unless是避免每次循环重新定义，导致上次循环的数据丢失了。

2. while (1) {}；这里我也没看明白，难道这不是一个无穷循环吗？执行起来不是，但看起来是。

A: 个人建议你先看看编程相关的书，这个是很基础的一个方法。 当循环退出条件不易事先给出时，我们可以使用 while (1) {} 这种形式，在循环体内再通过条件跳出循环。

3.  my $result    = "";这是什么意思？我完全不理解？什么都没有，把它赋给一个标量，这是为什么呀？

A: 这个都要问为什么，我， 我真的强烈建议你看看书的。 $result被用来保存字符串，我们在声明的时候，同时初始化成空串，在下文中，对该字串进行内容追加。 这个都完全不理解！，我都不知道说什么好了。

$result .= "序列：\n$seq1\n$seq2\n比对结果：\n@re_align1\n@re_align2";这里的一对问号和冒号是什么意思呀，我从来没见过。

A: {:3_198:} ，字符串 放在双引号当中，变量会自动被实际内容替换掉。 冒号就是冒号，如果非要我说出个意思来，我想先问问你，你的脑袋长在头上是什么意思呢？

我编程一般都加-w和use strict；好像前面用 my $score   = [];定义后，后面用$score[0][$j]时，他报错说数组没明确定义；但对$score->[0]->[0]，他为什么不报错呀？$score[0][$j]和$score->[0]->[0]不是同样的意思吗？这两种写法的本质区别是什么呀？

A: 这个是我完全按照js 脚本翻译时没有写的很严谨，$score[0][$j] 这种写法,是数组调用形式，perl解析器检查语法时，需要先声明@score数组，但我们声明的$score是一个匿名数组引用，因此报了一些warning,其实我们统一按照引用的写法，解析器就能正确识别了。
原始代码：

1. 
   
2. for ( my $j = 1; $j <= $l1; $j++ ) {
   
3. 
   
4. 
   
5.          $score[0][$j]   = $GAP * $j;
   
6.          $pointer[0][$j] = 2;
   
7.      }
   

复制代码

修正后：

1. 
   
2. for ( my $j = 1; $j <= $l1; $j++ ) {
   
3. 
   
4. 
   
5.          $score->[0]->[$j]   = $GAP * $j;
   
6.          $pointer->[0]->[$j] = 2;
   
7.      }

复制代码

我觉得javascript的代码好像比perl的代码少且精炼，是javascript比perl强大么？perl是不是老了点？

A: {:3_183:}  要追求精炼，谁又能比得上perl呢，只怕太精炼了，你... 你看得懂么？(没有鄙视楼主水平的意思，有例为证！) 只有一行的perl程序。 javascript和perl基本上没有什么可比性，我觉得你对他们都不了解才说出这样的话来，我不怪你！ 但如果你以后还想在perl版块里混，想在这里获得帮助，真的不要再提这样问题了。

长生天一

回复 7# climby


    谢谢大哥的耐心指教，小弟受益匪浅。
    我还有最后一个基本问题，就是：
    我见过$score[$i][$j]有时可写成$score->[$i]->[$j]，有时又写成$score[$i]->[$j]，我看书时没看懂什么时候可以省略第一个->，想请大哥明示。
    还有，多维数组定义是不是一般都通过my $score=[]，而不再用原来一维的my @score的定义方法了？还是另有什么特定的应用范围？多维哈希也是这样吗？小弟经验确实不足。
    多维数组中，[]里放的是引用（可以是变量名），而解引用时，[]里既可放角标（0..9），也可放引用，弄的我就很糊，大哥能否帮我理一理？主要是上学时稍微学过一些C语言，感觉它的二维数组定义和解的时候就很明确，而且我的感觉是C里就是给你矩阵，而perl里先给你一层，再给你一层，不是直接给出矩阵，这让我很不习惯，这是我学不动高级数据结构的根本原因。想请大哥谈谈怎么更好的理解多维数组？
    我原来没怎么接触过计算机，现在迫于工作需要，必须要用perl编写小程序处理数据，自学了一个月，也没人教，只看了learning perl和一部分intermediate perl，感觉里面的实例较少，想请大哥推荐本好的实例经典的书看看。这段时间下来，感觉光看基本语法不行，只有通过实例才能更快提高解决问题的能力。谢谢！

climby

回复 8# 长生天一


   

我见过$score[$i][$j]有时可写成$score->[$i]->[$j]，有时又写成$score[$i]->[$j]，我看书时没看懂什么时候可以省略第一个->，想请大哥明示。

A:  $score[$i][$j］和 $score->[$i]->[$j] 是两种不同表达方式的。并不是像你所说的前者有时可写成后者。 对于$score[$i][$j］的表达方式，前提是存在数组@score, $score[$i]是对数组@score中元素的引用，虽然我们也看到了$score，但只要你看了书你就知道，其实并不存在$score的，也就是说$score[$i] 可以和$score毫无关系。对于 $score->[$i]->[$j]的表达方式，很明显，$score是真实存在,只不过它不是一个普通标量，是一个数组的引用。 对于 $score[$i]->[$j]的表达方式。如果你读懂我前面的描述，我想你应该就能明白的。 很明显 $score[$i]对应的是数组@score的一个元素，这个数组元素中保存的是另外一个数组的引用。
     对于学习perl的，例子比较多的书，我想perl  cookbook很不错的，讲的都是针对一些具体问题的解决方法，实实在在的例子，还有代码分析。一直是我手边的参考书的

ykredrum

document.write(pairaln('CTGGGCTGACTGA', 'GACTAGCTAGACTGA'))
学生物化学的，高科技啊