use strict; use warnings; my $xLength = my @xSeq = qw (A A G G C C T T); my $yLength = my @ySeq = qw (A C G T A C T T); my @LM; ; #### Längenmatrix $LM[$_][0] = 0 for 0..$xLength; #### x-Achse mit 0 füllen #### $LM[0][$_] = 0 for 0..$yLength; #### y-Achse mit 0 füllen #### #### Längenmatrix berechnen #### my $tauscher = 0; for my $x (1..$xLength) { for my $y (1..$yLength) { if ($xSeq[$x-1] eq $ySeq[$y-1]) { $tauscher = $LM[$x-1][$y-1] + 2 } else { $tauscher = $LM[$x-1][$y-1] - 1 } for ($LM[$x-1][$y]-1, $LM[$x][$y-1]-1, 0) { $tauscher = $_ if $_ > $tauscher } $LM[$x][$y] = $tauscher; } } #### höchsten Wert finden #### my ($Hochw, $Hochx, $Hochy) = (0, 0, 0); for my $x (0..$xLength) { for my $y (0..$yLength) { if ($Hochw < $LM[$x][$y]) { $Hochw = $LM[$x][$y]; $Hochx = $x; $Hochy = $y; } } } #### Wegematrix berechnen #### my @WM; ; #### Wegematrix my @WStack = ([$Hochx, $Hochy]);#### Wegestack my ($w, $x, $y, $z); while (@WStack) { ($x, $y) = @{pop @WStack}; next if $WM[$x][$y]; $z = $LM[$x][$y]; $w = 0; if ( (( $z == $LM[$x-1][$y-1] + 2 ) or ( $z == $LM[$x-1][$y-1] - 1 )) and ($x > 1 and $y > 1) &nbs p; &nbs p; ) { $w |= 1; push @WStack, [$x-1, $y-1]; } if ( $z == $LM[$x-1][$y] - 1 ) { $w |= 2; push @WStack, [$x-1, $y]; } if ( $z == $LM[$x][$y-1] - 1 ) { $w |= 4; push @WStack, [$x, $y-1]; } $WM[$x][$y] = $w; } #### Optimalen Pfad (align) #### ($x, $y) = ($Hochx, $Hochy); my @oPfad = ($xSeq[$x-1].$ySeq[$y-1]) ; while ($WM[$x][$y]) { $w = $WM[$x][$y]; if ($w & 0b001) { unshift @oPfad, $xSeq[--$x-1].$ySeq[--$y-1] } elsif ($w & 0b010) { unshift @oPfad, $xSeq[--$x-1]."-" } elsif ($w & 0b100) { unshift @oPfad, "-".$ySeq[--$y-1] } } #### allePfade #### my (@allePfade, @CPfad, @abzw); #### Pfade, aktueller Pfad(cursor), Abzweigungen my @PQueue = ([$Hochx, $Hochy, $xSeq[$Hochx-1].$ySeq[$Hochy-1]]); while (@PQueue) { ($x, $y, @CPfad) = @{shift @PQueue}; while ($WM[$x][$y]){ $w = $WM[$x][$y]; @abzw = (); push @abzw, [$x-1, $y-1, $xSeq[$x-2].$ySeq[$y-2]] if $w & 0b001; push @abzw, [$x-1, $y , $xSeq[$x-2]."-" ] if $w & 0b010; push @abzw, [$x , $y-1, "-".$ySeq[$y-2]] if $w & 0b100; push @PQueue, [@{$abzw[$_]}, @CPfad ] for 1 .. $#abzw; unshift @CPfad, $abzw[0][2]; ($x, $y) = @{$abzw[0]}; } push @allePfade, [@CPfad]; } # Ausgabe : print <