• Publicidad

Algoritmo de ordenación Manber-Myers para array de sufijos

Perl aplicado a la bioinformática

Algoritmo de ordenación Manber-Myers para array de sufijos

Notapor explorer » 2012-01-30 18:37 @817

En bioinformática (y otros muchos campos), una de las tareas habituales es la búsqueda de una cadena en otra más larga. Saber si está, dónde está, y cuántas más veces aparece.

Aún con los ordenadores más potentes, la simple búsqueda secuencial tiene límites si la cadena donde buscamos es enorme.

Una de las técnicas que se suelen utilizar, para acelerar el proceso de búsqueda, es la llamada Array de sufijos.

Supongamos que tenemos una secuencia así:

AGTGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG

entonces, podemos deducir sus sufijos:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
 AGTGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
  GTGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
   TGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
    GTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
     TTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
      TCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
       CCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
        CTCCATAGATATGGCGGTTACCTCCGTTCGTGG
         TCCATAGATATGGCGGTTACCTCCGTTCGTGG
          CCATAGATATGGCGGTTACCTCCGTTCGTGG
           CATAGATATGGCGGTTACCTCCGTTCGTGG
            ATAGATATGGCGGTTACCTCCGTTCGTGG
             TAGATATGGCGGTTACCTCCGTTCGTGG
              AGATATGGCGGTTACCTCCGTTCGTGG
               GATATGGCGGTTACCTCCGTTCGTGG
                ATATGGCGGTTACCTCCGTTCGTGG
                 TATGGCGGTTACCTCCGTTCGTGG
                  ATGGCGGTTACCTCCGTTCGTGG
                   TGGCGGTTACCTCCGTTCGTGG
                    GGCGGTTACCTCCGTTCGTGG
                     GCGGTTACCTCCGTTCGTGG
                      CGGTTACCTCCGTTCGTGG
                       GGTTACCTCCGTTCGTGG
                        GTTACCTCCGTTCGTGG
                         TTACCTCCGTTCGTGG
                          TACCTCCGTTCGTGG
                           ACCTCCGTTCGTGG
                            CCTCCGTTCGTGG
                             CTCCGTTCGTGG
                              TCCGTTCGTGG
                               CCGTTCGTGG
                                CGTTCGTGG
                                 GTTCGTGG
                                  TTCGTGG
                                   TCGTGG
                                    CGTGG
                                     GTGG
                                      TGG
                                       GG
                                        G
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Ahora, estas cadenas las ordenamos alfabéticamente:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
ACCTCCGTTCGTGG
AGATATGGCGGTTACCTCCGTTCGTGG
AGTGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
ATAGATATGGCGGTTACCTCCGTTCGTGG
ATATGGCGGTTACCTCCGTTCGTGG
ATGGCGGTTACCTCCGTTCGTGG
CATAGATATGGCGGTTACCTCCGTTCGTGG
CCATAGATATGGCGGTTACCTCCGTTCGTGG
CCGTTCGTGG
CCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
CCTCCGTTCGTGG
CGGTTACCTCCGTTCGTGG
CGTGG
CGTTCGTGG
CTCCATAGATATGGCGGTTACCTCCGTTCGTGG
CTCCGTTCGTGG
G
GATATGGCGGTTACCTCCGTTCGTGG
GCGGTTACCTCCGTTCGTGG
GG
GGCGGTTACCTCCGTTCGTGG
GGTTACCTCCGTTCGTGG
GTGG
GTGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
GTTACCTCCGTTCGTGG
GTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
GTTCGTGG
TACCTCCGTTCGTGG
TAGATATGGCGGTTACCTCCGTTCGTGG
TATGGCGGTTACCTCCGTTCGTGG
TCCATAGATATGGCGGTTACCTCCGTTCGTGG
TCCGTTCGTGG
TCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
TCGTGG
TGG
TGGCGGTTACCTCCGTTCGTGG
TGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
TTACCTCCGTTCGTGG
TTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
TTCGTGG
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Ya podemos realizar la búsqueda de una subcadena. Supongamos que queremos buscar la cadena GTT. Por medio de búsqueda binaria, localizamos aquellas cadenas que comienzan por esa cadena. Y el número de cadena que encontramos coincide con la posición dentro de la cadena original (si GTT lo encontramos en la subcadena 24, esa es la misma posición donde se encuentra dentro de la primera cadena).

El problema ahora viene en la parte de ordenar los sufijos. Si la cadena es muy larga, puede tardar mucho el generar todas las subcadenas, aparte de consumir mucha memoria, y luego, hacer el proceso de ordenación.

Por ello, lo que se hace es ordenar un vector con las posiciones de las subcadenas. No hace falta extraerlas de la cadena original. Solo es necesario guardar las posiciones de comienzo. Y hacer las ordenaciones usando esas posiciones como referencia.

Así, para el ejemplo mostrado, quedaría:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
27      ACCTCCGTTCGTGG
14      AGATATGGCGGTTACCTCCGTTCGTGG
1       AGTGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
12      ATAGATATGGCGGTTACCTCCGTTCGTGG
16      ATATGGCGGTTACCTCCGTTCGTGG
18      ATGGCGGTTACCTCCGTTCGTGG
11      CATAGATATGGCGGTTACCTCCGTTCGTGG
10      CCATAGATATGGCGGTTACCTCCGTTCGTGG
31      CCGTTCGTGG
7       CCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
28      CCTCCGTTCGTGG
22      CGGTTACCTCCGTTCGTGG
36      CGTGG
32      CGTTCGTGG
8       CTCCATAGATATGGCGGTTACCTCCGTTCGTGG
29      CTCCGTTCGTGG
40      G
15      GATATGGCGGTTACCTCCGTTCGTGG
21      GCGGTTACCTCCGTTCGTGG
39      GG
20      GGCGGTTACCTCCGTTCGTGG
23      GGTTACCTCCGTTCGTGG
37      GTGG
2       GTGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
24      GTTACCTCCGTTCGTGG
4       GTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
33      GTTCGTGG
26      TACCTCCGTTCGTGG
13      TAGATATGGCGGTTACCTCCGTTCGTGG
17      TATGGCGGTTACCTCCGTTCGTGG
9       TCCATAGATATGGCGGTTACCTCCGTTCGTGG
30      TCCGTTCGTGG
6       TCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
35      TCGTGG
38      TGG
19      TGGCGGTTACCTCCGTTCGTGG
3       TGTTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
25      TTACCTCCGTTCGTGG
5       TTCCTCCATAGATATGGCGGTTACCTCCGTTCGTGG
34      TTCGTGG
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Solo almacenamos los números, y con ellos hacemos las ordenaciones y las posteriores búsquedas. Bueno, en realidad es algo más complicado, ya que también se tiene en cuenta la concordancia de caracteres entre sufijos vecinos, que aceleran la búsqueda (se comenta en la página de Wikipedia).

El concepto de array de sufijos, así como su creación, ordenación, y búsqueda, es obra de Gene Myers y Udi Manber, publicado en mayo de 1989, revisado en agosto de 1991, y publicado en la revista SIAM J. Computing en octubre de 1993. La mejor descripción se encuentra en la publicación de agosto de 1991 (500Kb, PDF).

Hace unos días, nuestros amigos del sitio #!/perl/bioinfo publicaron un artículo al respecto, con una implementación del algoritmo de ordenación Manber/Myers escrita en Python.

Es obvio que una solución escrita en Perl, dará unos resultados similares a los ofrecidos con Python, pero los dos quedan muy lejos de los tiempos que una implementación en C ofrece. Ni Python ni Perl se deberían usar para resolver estos problemas, comparado con las prestaciones que nos da un programa compilado. Pero sí que es más fácil de ver y leer el funcionamiento interno del algoritmo. Y por si alguien se pregunta si usar el comando sort ofrecido por el propio lenguaje Perl o Python, no es más rápido que todo esto, le remito al artículo enlazado antes, donde hay una tabla con tiempos entre el algoritmo Manber/Myers y el Mergesort, que es el que suele usar sort().

Como este es un sitio dedicado a Perl, pues podemos intentar mostrar distintas soluciones de ordenación, también a título formativo.

Primero, cómo sería la generación y ordenación de sufijos, en puro Perl, usando las funciones intrínsecas del lenguaje:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. # Prueba de generación de un array de sufijos ordenados usando solo sort()
  3. # by Joaquin Ferrero, 2012.
  4. #
  5.  
  6. ### Módulos
  7. use Modern::Perl;
  8. use utf8::all;
  9. use autodie;
  10. use File::Slurp;
  11. use List::MoreUtils qw(uniq);
  12.  
  13. ### Constantes
  14. use constant {
  15.     DEBUG => 1,
  16. };
  17.  
  18.  
  19. ### Variables
  20. my $A;                          # Secuencia a procesar
  21. my $N;                          # Longitud de la secuencia
  22. my @Σ;                          # Alfabeto
  23.  
  24.  
  25. ### Argumentos
  26. if (@ARGV) {
  27.     my $arg = shift;
  28.    
  29.     if ($arg =~ /^\d+$/) {                                              # Si pasamos un número
  30.         @Σ = sort qw(A C G T);                                          # El alfabeto son las cuatro bases de siempre
  31.         $A = join '', map {[rand 4] } 1 .. $arg;                     # Generamos la secuencia
  32.         $N = $arg;                                                      # La longitud de la secuencia es la indicada
  33.     }
  34.     else {
  35.         $A = read_file($arg, chomp => 'Yes');                           # Leemos el archivo
  36.         @Σ = sort {$a cmp $b} uniq split //, $A;                        # Sacamos su alfabeto
  37.         $N = length $A;                                                 # Y su longitud
  38.         die "ERROR: El fichero está vacío\n" if not $N;
  39.     }
  40. }
  41. else {
  42.     die "Uso: $0 <longitud secuencia aleatorio|fichero con secuencia>\n";
  43. }
  44.  
  45. if (DEBUG) {
  46.     say $A if $N < 50;
  47.     say "Longitud: $N";
  48.     say "Alfabeto: @Σ";
  49. }
  50.                                                                         # Ordenación usando mergesort de Perl
  51. my @sufijos = sort { substr($A, $a) cmp substr($A, $b) } 0 .. $N-1;
  52.  
  53. if ($N < 50) {                                                          # Si la secuencia es pequeña
  54.     for (@sufijos) {                                                    # Sacamos los sufijos ordenados
  55.         printf "%6d\t%s\n", $_, substr $A, $_;
  56.     }
  57. }
  58.  
  59. __END__
Coloreado en 0.007 segundos, usando GeSHi 1.0.8.4

Para secuencias pequeñas, los tiempos son cortos (todos los tiempos sacados en una máquina AMD Athlon(tm) 64 Processor 3000+ a 2Ghz):
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Long.  Tiempo
  5000 0m00.241s
 10000 0m00.516s
 20000 0m01.378s
 40000 0m05.636s
 80000 0m26.524s
160000 5m40.411s
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Ahora veamos cómo sería el código de una implementación exacta del algoritmo de ordenación Manber/Myers:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. # Simple algorithm for Suffix Array creation,
  3. # based on Manber & Myers, Aug 1991
  4. # by Joaquin Ferrero, 2012.
  5. #
  6. # Esta es una versión idéntica a la versión original de Myers, en C,
  7. # con propósito únicamente formativo.
  8. #
  9. # Estadísticas para AMD Athlon 64 3000+ a 2Ghz:
  10. #
  11. #       Longitud   Tiempos
  12. #       ---------+----------
  13. #           5000   0m00.794s
  14. #          10000   0m01.196s
  15. #          20000   0m02.271s
  16. #          40000   0m04.506s
  17. #          80000   0m09.685s
  18. #         160000   0m19.470s
  19. #         320000   0m43.474s
  20. #         640000   1m27.284s
  21. #
  22.  
  23. ### Módulos
  24. use Modern::Perl;
  25. use utf8::all;
  26. use autodie;
  27. use File::Slurp;
  28. use List::MoreUtils qw(uniq);
  29.  
  30. ### Constantes
  31. use constant {
  32.     DEBUG => 1,
  33.     BIT   => 0x8000_0000,
  34.     MASK  => 0x7FFF_FFFF,
  35. };
  36.  
  37. ### Variables
  38. my $A;                          # Secuencia a procesar
  39. my $N;                          # Longitud de la secuencia
  40. my @Σ;                          # Alfabeto
  41.  
  42. ### Argumentos
  43. if (@ARGV) {
  44.     my $arg = shift;
  45.    
  46.     if ($arg =~ /^\d+$/) {                                      # Si pasamos un número...
  47.         @Σ = sort qw(A C G T);                                  # con este alfabeto...
  48.         $A = join '', map {[rand 4] } 1 .. $arg;             # generamos la secuencia...
  49.         $N = $arg;                                              # de esta longitud.
  50.     }
  51.     else {
  52.         $A = read_file($arg, chomp => 'Yes');                   # Si no, leemos el archivo indicado
  53.         @Σ = sort {$a cmp $b} uniq split //, $A;                # del que extraemos su alfabeto
  54.         $N = length $A;                                         # y su longitud
  55.         die "ERROR: El fichero está vacío\n" if not $N;
  56.     }
  57. }
  58. else {
  59.     die "Uso: $0 <longitud secuencia aleatorio|fichero con secuencia>\n";
  60. }
  61.  
  62. if (DEBUG) {
  63.     say $A if $N < 50;
  64.     say "Longitud: $N";
  65.     say "Alfabeto: @Σ";
  66. }
  67.  
  68. ### Reserva de espacio
  69. my @Pos;                                        # Índice -> Inicio de sufijo
  70. my @Prm;                                        # Inicio de sufijo -> Índice de @Pos (Inversa de la anterior)
  71. my @Lcp;                                        # Longest Common Prefixes
  72. my @BH;
  73. my @B2H;
  74.  
  75. my @Min;                                        # auxiliares
  76. my @Mid;
  77.  
  78. $#Pos = $N+1 -1;                                # Reserva de espacio en memoria
  79. $#Lcp = $N-1 -1;                                # -1 porque $#var es el último índice de @var,
  80. $#Prm = $N+1 -1;                                # no el número de elementos de @var
  81. $#BH  = $N+1 -1;
  82. $#B2H = $N+1 -1;
  83.  
  84. my $lgN = 0;                                    # log N / log 2
  85. for (my $i = 1; $i < $N-1; $i <<= 1) { $lgN++ } # averigüamos el número de vueltas del bucle principal
  86. if ($lgN > 0) {
  87.     $#Min = $lgN -1;
  88.     $#Mid = $lgN -1;
  89. }
  90.  
  91. ### Inicialización
  92. $A .= "\0";                                     # Terminador
  93.  
  94. for my $a (0 .. $N-1-1) {
  95.     $Lcp[$a] = $N + 1;                          # Valores iniciales del LCP
  96. }
  97.  
  98.  
  99. ### Firt phase bucket sort                      # Primera ordenación basada en las letras del alfabeto
  100. my %Bucket;                                     # Primera aparición de cada letra del alfabeto
  101. my @Link;
  102. my($a, $b);
  103.  
  104. for my $c ( @Σ ) {
  105.     $Bucket{$c} = -1;                           # Los bucket iniciales lo forman todas las letras del alfabeto
  106. }
  107.  
  108. for ($a = $N-1; $a >= 0; $a--) {                # Ordenación de los buckets
  109.     my $c       = substr $A, $a, 1;
  110.     $Link[$a]   = $Bucket{$c};
  111.     $Bucket{$c} = $a;
  112. }
  113.  
  114. my $rank = 0;
  115. my $c    = 0;
  116. for my $a (@Σ) {                                # Sigue la ordenación, a lo que sumamos el cálculo de $rank
  117.     my $i = $Bucket{$a};
  118.     while ($i != -1) {
  119.         my $j = $Link[$i];
  120.         $Prm[$i] = $c;
  121.         if ($i == $Bucket{$a}) {
  122.             $BH[$c] = 1;
  123.             $rank++;                            # es necesario una vuelta más en el bucle principal
  124.             set($c, 0) if $c;
  125.         }
  126.         else {
  127.             $BH[$c] = 0;
  128.         }
  129.         $c++;
  130.         $i = $j;
  131.     }
  132. }
  133.  
  134. $BH[$N] = 1;
  135. $Pos[$N] = $Prm[$N] = 0;
  136.  
  137. for my $i (0 .. $N-1) {                         # Primeros valores de los array de ordenación
  138.     $Pos[$Prm[$i]] = $i;
  139. }
  140.  
  141. # Inductive sorting stage
  142. for (my $H = 1; $H < $N  and  $rank < $N; $H <<= 1) {   # Bucle principal
  143.  
  144.     say "Level $H. rank $rank" if DEBUG;
  145.  
  146.     my($c, $d);
  147.    
  148.     for ( $a = 0; $a < $N; $BH[$b] = 0 ) {
  149.         for ($b = $a++; !$BH[$a]; $a++) {
  150.             $Prm[$Pos[$a]] = $b;
  151.         }
  152.     }
  153.  
  154.     for ($c = $N-1; $c >= $N-$H; $c--) {
  155.         $b = $Prm[$c];
  156.         for ($d = $b; $Pos[$d] != $c; $d++) { }
  157.         $Pos[$d] = $Pos[$b];
  158.         $Pos[$b] = $c;
  159.         $BH[$b]  = 1;
  160.         $Prm[$c] = 1;
  161.     }
  162.  
  163.     for $a (0 .. $N-1) {
  164.         if (($c = $Pos[$a] - $H) >= 0) {
  165.             $b = $Prm[$c];
  166.             if ($BH[$b]) {
  167.                 $Prm[$c] += $Prm[$Pos[$b]]++;
  168.             }
  169.             else {
  170.                 for ($d = $b; $Pos[$d] != $c; $d++) { }
  171.                 $Pos[$d] = $Pos[$b];
  172.                 $Pos[$b] = $c;
  173.                 $BH[$b]  = 1;
  174.                 $Prm[$c] = 1;
  175.             }
  176.         }
  177.     }
  178.    
  179.     for $a (0 .. $N-1) {
  180.         if ($BH[$a]) {
  181.             $Prm[$Pos[$a]] = $a;
  182.         }
  183.     }
  184.  
  185.     for ($a = 0; $a < $N; ) {
  186.  
  187.         $b = $a;
  188.         do {
  189.             $c = $Pos[$a++] - $H;
  190.             if ($c >= 0) {
  191.                 $B2H[$Prm[$c]] = 1;
  192.             }
  193.         } while ( ! $BH[$a] );
  194.  
  195.         $a = $b;
  196.         do {
  197.             $c = $Pos[$a++] - $H;
  198.             if ($c >= 0) {
  199.                 $c = $Prm[$c];
  200.                 if ($B2H[$c]) {
  201.                     for ($c++; $B2H[$c] and !$BH[$c]; $c++) {
  202.                         $B2H[$c] = 0;
  203.                     }
  204.                 }
  205.             }
  206.         } while ( !$BH[$a] );
  207.     }
  208.  
  209.     for $a (0 .. $N-1) {
  210.         $Pos[$Prm[$a]] = $a;
  211.     }
  212.  
  213.     for $a (0 .. $N-1) {
  214.         if ($B2H[$a]) {
  215.             $B2H[$a] = 0;
  216.             if ( !$BH[$a] ) {
  217.                 $c = lcp($Pos[$a-1] + $H, $Pos[$a] + $H);
  218.                 $rank++;
  219.                 set($a, $H + $c);
  220.                 $BH[$a] = 1;
  221.             }
  222.         }
  223.     }
  224. }
  225.  
  226. show() if $N < 50;
  227. #save();
  228.  
  229. exit 0;
  230.  
  231.  
  232. ### Subrutinas
  233. # Cálculo de las coincidencias entre sufijos vecinos
  234. sub lcp {
  235.     my($a, $b) = @_;
  236.     my($min, $opt, $cp, $L, $M, $R);
  237.  
  238.     return 0 if substr($A, $a, 1) ne substr($A, $b, 1);
  239.  
  240.     $a = $Prm[$a];
  241.     $b = $Prm[$b];
  242.  
  243.     if ($a > $b) {
  244.         ($a, $b) = ($b, $a);
  245.     }
  246.  
  247.     return $Lcp[0] if $a == 0  and  $b == $N-1;
  248.  
  249.     $min = $N+1;
  250.  
  251.     if ($a > 0) {
  252.         $L   = 0;
  253.         $R   = $N-1;
  254.         $opt = $Lcp[0];
  255.  
  256.         while ($a != $R) {
  257.             $M = ($L+$R) >> 1;
  258.             if ($a <= $M) {
  259.                 if ($Lcp[$M] & BIT) {
  260.                     $cp  = $opt;
  261.                     $opt = $Lcp[$M] & MASK;
  262.                 }
  263.                 else {
  264.                     $cp  = $Lcp[$M];
  265.                 }
  266.                 if ($R <= $b and $cp < $min) {
  267.                     $min = $cp;
  268.                 }
  269.                 $R = $M;
  270.             }
  271.             else {
  272.                 if ( ! ($Lcp[$M] & BIT)) {
  273.                     $opt = $Lcp[$M];
  274.                 }
  275.                 $L = $M;
  276.             }
  277.         }
  278.     }
  279.  
  280.     if ($b < $N-1) {
  281.         $L   = 0;
  282.         $R   = $N-1;
  283.         $opt = $Lcp[0];
  284.  
  285.         while ($b != $L) {
  286.             $M = ($L+$R) >> 1;
  287.             if ($b >= $M) {
  288.                 if ($Lcp[$M] & BIT) {
  289.                     $cp = $Lcp[$M] & MASK;
  290.                 }
  291.                 else {
  292.                     $cp  = $opt;
  293.                     $opt = $Lcp[$M];
  294.                 }
  295.                 if ($a <= $L and $cp < $min) {
  296.                     $min = $cp;
  297.                 }
  298.                 $L = $M;
  299.             }
  300.             else {
  301.                 if ($Lcp[$M] & BIT) {
  302.                     $opt = $Lcp[$M] & MASK;
  303.                 }
  304.                 $R = $M;
  305.             }
  306.         }
  307.     }
  308.  
  309.     return $min;
  310. }
  311.  
  312. # Actualiza los valores del árbol de sufijos
  313. sub set {
  314.     my($a, $val) = @_;
  315.     my($L, $M, $R, $opt, $h);
  316.    
  317.     $L     = 0;
  318.     $R     = $N-1;
  319.     $h     = 0;
  320.     $opt   = $Lcp[0];
  321.    
  322.     while ($R-$L > 1) {
  323.         $M         = ($L+$R) >> 1;
  324.         $Min[$h]   = $opt;
  325.         $Mid[$h]   = $M;
  326.  
  327.         if ($a <= $M) {
  328.             $R = $M;
  329.             if ($Lcp[$M] & BIT) {
  330.                 $opt = $Lcp[$M] & MASK;
  331.             }
  332.         }
  333.         else {
  334.             $L = $M;
  335.             if ( ! ($Lcp[$M] & BIT)) {
  336.                 $opt = $Lcp[$M];
  337.             }
  338.         }
  339.  
  340.         $h++;
  341.     }
  342.    
  343.     for ($h--; $h >= 0; $h--) {
  344.         $opt = $Min[$h];
  345.         $M   = $Mid[$h];
  346.  
  347.         if ($Lcp[$M] & BIT) {
  348.             $L = $Lcp[$M] & MASK;
  349.             $R = $opt;
  350.         }
  351.         else {
  352.             $L = $opt;
  353.             $R = $Lcp[$M];
  354.         }
  355.  
  356.         if ($a <= $M) {
  357.             if ($val < $L) {
  358.                 $L = $val;
  359.             }
  360.         }
  361.         else {
  362.             if ($val < $R) {
  363.                 $R = $val;
  364.             }
  365.         }
  366.  
  367.         if ($L < $R) {
  368.             $Lcp[$M] = $R;
  369.         }
  370.         else {
  371.             $Lcp[$M] = $L | BIT;
  372.         }
  373.     }
  374.  
  375.     if ($val < $Lcp[0]) {
  376.         $Lcp[0] = $val;
  377.     }
  378. }
  379.  
  380. # Muestra el resultado en pantalla
  381. sub show {
  382.     for my $i (0 .. $N-1) {
  383.         printf "%6d: %6d %6d ", $i, $Prm[$i], $Pos[$i];
  384.        
  385.         if ($BH[$i]) {
  386.             if ($i > 0) {
  387.                 printf "[%6d]+ '", lcp($Pos[$i-1], $Pos[$i] );
  388.             }
  389.             else {
  390.                 printf "[%6d]+ '", 0;
  391.             }
  392.         }
  393.         else {
  394.             printf "%9s '", '';
  395.         }
  396.        
  397.         print substr $A, $Pos[$i], 25;
  398.         print "'\n";
  399.     }
  400.    
  401.     print "\n";
  402. }
  403.  
  404. # Guarda el resultado en disco
  405. sub save {
  406.     open my $fh, '>', 'out.pl.txt';
  407.     for my $i (0 .. $N-1) {
  408.         printf $fh "%d\t%s\n", $Pos[$i], substr $A, $Pos[$i], -1;
  409.     }
  410.     close $fh;
  411. }
  412.  
  413. __END__
Coloreado en 0.007 segundos, usando GeSHi 1.0.8.4
(Aquí también hay una subrutina que nos permite guardar a disco los sufijos ordenados, por si los necesitamos más adelante.) (No vamos a entrar en la descripción del funcionamiento del algoritmo. Consultar la publicación original de Manber y Myers.)

Vemos que los tiempos son mucho menores que con solo el mergesort de nuestra función sort(). Esa es la razón de por qué usar estos algoritmos y no confiar solo en las funciones incorporadas.

Pero, repetimos, esto es solo a título formativo. La solución que hay que poner en un entorno de producción es la de un programa compilado. Observad los tiempos que se obtienen con el algoritmo Manber/Myers escrito en C:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Long.   Tiempo
   5000 0m00.014s
  10000 0m00.029s
  20000 0m00.059s
  40000 0m00.127s
  80000 0m00.209s
 160000 0m00.501s
 320000 0m01.190s
 640000 0m02.695s
1280000 0m05.782s
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Si, aun así, nos empeñamos en querer usar Perl ;) , lo que hay que hacer es usar el módulo Inline::C, e implementar el algoritmo en C dentro del código Perl. Perl lo compilará en una biblioteca externa, y lo ejecutará a la misma velocidad que si fuera el programa compilado en puro C.

Comentar, finalmente, que desde Manber y Myers publicaron este algoritmo, se han desarrollado una veintena más, algunos de ellos hasta 30 veces más rápidos.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Publicidad

Volver a Bioinformática

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 5 invitados

cron