Comment changer cela en "idiomatique" Perl?

Question

Je commence à approfondir Perl, mais j'ai du mal à écrire du code "Perl-ly" au lieu d'écrire C en Perl. Comment puis-je changer le code suivant pour utiliser plus d'idiomes Perl, et comment devrais-je apprendre les idiomes?

Juste une explication de ce qu'il fait: Cette routine fait partie d'un module qui aligne des séquences d'acides aminés ou d'ADN (en utilisant Needelman-Wunch si vous vous souciez de telles choses). Il crée deux tableaux 2d, un pour stocker un score pour chaque position dans les deux séquences, et un pour garder une trace du chemin afin que l'alignement le plus haut score puisse être recréé plus tard. Cela fonctionne bien, mais je sais que je ne fais pas les choses de façon très concise et claire.

modifier: Ce fut pour une mission. Je l'ai terminé, mais je veux un peu nettoyer mon code. Les détails sur la mise en œuvre de l'algorithme peuvent être trouvés on the class website si l'un de vous êtes intéressé.

sub create_matrix { 
    my $self = shift; 
    #empty array reference 
    my $matrix = $self->{score_matrix}; 
    #empty array ref 
    my $path_matrix = $self->{path_matrix}; 
    #$seq1 and $seq2 are strings set previously 
    my $num_of_rows = length($self->{seq1}) + 1; 
    my $num_of_columns = length($self->{seq2}) + 1; 

    #create the 2d array of scores 
    for (my $i = 0; $i < $num_of_rows; $i++) { 
     push(@$matrix, []); 
     push(@$path_matrix, []); 
     $$matrix[$i][0] = $i * $self->{gap_cost}; 
     $$path_matrix[$i][0] = 1; 
    } 

    #fill out the first row 
    for (my $i = 0; $i < $num_of_columns; $i++) { 
     $$matrix[0][$i] = $i * $self->{gap_cost}; 
     $$path_matrix[0][$i] = -1; 
    } 
    #flag to signal end of traceback 
    $$path_matrix[0][0] = 2; 
    #double for loop to fill out each row 
    for (my $row = 1; $row < $num_of_rows; $row++) { 
     for (my $column = 1; $column < $num_of_columns; $column++) { 
      my $seq1_gap = $$matrix[$row-1][$column] + $self->{gap_cost}; 
      my $seq2_gap = $$matrix[$row][$column-1] + $self->{gap_cost}; 
      my $match_mismatch = $$matrix[$row-1][$column-1] + $self->get_match_score(substr($self->{seq1}, $row-1, 1), substr($self->{seq2}, $column-1, 1)); 
      $$matrix[$row][$column] = max($seq1_gap, $seq2_gap, $match_mismatch); 

      #set the path matrix 
      #if it was a gap in seq1, -1, if was a (mis)match 0 if was a gap in seq2 1 
      if ($$matrix[$row][$column] == $seq1_gap) { 
       $$path_matrix[$row][$column] = -1; 
      } 
      elsif ($$matrix[$row][$column] == $match_mismatch) { 
       $$path_matrix[$row][$column] = 0; 
      } 
      elsif ($$matrix[$row][$column] == $seq2_gap) { 
       $$path_matrix[$row][$column] = 1; 
      } 
     } 
    } 
} 

Answer 1

J'ai d'autres commentaires aussi bien, mais voici la première observation:

my $num_of_rows = length($self->{seq1}) + 1; 
my $num_of_columns = length($self->{seq2}) + 1; 

Alors $self->{seq1} et sont des chaînes et vous garder l'accès aux éléments individuels à l'aide substr. Je préfère les stocker sous forme de tableaux de caractères:

$self->{seq1} = [ split //, $seq1 ]; 

Voici comment je l'ai écrit:

sub create_matrix { 
    my $self = shift; 

    my $matrix  = $self->{score_matrix}; 
    my $path_matrix = $self->{path_matrix}; 

    my $rows = @{ $self->{seq1} }; 
    my $cols = @{ $self->{seq2} }; 

    for my $row (0 .. $rows) { 
     $matrix->[$row]->[0] = $row * $self->{gap_cost}; 
     $path_matrix->[$row]->[0] = 1; 
    } 

    my $gap_cost = $self->{gap_cost}; 

    $matrix->[0] = [ map { $_ * $gap_cost } 0 .. $cols ]; 
    $path_matrix->[0] = [ (-1) x ($cols + 1) ]; 

    $path_matrix->[0]->[0] = 2; 

    for my $row (1 .. $rows) { 
     for my $col (1 .. $cols) { 
      my $gap1 = $matrix->[$row - 1]->[$col] + $gap_cost; 
      my $gap2 = $matrix->[$row]->[$col - 1] + $gap_cost; 
      my $match_mismatch = 
       $matrix->[$row - 1]->[$col - 1] + 
       $self->get_match_score(
        $self->{seq1}->[$row - 1], 
        $self->{seq2}->[$col - 1] 
       ); 

      my $max = $matrix->[$row]->[$col] = 
       max($gap1, $gap2, $match_mismatch); 

      $path_matrix->[$row]->[$col] = $max == $gap1 
        ? -1 
        : $max == $gap2 
        ? 1 
        : 0; 
      } 
     } 
    } 

Answer 2

Un simple changement consiste à utiliser for boucles comme celui-ci:

for my $i (0 .. $num_of_rows){ 
    # Do stuff. 
} 

Pour plus d'informations, consultez la documentation Perl sur foreach loops et le range operator.

Answer 3

La majorité de votre code est manipulait des tableaux 2D. Je pense que la plus grande amélioration serait de passer à PDL si vous voulez faire beaucoup de choses avec des tableaux, en particulier si l'efficacité est une préoccupation. C'est un module Perl qui fournit un excellent support de tableau. Les routines sous-jacentes sont implémentées en C pour l'efficacité donc c'est rapide aussi.

Answer 4

Au lieu de déréférencement vos tableaux à deux dimensions comme celui-ci:

$$path_matrix[0][0] = 2; 

faire ceci:

$path_matrix->[0][0] = 2; 

, vous aussi faire beaucoup de si/alors/déclarations d'autre à faire correspondre sous-séquences particulières: ceci pourrait être mieux écrit comme given instructions (l'équivalent de perl5.10 de switch de C). Lisez à ce sujet à perldoc perlsyn:

given ($matrix->[$row][$column]) 
{ 
    when ($seq1_gap)  { $path_matrix->[$row][$column] = -1; } 
    when ($match_mismatch) { $path_matrix->[$row][$column] = 0; } 
    when ($seq2_gap)  { $path_matrix->[$row][$column] = 1; } 
} 

Answer 5

vous obtenez plusieurs suggestions concernant la syntaxe, mais je suggère une approche plus modulaire, si pour aucune autre raison que la lisibilité du code. Il est beaucoup plus facile de se familiariser avec le code si vous pouvez percevoir la situation dans son ensemble avant de vous inquiéter des détails de bas niveau.

Votre méthode principale pourrait ressembler à ceci.

sub create_matrix { 
    my $self = shift; 
    $self->create_2d_array_of_scores; 
    $self->fill_out_first_row; 
    $self->fill_out_other_rows; 
} 

Et vous aussi plusieurs petites méthodes comme celle-ci:

n_of_rows 
n_of_cols 
create_2d_array_of_scores 
fill_out_first_row 
fill_out_other_rows 

Et vous pouvez aller encore plus loin en définissant des méthodes encore plus petites - getters, setters, et ainsi de suite. À ce stade, vos méthodes de niveau intermédiaire telles que create_2d_array_of_scores ne toucheraient pas directement la structure de données sous-jacente.

sub matrix  { shift->{score_matrix} } 
sub gap_cost { shift->{gap_cost}  } 

sub set_matrix_value { 
    my ($self, $r, $c, $val) = @_; 
    $self->matrix->[$r][$c] = $val; 
} 

# Etc. 

Answer 6

Je conseille toujours de regarder CPAN des solutions précédentes ou des exemples de la façon de faire les choses en Perl. Avez-vous regardé Algorithm::NeedlemanWunsch?

La documentation de ce module comprend un exemple de correspondance de séquences d'ADN. Voici un exemple utilisant la matrice de similarité de wikipedia.

#!/usr/bin/perl -w 
use strict; 
use warnings; 
use Inline::Files;     #multiple virtual files inside code 
use Algorithm::NeedlemanWunsch; # refer CPAN - good style guide 

# Read DNA sequences 
my @a = read_DNA_seq("DNA_SEQ_A"); 
my @b = read_DNA_seq("DNA_SEQ_B"); 

# Read Similarity Matrix (held as a Hash of Hashes) 
my %SM = read_Sim_Matrix(); 

# Define scoring based on "Similarity Matrix" %SM 
sub score_sub { 
    if (!@_) { 
     return -3;     # gap penalty same as wikipedia) 
    } 
    return $SM{ $_[0] }{ $_[1] }; # Similarity Value matrix 
} 

my $matcher = Algorithm::NeedlemanWunsch->new(\&score_sub, -3); 
my $score = $matcher->align(\@a, \@b, { align => \&check_align, }); 

print "\nThe maximum score is $score\n"; 

sub check_align { 
    my ($i, $j) = @_;    # @a[i], @b[j] 
    print "seqA pos: $i, seqB pos: $j\t base \'$a[$i]\'\n"; 
} 

sub read_DNA_seq { 
    my $source = shift; 
    my @data; 
    while (<$source>) { 
     push @data, /[ACGT-]{1}/g; 
    } 
    return @data; 
} 

sub read_Sim_Matrix { 

    #Read DNA similarity matrix (scores per Wikipedia) 
    my (@AoA, %HoH); 
    while (<SIMILARITY_MATRIX>) { 
     push @AoA, [/(\S+)+/g]; 
    } 

    for (my $row = 1 ; $row < 5 ; $row++) { 
     for (my $col = 1 ; $col < 5 ; $col++) { 
      $HoH{ $AoA[0][$col] }{ $AoA[$row][0] } = $AoA[$row][$col]; 
     } 
    } 
    return %HoH; 
} 

__DNA_SEQ_A__ 
A T G T A G T G T A T A G T 
A C A T G C A 
__DNA_SEQ_B__ 
A T G T A G T A C A T G C A 
__SIMILARITY_MATRIX__ 
- A G C T 
A 10 -1 -3 -4 
G -1 7 -5 -3 
C -3 -5 9 0 
T -4 -3 0 8 

Et voici quelques exemple de sortie: « Comment puis-je changer cela Perl « idiot » »

seqA pos: 7, seqB pos: 2 base 'G' 
seqA pos: 6, seqB pos: 1 base 'T' 
seqA pos: 4, seqB pos: 0 base 'A' 

The maximum score is 100