Searching for words in a dictionary I'm using an open source program called MElt which lemmatize (give the lemma example:giving-->give) of words. MElt works on Linux and it's programmed in Perl and Python. So far it's working good but it take way too much time to give the results. I looked into the code and located the loop responsible for this:

while (&lt;LEFFF&gt;) { 
  chomp;
  s/ /_/g;
#  s/(\S)-(\S)/\1_-_\2/g;
  /^(.*?)\t(.*?)\t(.*?)(\t|$)/ || next;
  $form = $1; $cats = $2; $lemma = $3;
  #print "$form \n";
  #print "$cats \n";
  #print "$lemma \n";
  if ($lower_case_lemmas) {
    $lemma = lc($lemma);
  }
  if ($it_mapping) {
    next if ($form =~ /^.+'$/);
    next if ($form eq "dato" &amp;&amp; $lemma eq "datare"); # bourrin
    next if ($form eq "stato" &amp;&amp; $lemma eq "stare"); # bourrin
    next if ($form eq "stata" &amp;&amp; $lemma eq "stare"); # bourrin
    next if ($form eq "parti" &amp;&amp; $lemma eq "parto"); # bourrin
    if ($cats =~ /^(parentf|parento|poncts|ponctw)$/) {$cats = "PUNCT"}
    if ($cats =~ /^(PRO)$/) {$cats = "PRON"}
    if ($cats =~ /^(ARTPRE)$/) {$cats = "PREDET"}
    if ($cats =~ /^(VER|ASP|AUX|CAU)$/) {$cats = "VERB"}
    if ($cats =~ /^(CON)$/) {$cats = "CONJ"}
    if ($cats =~ /^(PRE)$/) {$cats = "PREP"}
    if ($cats =~ /^(DET)$/) {$cats = "ADJ"}
    if ($cats =~ /^(WH)$/) {$cats = "PRON|CONJ"}
    next if ($form =~ /^(una|la|le|gli|agli|ai|al|alla|alle|col|dagli|dai|dal|dalla|dalle|degli|dei|del|della|delle|dello|nei|nel|nella|nelle|nello|sul|sulla)$/ &amp;&amp; $cats eq "ART");
    next if ($form =~ /^quest[aei]$/ &amp;&amp; $cats eq "ADJ");
    next if ($form =~ /^quest[aei]$/ &amp;&amp; $cats eq "PRON");
    next if ($form =~ /^quell[aei]$/ &amp;&amp; $cats eq "ADJ");
    next if ($form =~ /^quell[aei]$/ &amp;&amp; $cats eq "PRON");
    next if ($form =~ /^ad$/ &amp;&amp; $cats eq "PREP");
    next if ($form =~ /^[oe]d$/ &amp;&amp; $cats eq "CONJ");
  }
  $qmlemma = quotemeta ($lemma);
  for $cat (split /\|/, $cats) {
    if (defined ($cat_form2lemma{$cat}) &amp;&amp; defined ($cat_form2lemma{$cat}{$form}) &amp;&amp; $cat_form2lemma{$cat}{$form} !~ /(^|\|)$qmlemma(\||$)/) {
      $cat_form2lemma{$cat}{$form} .= "|$lemma";
    } else {
      $cat_form2lemma{$cat}{$form} = "$lemma";
      $form_lemma_suffs = "@".$form."###@".$lemma;
      while ($form_lemma_suffs =~ s/^(.)(.+)###\1(.+)/\2###\3/) {
        if (length($2) &lt;= 8) {
          $cat_formsuff_lemmasuff2count{$cat}{$2}{$3}++;
          if ($multiple_lemmas) {
            $cat_formsuff_lemmasuff2count{$cat}{$2}{__ALL__}++;
          }
        }
      }
    }
  }
}


The variable LEFFF is a dictionary composed of 490489 lines.  So, the loop is comparing the words with all the dictionary lines one by one.  This is too much. Any ideas how to optimize this?

Here's a preview of how LEFFF is structured:



touant  VPR touer   0
intimiste   NC  intimiste   1
intimiste   ADJ intimiste   0
phonologiques   ADJ phonologique    1
condescendirent V   condescendre    1
enchaussez  VIMP    enchausser  1
enchaussez  V   enchausser  0
riotiez VS  rioter  1
riotiez V   rioter  0
Eyzin-Pinet NPP Eyzin-Pinet 1
dentaires   NC  dentaire    0
dentaires   ADJ dentaire    1
classe  VIMP    classer 0
classe  VS  classer 1
Well, this is difficult, especially without being a linguist. However, the code is horrid, and I can fix that.



s/ /_/g should be tr/ /_/, as single-character transliterations are more efficient than full-fledged regex matches.



/^(.*?)\t(.*?)\t(.*?)(\t|$)/ || next;
$form = $1; $cats = $2; $lemma = $3;


should be

my ($form, $cats, $lemma) = split /\t/, $_, 4 or next;


The .*? in the regex is a big no-no. It wants to split the line into three parts at tabs – so let's use split.



Certain stuff could be written more readable:

  if ($it_mapping) {
    next if $form =~ /.'$/  # optimized from /^.+'$/
         or $form eq "dato"  &amp;&amp; $lemma eq "datare"
         or $form eq "stato" &amp;&amp; $lemma eq "stare"
         or $form eq "stata" &amp;&amp; $lemma eq "stare"
         or $form eq "parti" &amp;&amp; $lemma eq "parto"
         or $cats eq "ART" &amp;&amp; $form =~ /^(?:una|la|le|gli|agli|ai|al|alla|alle|col|dagli|dai|dal|dalla|dalle|degli|dei|del|della|delle|dello|nei|nel|nella|nelle|nello|sul|sulla)$/;

    # removing capture groups, using eq where appropriate, using postfix if:
    $cats = "PUNCT"     if $cats =~ /^(?:parentf|parento|poncts|ponctw)$/;
    $cats = "PRON"      if $cats eq 'PRO';
    $cats = "PREDET"    if $cats eq 'ARTPRE';
    $cats = "VERB"      if $cats =~ /^(?:VER|ASP|AUX|CAU)$/;
    $cats = "CONJ"      if $cats eq 'CON';
    $cats = "PREP"      if $cats eq 'PRE';
    $cats = "ADJ"       if $cats eq 'DET';
    $cats = "PRON|CONJ" if $cats eq 'WH';

    # cheaper test (equality) as early as possible
    next if $cats eq "PREP" &amp;&amp; $form eq 'ad'
         or $cats eq "ADJ"  &amp;&amp; $form =~ /^quest[aei]$/
         or $cats eq "PRON" &amp;&amp; $form =~ /^quest[aei]$/
         or $cats eq "ADJ"  &amp;&amp; $form =~ /^quell[aei]$/
         or $cats eq "PRON" &amp;&amp; $form =~ /^quell[aei]$/
         or $cats eq "CONJ" &amp;&amp; $form =~ /^[oe]d$/;
  }


Note that I did not optimize the gargantuan regex – the trie optimization will transform that into a state machine, which is far more efficient. This regex match was also moved before the $cats normalization in order to bail out as early as possible.



$qmlemma = quotemeta ($lemma);


should be 

my $qmlemma = quotemeta ($lemma);


because lexical variables can be more efficient, and it makes it easier to reason about the code.



The next part (looping through the $cats) is very hackish, and could be done more efficient with a different data structure. 

(I removed my no autovivification recommendation because that behaviour is needed in the else clause again, and it does not effectively save much).

The regex should be changed to /(?:^|[|])$qmlemma(?:[|]|$)/ to avoid unneccessary capturing (and to make it more readable).



The else-branch should be changed to

$cat_form2lemma{$cat}{$form} = $lemma; # avoid unneccessary stringification
my $form_lemma_suffs = '@' . $form . '###@' . $lemma;  # lexical variables!!!
while ($form_lemma_suffs =~ s/^(.)(.+)###\1(.+)/\2###\3/) {
  if (length($2) &lt;= 8) {
    $cat_formsuff_lemmasuff2count{$cat}{$2}{$3}++;
    $cat_formsuff_lemmasuff2count{$cat}{$2}{__ALL__}++ if $multple_lemmas;
  }
}


Most of the changes are meant to improve readability (postfix if, spacing). If I grok that code correctly, then it might be able to change this to

$cat_form2lemma{$cat}{$form} = $lemma; # avoid unneccessary stringification

my ($form_suff, $lemma_suff) = ($form, $lemma);
while (length($form_suff) and substr($form_suff, 0, 1, '') eq substr($lemma_suff, 0, 1, '')) {
  if (length($form_suff) &lt;= 8) {
    $cat_formsuff_lemmasuff2count{$cat}{$form_suff}{$lemma_suff}++;
    $cat_formsuff_lemmasuff2count{$cat}{$form_suff}{__ALL__}++ if $multiple_lemmas;
  }
}


C-style string manipulation with substr is far more efficient than regexes with captures and backrefs.