9
votes

Le moyen le plus rapide de trouver des positions d'inadéquation entre deux cordes de la même longueur

J'ai des millions de paires de ficelle de même longueur que je veux comparer et trouver la position où il a des incompatibles.

Par exemple pour chaque $ STR1 et $ str2 Nous voulons trouver une incompatibilité Position avec $ str_source : xxx

y a-t-il un moyen rapide de le faire. Actuellement j'ai la méthode de style C que je boucle chaque position dans les deux chaînes utilisant la fonction 'substran'. Mais cette approche est horriblement lente. xxx


2 commentaires

Enregistrement de la position des différences tout ce que vous voulez faire?


@Kinopiko: Ils ressemblent à des gènes, ils pourraient donc être énormes (!!).


9 Réponses :


4
votes

On dirait que cela pourrait être une partie critique de performance de votre application. Dans ce cas, vous voudrez peut-être envisager d'écrire une méthode de poste C pour faire la comparaison.

Perl fournit le XS Mécanisme d'extension qui rend cela raisonnablement simple.


1 commentaires

En ligne est plus facile à utiliser pour de petites choses comme celle-ci.



3
votes

Vous faites 2 appels vers le substrateur pour chaque comparaison de caractères qui est probablement ce qui vous ralentit.

Quelques optimisations Je ferais P>

@source = split //,$str_source  #split first rather than substr
@base = split //, $str_base

for $i (0 .. length($str_source)) {
   $mism_pos{$1} = 1 if ($source[$i] ne $base); #hashing is faster than array push
}

return keys $mism_pos


2 commentaires

Bien que vous soyez correct sur l'appel supplémentaire au substrateur, vous auriez besoin de profiler pour prouver qu'il est plus rapide.


Je soupçonne que ce sera un peu plus lent. Bien que cela ressemble à un appel de fonction «lourd», Substr () est très rapide - en interne, il s'agit d'une recherche de tableau. Les matrices de bâtiments OTOH de chaînes d'un caractère nécessitent une allocation de mémoire et une distribution de la mémoire, et les frais de vue de la mémoire sont significatifs. Mais comme le dit Kinopiko, profilez-le;)



1
votes

J'allais dire, "écrivez-le en C" aussi.

Une fois là-bas, vous pouvez utiliser une optimisation comme comparer 4 caractères à la fois (sous forme d'entiers 32 bits).

ou changer votre représentation (4 lettres, droite?) Pour utiliser 2 bits pour représenter une base (?), afin que vous puissiez comparer 16 caractères à la fois.


0 commentaires

3
votes

Le moyen le plus rapide de comparer les chaînes pour trouver des différences serait de xor chaque octet d'entre eux ensemble, alors test pour zéro . Si je devais faire cela, je voudrais simplement écrire un programme en C pour faire le travail de différence plutôt que de rédiger une extension C à Perl, alors je dirais mon programme C comme sous-processus de Perl. L'algorithme exact dépendrait de la longueur des chaînes et de la quantité de données. Cependant, cela ne prendrait pas plus de 100 lignes de C. En fait, si vous souhaitez optimiser la vitesse, un programme d'octets Xor de chaînes et de tests de longueur fixe pour zéro pourrait être écrit dans la langue d'assemblage.


5 commentaires

Si vous allez aller tout le chemin, assurez-vous de comparer des mots 32 bits ou 64 bits au lieu de juste des octets. :)


J'ai demandé la longueur des cordes mais je n'ai pas encore de réponse.


Voulez-vous dire en utilisant un piratage binaire intelligent pour tester n'importe quel octet dans un mot pour zéro dans un seul op? Si oui, veuillez expliquer le truc un peu. Sinon, je suis darésay Xoring Bytes, puis vérifiant les octets de zéro n'est pas plus rapide que de comparer les octets directement ... :)


En supposant que l'alphabet est de quatre lettres, une chaîne de huit lettres conviendrait dans un mot de 32 bits. Réduisez chaque chaîne à un mot, XOR, puis si ce XOR n'est pas nul, et le résultat avec huit masques de bits pour trouver lesquels ont changé. Cela pourrait être appliqué à des séquences plus longues aussi. "Comparer les octets" signifie les soustrayer, auquel cas cela ne fonctionnerait pas en raison de débordements.


Gotcha, Nice, +1. J'étais confus, pensant que nous recherchions n'importe quel octet zéro plutôt que n'importe quel octet non nul . (BTW Décérent la méthode 4 à STDLIB.NET/~COLMMACC/ 2009/03/01 / Optimisation-Strlen pour une solution nette de gérer que problème.)



5
votes

Ceux-ci ressemblent à des séquences de gènes. Si les chaînes sont toutes des 8 caractères et que le domaine des codes possibles est (A, C, G, T), vous pourriez envisager de transformer les données en quelque sorte avant de le traiter. Cela ne vous donnerait que 65536 chaînes possibles, vous pouvez donc spécialiser votre mise en œuvre.

Par exemple, vous écrivez une méthode qui prend une chaîne de 8 caractères et la mappe sur un entier. Memoize que pour que l'opération soit rapide. Ensuite, écrivez une fonction de comparaison, qui compte deux entiers, vous indique comment ils diffèrent. Vous l'appeleriez dans une construction de bouclage appropriée avec un test d'égalité numérique comme sauf si ($ a! = $ B) avant d'appeler la comparaison - un court-circuit pour des codes identiques si vous voulez.


1 commentaires

+1, mais sur la réflexion de la quantité de travail que vous devez faire pour construire la mémoire "clé" probablement des nains le coût de calcul! Vous auriez besoin de faire une recherche de hachage droite d'une chaîne (quelle-interne Perl fera-t-elle sûrement en boucle sur ses caractères), ou calculez une clé entière en bouché de chaque nucléotide dans 2 bits à une heure - c'est-à-dire résoudre le problème. Pour obtenir la clé, vous devez résoudre le problème! :)



18
votes

Inline :: C


Le calcul est facile, le faire avec Inline :: C (Lire Perldoc Inline :: C-Cookbook et PERLDOC INLINE :: C pour la documentation): P>

use PDL; 
use PDL::Char;                                                                  
$PDL::SHARE=$PDL::SHARE; # keep stray warning quiet 

my $source=PDL::Char->new("ATTCCGGG");                                          
for my $str ( "ATTGCGGG", "ATACCGGC") {                                         
  my $match =PDL::Char->new($str);                                              
  my @diff=which($match!=$source)->list;                                        
  print "@diff\n";                                                              
}


0 commentaires

4
votes

Voici un script d'analyse comparative pour déterminer si les différences de vitesse de diverses approches. Gardez simplement à l'esprit qu'il y aura un retard la première fois qu'un script utilise Inline :: C < / a> est appelé car le compilateur C est invoqué, etc. Alors, exécutez le script une fois, puis de référence. xxx

résultats (à l'aide de VC ++ 9 sur Windows XP avec AS PERL 5.10.1) Avec $ copies = 1 : xxx

résultats avec $ copies = 100 : xxx


0 commentaires

2
votes

Certaines chaînes classiques Comparez les optimisations:

Mismatch optimal - Commencez à comparer à la fin de la chaîne de recherche. par exemple. Recherchez ABC à Abdabeaubf Si vous vous comparez au début, vous vous déplacerez le long du modèle une char à la fois. Si vous recherchez à partir de la fin, vous pourrez sauter le long de trois caractères

Heuristic de mauvais caractère - Sélectionnez le char et la recherche le moins souvent survenant sur ce premier. par exemple. En anglais, un caractère 'z' est de rares et de bonnes fonctions de recherche de chaînes prendront une recherche sur «labyrinthe» et commencez à comparer sur le 3ème Char


0 commentaires

2
votes

Je ne sais pas à quel point il est efficace, mais vous pouvez toujours Xor les deux chaînes que vous correspondez et trouvez l'index de la première inadéquation.

main::diff_index:
# 15:   my($a,$b) = @_;
1  <;> nextstate(main 53 test.pl:15) # v:%,*,&,$
2  <0> pushmark # s
3  <$> gv(*_) # s
4  <1> rv2av[t3] # lK/3
5  <0> pushmark # sRM*/128
6  <0> padsv[$a:53,58] # lRM*/LVINTRO
7  <0> padsv[$b:53,58] # lRM*/LVINTRO
8  <2> aassign[t4] # vKS
# 16:   my $cmp = $a^$b;
9  <;> nextstate(main 54 test.pl:16) # v:%,*,&,$
a  <0> padsv[$a:53,58] # s
b  <0> padsv[$b:53,58] # s
c  <2> bit_xor[t6] # sK                     <-----  Single OP -----
d  <0> padsv[$cmp:54,58] # sRM*/LVINTRO
e  <2> sassign # vKS/2
# 18:   my @cmp;
f  <;> nextstate(main 55 test.pl:18) # v:%,*,&,{,$
g  <0> padav[@cmp:55,58] # vM/LVINTRO
# 20:   while( $cmp =~ /[^\0]/g ){ # match non-zero byte
h  <;> nextstate(main 57 test.pl:20) # v:%,*,&,{,$
i  <{> enterloop(next->r last->v redo->j) # v
s  <0> padsv[$cmp:54,58] # s
t  </> match(/"[^\\0]"/) # sKS/RTIME        <-----  Single OP -----
u  <|> and(other->j) # vK/1
# 21:     push @cmp, pos($cmp) - 1;
j      <;> nextstate(main 56 test.pl:21) # v:%,*,&,$
k      <0> pushmark # s
l      <0> padav[@cmp:55,58] # lRM
m      <0> padsv[$cmp:54,58] # sRM
n      <1> pos[t8] # sK/1
o      <$> const(IV 1) # s
p      <2> subtract[t9] # sK/2
q      <@> push[t10] # vK/2
r      <0> unstack # v
           goto # s
v  <2> leaveloop # vK/2
# 24:   return @cmp;
w  <;> nextstate(main 58 test.pl:24) # v:%,*,&,{,$
x  <0> pushmark # s
y  <0> padav[@cmp:55,58] 
z  <@> return # K
10 <1> leavesub[1 ref] # K/REFC,1


0 commentaires