home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Approx.pm < prev    next >
Encoding:
Perl POD Document  |  2003-11-29  |  23.7 KB  |  884 lines

  1. package String::Approx;
  2.  
  3. $VERSION = '3.23';
  4.  
  5. use strict;
  6. local $^W = 1;
  7.  
  8. use Carp;
  9. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  10.  
  11. require Exporter;
  12. require DynaLoader;
  13.  
  14. @ISA = qw(Exporter DynaLoader);
  15.  
  16. @EXPORT_OK = qw(amatch asubstitute aindex aslice arindex
  17.         adist adistr adistword adistrword);
  18.  
  19. bootstrap String::Approx $VERSION;
  20.  
  21. my $CACHE_MAX = 1000;    # high water mark
  22. my $CACHE_PURGE = 0.75;    # purge this much of the least used
  23. my $CACHE_N_PURGE;    # purge this many of the least used
  24.  
  25. sub cache_n_purge () {
  26.     $CACHE_N_PURGE = $CACHE_MAX * $CACHE_PURGE;
  27.     $CACHE_N_PURGE = 1 if $CACHE_N_PURGE < 1;
  28.     return $CACHE_N_PURGE;
  29. }
  30.  
  31. cache_n_purge();
  32.  
  33. sub cache_max (;$) {
  34.     if (@_ == 0) {
  35.     return $CACHE_MAX;
  36.     } else {
  37.     $CACHE_MAX = shift;
  38.     }
  39.     $CACHE_MAX = 0 if $CACHE_MAX < 0;
  40.     cache_n_purge();
  41. }
  42.  
  43. sub cache_purge (;$) {
  44.     if (@_ == 0) {
  45.     return $CACHE_PURGE;
  46.     } else {
  47.     $CACHE_PURGE = shift;
  48.     }
  49.     if ($CACHE_PURGE < 0) {
  50.     $CACHE_PURGE = 0;
  51.     } elsif ($CACHE_PURGE > 1) {
  52.     $CACHE_PURGE = 1;
  53.     }
  54.     cache_n_purge();
  55. }
  56.  
  57. my %_simple;
  58. my %_simple_usage_count;
  59.  
  60. sub _cf_simple {
  61.     my $P = shift;
  62.  
  63.     my @usage =
  64.     sort { $_simple_usage_count{$a} <=> $_simple_usage_count{$b} }
  65.              grep { $_ ne $P }
  66.                   keys %_simple_usage_count;
  67.         
  68.     # Make room, delete the least used entries.
  69.     $#usage = $CACHE_N_PURGE - 1;
  70.         
  71.     delete @_simple_usage_count{@usage};
  72.     delete @_simple{@usage};
  73. }
  74.  
  75. sub _simple {
  76.     my $P = shift;
  77.  
  78.     my $_simple = new(__PACKAGE__, $P);
  79.  
  80.     if ($CACHE_MAX) {
  81.     $_simple{$P} = $_simple unless exists $_simple{$P};
  82.  
  83.     $_simple_usage_count{$P}++;
  84.  
  85.     if (keys %_simple_usage_count > $CACHE_MAX) {
  86.         _cf_simple($P);
  87.     }
  88.     }
  89.  
  90.     return ( $_simple );
  91. }
  92.  
  93. sub _parse_param {
  94.     use integer;
  95.  
  96.     my ($n, @param) = @_;
  97.     my %param;
  98.  
  99.     foreach (@param) {
  100.         while ($_ ne '') {
  101.         s/^\s+//;
  102.             if (s/^([IDS]\s*)?(\d+)(\s*%)?//) {
  103.                 my $k = defined $3 ? (($2-1) * $n) / 100 + ($2 ? 1 : 0) : $2;
  104.  
  105.         if (defined $1) {
  106.             $param{$1} = $k;
  107.         } else {
  108.             $param{k}  = $k;
  109.         }
  110.         } elsif (s/^initial_position\W+(\d+)\b//) {
  111.         $param{'initial_position'} = $1;
  112.         } elsif (s/^final_position\W+(\d+)\b//) {
  113.         $param{'final_position'} = $1;
  114.         } elsif (s/^position_range\W+(\d+)\b//) {
  115.         $param{'position_range'} = $1;
  116.         } elsif (s/^minimal_distance\b//) {
  117.         $param{'minimal_distance'} = 1;
  118.             } elsif (s/^i//) {
  119.                 $param{ i } = 1;
  120.             } elsif (s/^g//) {
  121.                 $param{ g } = 1;
  122.             } elsif (s/^\?//) {
  123.                 $param{'?'} = 1;
  124.             } else {
  125.                 die "unknown parameter: '$_'\n";
  126.             }
  127.         }
  128.     }
  129.  
  130.     return %param;
  131. }
  132.  
  133. my %_param_key;
  134. my %_parsed_param;
  135.  
  136. my %_complex;
  137. my %_complex_usage_count;
  138.  
  139. sub _cf_complex {
  140.     my $P = shift;
  141.  
  142.     my @usage =
  143.     sort { $_complex_usage_count{$a} <=>
  144.            $_complex_usage_count{$b} }
  145.              grep { $_ ne $P }
  146.                   keys %_complex_usage_count;
  147.         
  148.     # Make room, delete the least used entries.
  149.     $#usage = $CACHE_N_PURGE - 1;
  150.         
  151.     delete @_complex_usage_count{@usage};
  152.     delete @_complex{@usage};
  153. }
  154.  
  155. sub _complex {
  156.     my ($P, @param) = @_;
  157.     unshift @param, length $P;
  158.     my $param = "@param";
  159.     my $_param_key;
  160.     my %param;
  161.     my $complex;
  162.     my $is_new;
  163.  
  164.     unless (exists $_param_key{$param}) {
  165.     %param = _parse_param(@param);
  166.     $_parsed_param{$param} = { %param };
  167.     $_param_key{$param} = join(" ", %param);
  168.     } else {
  169.     %param = %{ $_parsed_param{$param} };
  170.     }
  171.  
  172.     $_param_key = $_param_key{$param};
  173.  
  174.     if ($CACHE_MAX) {
  175.     if (exists $_complex{$P}->{$_param_key}) {
  176.         $complex = $_complex{$P}->{$_param_key};
  177.     }
  178.     }
  179.  
  180.     unless (defined $complex) {
  181.     if (exists $param{'k'}) {
  182.         $complex = new(__PACKAGE__, $P, $param{k});
  183.     } else {
  184.         $complex = new(__PACKAGE__, $P);
  185.     }
  186.     $_complex{$P}->{$_param_key} = $complex if $CACHE_MAX;
  187.     $is_new = 1;
  188.     }
  189.  
  190.     if ($is_new) {
  191.     $complex->set_greedy unless exists $param{'?'};
  192.  
  193.     $complex->set_insertions($param{'I'})
  194.         if exists $param{'I'};
  195.     $complex->set_deletions($param{'D'})
  196.         if exists $param{'D'};
  197.     $complex->set_substitutions($param{'S'})
  198.         if exists $param{'S'};
  199.     
  200.     $complex->set_caseignore_slice
  201.         if exists $param{'i'};
  202.  
  203.     $complex->set_text_initial_position($param{'initial_position'})
  204.         if exists $param{'initial_position'};
  205.  
  206.     $complex->set_text_final_position($param{'final_position'})
  207.         if exists $param{'final_position'};
  208.  
  209.     $complex->set_text_position_range($param{'position_range'})
  210.         if exists $param{'position_range'};
  211.  
  212.     $complex->set_minimal_distance($param{'minimal_distance'})
  213.         if exists $param{'minimal_distance'};
  214.     }
  215.  
  216.     if ($CACHE_MAX) {
  217.     $_complex_usage_count{$P}->{$_param_key}++;
  218.  
  219.     # If our cache overfloweth.
  220.     if (scalar keys %_complex_usage_count > $CACHE_MAX) {
  221.         _cf_complex($P);
  222.     }
  223.     }
  224.  
  225.     return ( $complex, %param );
  226. }
  227.  
  228. sub cache_disable {
  229.     cache_max(0);
  230. }
  231.  
  232. sub cache_flush_all {
  233.     my $old_purge = cache_purge();
  234.     cache_purge(1);
  235.     _cf_simple('');
  236.     _cf_complex('');
  237.     cache_purge($old_purge);
  238. }
  239.  
  240. sub amatch {
  241.     my $P = shift;
  242.     return 1 unless length $P; 
  243.     my $a = ((@_ && ref $_[0] eq 'ARRAY') ?
  244.          _complex($P, @{ shift(@_) }) : _simple($P))[0];
  245.  
  246.     if (@_) {
  247.         if (wantarray) {
  248.             return grep { $a->match($_) } @_;
  249.         } else {
  250.             foreach (@_) {
  251.                 return 1 if $a->match($_);
  252.             }
  253.              return 0;
  254.         }
  255.     } 
  256.     if (defined $_) {
  257.         if (wantarray) {
  258.             return $a->match($_) ? $_ : undef;
  259.         } else {
  260.         return 1 if $a->match($_);
  261.         }
  262.     } 
  263.     return $a->match($_) if defined $_;
  264.     die "amatch: \$_ is undefined: what are you matching?\n";
  265. }
  266.  
  267. sub _find_substitute {
  268.     my ($ri, $rs, $i, $s, $S, $rn) = @_;
  269.  
  270.     push @{ $ri }, $i;
  271.     push @{ $rs }, $s;
  272.  
  273.     my $pre = substr($_, 0, $i);
  274.     my $old = substr($_, $i, $s);
  275.     my $suf = substr($_, $i + $s);
  276.     my $new = $S;
  277.  
  278.     $new =~ s/\$\`/$pre/g;
  279.     $new =~ s/\$\&/$old/g;
  280.     $new =~ s/\$\'/$suf/g;
  281.  
  282.     push @{ $rn }, $new;
  283. }
  284.  
  285. sub _do_substitute {
  286.     my ($rn, $ri, $rs, $rS) = @_;
  287.  
  288.     my $d = 0;
  289.     my $n = $_;
  290.  
  291.     foreach my $i (0..$#$rn) {
  292.     substr($n, $ri->[$i] + $d, $rs->[$i]) = $rn->[$i];
  293.     $d += length($rn->[$i]) - $rs->[$i];
  294.     }
  295.  
  296.     push @{ $rS }, $n;
  297. }
  298.  
  299. sub asubstitute {
  300.     my $P = shift;
  301.     my $S = shift;
  302.     my ($a, %p) =
  303.     (@_ && ref $_[0] eq 'ARRAY') ?
  304.         _complex($P, @{ shift(@_) }) : _simple($P);
  305.  
  306.     my ($i, $s, @i, @s, @n, @S);
  307.  
  308.     if (@_) {
  309.     if (exists $p{ g }) {
  310.         foreach (@_) {
  311.         @s = @i = @n = ();
  312.         while (($i, $s) = $a->slice_next($_)) {
  313.             if (defined $i) {
  314.             _find_substitute(\@i, \@s, $i, $s, $S, \@n);
  315.             }
  316.         }
  317.         _do_substitute(\@n, \@i, \@s, \@S) if @n;
  318.         }
  319.     } else {
  320.         foreach (@_) {
  321.         @s = @i = @n = ();
  322.         ($i, $s) = $a->slice($_);
  323.         if (defined $i) {
  324.             _find_substitute(\@i, \@s, $i, $s, $S, \@n);
  325.             _do_substitute(\@n, \@i, \@s, \@S);
  326.         }
  327.         }
  328.     }
  329.     return @S;
  330.     } elsif (defined $_) {
  331.     if (exists $p{ g }) {
  332.         while (($i, $s) = $a->slice_next($_)) {
  333.         if (defined $i) {
  334.             _find_substitute(\@i, \@s, $i, $s, $S, \@n);
  335.         }
  336.         }
  337.         _do_substitute(\@n, \@i, \@s, \@S) if @n;
  338.     } else {
  339.         ($i, $s) = $a->slice($_);
  340.         if (defined $i) {
  341.         _find_substitute(\@i, \@s, $i, $s, $S, \@n);
  342.         _do_substitute(\@n, \@i, \@s, \@S);
  343.         }
  344.     }
  345.     return $_ = $n[0];
  346.     } else {
  347.     die "asubstitute: \$_ is undefined: what are you substituting?\n";
  348.     }
  349. }
  350.  
  351. sub aindex {
  352.     my $P = shift;
  353.     return 0 unless length $P; 
  354.     my $a = ((@_ && ref $_[0] eq 'ARRAY') ?
  355.          _complex($P, @{ shift(@_) }) : _simple($P))[0];
  356.  
  357.     $a->set_greedy; # The *first* match, thank you.
  358.  
  359.     if (@_) {
  360.     if (wantarray) {
  361.         return map { $a->index($_) } @_;
  362.     } else {
  363.         return $a->index($_[0]);
  364.     }
  365.     }
  366.     return $a->index($_) if defined $_;
  367.     die "aindex: \$_ is undefined: what are you indexing?\n";
  368. }
  369.  
  370. sub aslice {
  371.     my $P = shift;
  372.     return (0, 0) unless length $P; 
  373.     my $a = ((@_ && ref $_[0] eq 'ARRAY') ?
  374.          _complex($P, @{ shift(@_) }) : _simple($P))[0];
  375.  
  376.     $a->set_greedy; # The *first* match, thank you.
  377.  
  378.     if (@_) {
  379.     return map { [ $a->slice($_) ] } @_;
  380.     }
  381.     return $a->slice($_) if defined $_;
  382.     die "aslice: \$_ is undefined: what are you slicing?\n";
  383. }
  384.  
  385. sub _adist {
  386.     my $s0 = shift;
  387.     my $s1 = shift;
  388.     my ($aslice) = aslice($s0, ['minimal_distance', @_], $s1);
  389.     my ($index, $size, $distance) = @$aslice;
  390.     my ($l0, $l1) = map { length } ($s0, $s1);
  391.     return $l0 <= $l1 ? $distance : -$distance;
  392. }
  393.  
  394. sub adist {
  395.     my $a0 = shift;
  396.     my $a1 = shift;
  397.     my @m = ref $_[0] eq 'ARRAY' ? @{shift()} : ();
  398.     if (ref $a0 eq 'ARRAY') {
  399.     if (ref $a1 eq 'ARRAY') {
  400.         return [ map {  adist($a0, $_, @m) } @{$a1} ];
  401.     } else {
  402.         return [ map { _adist($_, $a1, @m) } @{$a0} ];
  403.     }
  404.     } elsif (ref $a1 eq 'ARRAY') {
  405.     return     [ map { _adist($a0, $_, @m) } @{$a1} ];
  406.     } else {
  407.     if (wantarray) {
  408.         return map { _adist($a0, $_, @m) } ($a1, @_);
  409.     } else {
  410.         return _adist($a0, $a1, @m);
  411.     }
  412.     }
  413. }
  414.  
  415. sub adistr {
  416.     my $a0 = shift;
  417.     my $a1 = shift;
  418.     my @m = ref $_[0] eq 'ARRAY' ? shift : ();
  419.     if (ref $a0 eq 'ARRAY') {
  420.     if (ref $a1 eq 'ARRAY') {
  421.         my $l0 = length();
  422.         return $l0 ? [ map { adist($a0, $_, @m) }
  423.               @{$a1} ] :
  424.                  [ ];
  425.     } else {
  426.         return [ map { my $l0 = length();
  427.                $l0 ? _adist($_, $a1, @m) / $l0 : undef
  428.              } @{$a0} ];
  429.     }
  430.     } elsif (ref $a1 eq 'ARRAY') {
  431.     my $l0 = length($a0);
  432.     return [] unless $l0;
  433.     return     [ map { _adist($a0, $_, @m) / $l0 } @{$a1} ];
  434.     } else {
  435.     my $l0 = length($a0);
  436.     if (wantarray) {
  437.         return map { $l0 ? _adist($a0, $_, @m) / $l0 : undef } ($a1, @_);
  438.     } else {
  439.         return undef unless $l0;
  440.         return _adist($a0, $a1, @m) / $l0;
  441.     }
  442.     }
  443. }
  444.  
  445. sub adistword {
  446.     return adist($_[0], $_[1], ['position_range=0']);
  447. }
  448.  
  449. sub adistrword {
  450.     return adistr($_[0], $_[1], ['position_range=0']);
  451. }
  452.  
  453. sub arindex {
  454.     my $P = shift;
  455.     my $l = length $P;
  456.     return 0 unless $l;
  457.     my $R = reverse $P;
  458.     my $a = ((@_ && ref $_[0] eq 'ARRAY') ?
  459.          _complex($R, @{ shift(@_) }) : _simple($R))[0];
  460.  
  461.     $a->set_greedy; # The *first* match, thank you.
  462.  
  463.     if (@_) {
  464.     if (wantarray) {
  465.         return map {
  466.         my $aindex = $a->index(scalar reverse());
  467.         $aindex == -1 ? $aindex : (length($_) - $aindex - $l);
  468.         } @_;
  469.     } else {
  470.         my $aindex = $a->index(scalar reverse $_[0]);
  471.         return $aindex == -1 ? $aindex : (length($_[0]) - $aindex - $l);
  472.     }
  473.     }
  474.     if (defined $_) {
  475.     my $aindex = $a->index(scalar reverse());
  476.     return $aindex == -1 ? $aindex : (length($_) - $aindex - $l);
  477.     }
  478.     die "arindex: \$_ is undefined: what are you indexing?\n";
  479. }
  480.  
  481. 1;
  482. __END__
  483.  
  484. =head1 NAME
  485.  
  486. String::Approx - Perl extension for approximate matching (fuzzy matching)
  487.  
  488. =head1 SYNOPSIS
  489.  
  490.   use String::Approx 'amatch';
  491.  
  492.   print if amatch("foobar");
  493.  
  494.   my @matches = amatch("xyzzy", @inputs);
  495.  
  496.   my @catches = amatch("plugh", ['2'], @inputs);
  497.  
  498. =head1 DESCRIPTION
  499.  
  500. String::Approx lets you match and substitute strings approximately.
  501. With this you can emulate errors: typing errorrs, speling errors,
  502. closely related vocabularies (colour color), genetic mutations (GAG
  503. ACT), abbreviations (McScot, MacScot).
  504.  
  505. NOTE: String::Approx has been designed to work with B<strings>, not
  506. with B<text>.  In other words, when you want to compare things like
  507. text or source code, consisting of B<words> or B<tokens> and
  508. B<phrases> and B<sentences>, or B<expressions> and B<statements>,
  509. you should probably use some other tool than String::Approx, like for
  510. example the standard UNIX diff(1) tool, or the Algorithm::Diff module
  511. from CPAN, or if you just want the Levenshtein edit distance
  512. (explained below), the Text::Levenshtein module from CPAN.  See also
  513. Text::WagnerFischer and Text::PhraseDistance.
  514.  
  515. The measure of B<approximateness> is the I<Levenshtein edit distance>.
  516. It is the total number of "edits": insertions,
  517.  
  518.     word world
  519.  
  520. deletions,
  521.  
  522.     monkey money
  523.  
  524. and substitutions
  525.  
  526.     sun fun
  527.  
  528. required to transform a string to another string.  For example, to
  529. transform I<"lead"> into I<"gold">, you need three edits:
  530.  
  531.     lead gead goad gold
  532.  
  533. The edit distance of "lead" and "gold" is therefore three, or 75%.
  534.  
  535. =head1 MATCH
  536.  
  537.     use String::Approx 'amatch';
  538.  
  539.     $matched     = amatch("pattern") 
  540.     $matched     = amatch("pattern", [ modifiers ])
  541.  
  542.     $any_matched = amatch("pattern", @inputs) 
  543.     $any_matched = amatch("pattern", [ modifiers ], @inputs)
  544.  
  545.     @match       = amatch("pattern") 
  546.     @match       = amatch("pattern", [ modifiers ])
  547.  
  548.     @matches     = amatch("pattern", @inputs) 
  549.     @matches     = amatch("pattern", [ modifiers ], @inputs)
  550.  
  551. Match B<pattern> approximately.  In list context return the matched
  552. B<@inputs>.  If no inputs are given, match against the B<$_>.  In scalar
  553. context return true if I<any> of the inputs match, false if none match.
  554.  
  555. Notice that the pattern is a string.  Not a regular expression.  None
  556. of the regular expression notations (^, ., *, and so on) work.  They
  557. are characters just like the others.  Note-on-note: some limited form
  558. of I<"regular expressionism"> is planned in future: for example
  559. character classes ([abc]) and I<any-chars> (.).  But that feature will
  560. be turned on by a special I<modifier> (just a guess: "r"), so there
  561. should be no backward compatibility problem.
  562.  
  563. Notice also that matching is not symmetric.  The inputs are matched
  564. against the pattern, not the other way round.  In other words: the
  565. pattern can be a substring, a submatch, of an input element.  An input
  566. element is always a superstring of the pattern.
  567.  
  568. =head2 MODIFIERS
  569.  
  570. With the modifiers you can control the amount of approximateness and
  571. certain other control variables.  The modifiers are one or more
  572. strings, for example C<"i">, within a string optionally separated by
  573. whitespace.  The modifiers are inside an anonymous array: the C<[ ]>
  574. in the syntax are not notational, they really do mean C<[ ]>, for
  575. example C<[ "i", "2" ]>.  C<["2 i"]> would be identical.
  576.  
  577. The implicit default approximateness is 10%, rounded up.  In other
  578. words: every tenth character in the pattern may be an error, an edit.
  579. You can explicitly set the maximum approximateness by supplying a
  580. modifier like
  581.  
  582.     number
  583.     number%
  584.  
  585. Examples: C<"3">, C<"15%">.
  586.  
  587. Note that C<0%> is not rounded up, it is equal to C<0>.
  588.  
  589. Using a similar syntax you can separately control the maximum number
  590. of insertions, deletions, and substitutions by prefixing the numbers
  591. with I, D, or S, like this:
  592.  
  593.     Inumber
  594.     Inumber%
  595.     Dnumber
  596.     Dnumber%
  597.     Snumber
  598.     Snumber%
  599.  
  600. Examples: C<"I2">, C<"D20%">, C<"S0">.
  601.  
  602. You can ignore case (C<"A"> becames equal to C<"a"> and vice versa)
  603. by adding the C<"i"> modifier.
  604.  
  605. For example
  606.  
  607.     [ "i 25%", "S0" ]
  608.  
  609. means I<ignore case>, I<allow every fourth character to be "an edit">,
  610. but allow I<no substitutions>.  (See L<NOTES> about disallowing
  611. substitutions or insertions.)
  612.  
  613. =head1 SUBSTITUTE
  614.  
  615.     use String::Approx 'asubstitute';
  616.  
  617.     @substituted = asubstitute("pattern", "replacement")
  618.     @substituted = asubstitute("pattern", "replacement", @inputs) 
  619.     @substituted = asubstitute("pattern", "replacement", [ modifiers ])
  620.     @substituted = asubstitute("pattern", "replacement",
  621.                    [ modifiers ], @inputs)
  622.  
  623. Substitute approximate B<pattern> with B<replacement> and return as a
  624. list <copies> of B<@inputs>, the substitutions having been made on the
  625. elements that did match the pattern.  If no inputs are given,
  626. substitute in the B<$_>.  The replacement can contain magic strings
  627. B<$&>, B<$`>, B<$'> that stand for the matched string, the string
  628. before it, and the string after it, respectively.  All the other
  629. arguments are as in C<amatch()>, plus one additional modifier, C<"g">
  630. which means substitute globally (all the matches in an element and not
  631. just the first one, as is the default).
  632.  
  633. See L<BAD NEWS> about the unfortunate stinginess of C<asubstitute()>.
  634.  
  635. =head1 INDEX
  636.  
  637.     use String::Approx 'aindex';
  638.  
  639.     $index   = aindex("pattern")
  640.     @indices = aindex("pattern", @inputs)
  641.     $index   = aindex("pattern", [ modifiers ])
  642.     @indices = aindex("pattern", [ modifiers ], @inputs)
  643.  
  644. Like C<amatch()> but returns the index/indices at which the pattern
  645. matches approximately.  In list context and if C<@inputs> are used,
  646. returns a list of indices, one index for each input element.
  647. If there's no approximate match, C<-1> is returned as the index.
  648.  
  649. There's also backwards-scanning C<arindex()>.
  650.  
  651. =head1 SLICE
  652.  
  653.     use String::Approx 'aindex';
  654.  
  655.     ($index, $size)   = aslice("pattern")
  656.     ([$i0, $s0], ...) = aslice("pattern", @inputs)
  657.     ($index, $size)   = aslice("pattern", [ modifiers ])
  658.     ([$i0, $s0], ...) = aslice("pattern", [ modifiers ], @inputs)
  659.  
  660. Like C<aindex()> but returns also the size (length) of the match.
  661. If the match fails, returns an empty list (when matching against C<$_>)
  662. or an empty anonymous list corresponding to the particular input.
  663.  
  664. Note that the size of the match will very probably be something you
  665. did not expect (such as longer than the pattern, or a negative
  666. number).  This may or may not be fixed in future releases.
  667.  
  668. If the modifier
  669.  
  670.     "minimal_distance"
  671.  
  672. is used, the minimal possible edit distance is returned as the
  673. third element:
  674.  
  675.     ($index, $size, $distance) = aslice("pattern", [ modifiers ])
  676.     ([$i0, $s0, $d0], ...)     = aslice("pattern", [ modifiers ], @inputs)
  677.  
  678. =head1 DISTANCE
  679.  
  680.     use String::Approx 'adist';
  681.  
  682.     $dist = adist("pattern", $input);
  683.     @dist = adist("pattern", @input);
  684.  
  685. Return the I<edit distance> or distances between the pattern and the
  686. input or inputs.  Zero edit distance means exact match.  (Remember
  687. that the match can 'float' in the inputs, the match is a substring
  688. match.)  If the pattern is longer than the input or inputs, the
  689. returned distance or distances is or are negative.
  690.  
  691.     use String::Approx 'adistr';
  692.  
  693.     $dist = adistr("pattern", $input);
  694.     @dist = adistr("pattern", @inputs);
  695.  
  696. Return the B<relative> I<edit distance> or distances between the
  697. pattern and the input or inputs.  Zero relative edit distance means
  698. exact match, one means completely different.  (Remember that the
  699. match can 'float' in the inputs, the match is a substring match.)  If
  700. the pattern is longer than the input or inputs, the returned distance
  701. or distances is or are negative.
  702.  
  703. You can use adist() or adistr() to sort the inputs according to their
  704. approximateness:
  705.  
  706.     my %d;
  707.     @d{@inputs} = map { abs } adistr("pattern", @inputs);
  708.     my @d = sort { $d{$a} <=> $d{$b} } @inputs;
  709.  
  710. Now C<@d> contains the inputs, the most like C<"pattern"> first.
  711.  
  712. =head1 CONTROLLING THE CACHE
  713.  
  714. C<String::Approx> maintains a LU (least-used) cache that holds the
  715. 'matching engines' for each instance of a I<pattern+modifiers>.  The
  716. cache is intended to help the case where you match a small set of
  717. patterns against a large set of string.  However, the more engines you
  718. cache the more you eat memory.  If you have a lot of different
  719. patterns or if you have a lot of memory to burn, you may want to
  720. control the cache yourself.  For example, allowing a larger cache
  721. consumes more memory but probably runs a little bit faster since the
  722. cache fills (and needs flushing) less often.
  723.  
  724. The cache has two parameters: I<max> and I<purge>.  The first one
  725. is the maximum size of the cache and the second one is the cache
  726. flushing ratio: when the number of cache entries exceeds I<max>,
  727. I<max> times I<purge> cache entries are flushed.  The default
  728. values are 1000 and 0.75, respectively, which means that when
  729. the 1001st entry would be cached, 750 least used entries will
  730. be removed from the cache.  To access the parameters you can
  731. use the calls
  732.  
  733.     $now_max = String::Approx::cache_max();
  734.     String::Approx::cache_max($new_max);
  735.  
  736.     $now_purge = String::Approx::cache_purge();
  737.     String::Approx::cache_purge($new_purge);
  738.  
  739.     $limit = String::Approx::cache_n_purge();
  740.  
  741. To be honest, there are actually B<two> caches: the first one is used
  742. far the patterns with no modifiers, the second one for the patterns
  743. with pattern modifiers.  Using the standard parameters you will
  744. therefore actually cache up to 2000 entries.  The above calls control
  745. both caches for the same price.
  746.  
  747. To disable caching completely use
  748.  
  749.     String::Approx::cache_disable();
  750.  
  751. Note that this doesn't flush any possibly existing cache entries,
  752. to do that use
  753.  
  754.     String::Approx::cache_flush_all();
  755.  
  756. =head1 NOTES
  757.  
  758. Because matching is by I<substrings>, not by whole strings, insertions
  759. and substitutions produce often very similar results: "abcde" matches
  760. "axbcde" either by insertion B<or> substitution of "x".
  761.  
  762. The maximum edit distance is also the maximum number of edits.
  763. That is, the C<"I2"> in
  764.  
  765.     amatch("abcd", ["I2"])
  766.  
  767. is useless because the maximum edit distance is (implicitly) 1.
  768. You may have meant to say
  769.  
  770.     amatch("abcd", ["2D1S1"])
  771.  
  772. or something like that.
  773.  
  774. If you want to simulate transposes
  775.  
  776.     feet fete
  777.  
  778. you need to allow at least edit distance of two because in terms of
  779. our edit primitives a transpose is first one deletion and then one
  780. insertion.
  781.  
  782. =head2 TEXT POSITION
  783.  
  784. The starting and ending positions of matching, substituting, indexing, or
  785. slicing can be changed from the beginning and end of the input(s) to
  786. some other positions by using either or both of the modifiers
  787.  
  788.     "initial_position=24"
  789.     "final_position=42"
  790.  
  791. or the both the modifiers
  792.  
  793.     "initial_position=24"
  794.     "position_range=10"
  795.  
  796. By setting the C<"position_range"> to be zero you can limit
  797. (anchor) the operation to happen only once (if a match is possible)
  798. at the position.
  799.  
  800. =head1 VERSION
  801.  
  802. Major release 3.
  803.  
  804. =head1 CHANGES FROM VERSION 2
  805.  
  806. =head2 GOOD NEWS
  807.  
  808. =over 4
  809.  
  810. =item The version 3 is 2-3 times faster than version 2
  811.  
  812. =item No pattern length limitation
  813.  
  814. The algorithm is independent on the pattern length: its time
  815. complexity is I<O(kn)>, where I<k> is the number of edits and I<n> the
  816. length of the text (input).  The preprocessing of the pattern will of
  817. course take some I<O(m)> (I<m> being the pattern length) time, but
  818. C<amatch()> and C<asubstitute()> cache the result of this
  819. preprocessing so that it is done only once per pattern.
  820.  
  821. =back
  822.  
  823. =head2 BAD NEWS
  824.  
  825. =over 4
  826.  
  827. =item You do need a C compiler to install the module
  828.  
  829. Perl's regular expressions are no more used; instead a faster and more
  830. scalable algorithm written in C is used.
  831.  
  832. =item C<asubstitute()> is now always stingy
  833.  
  834. The string matched and substituted is now always stingy, as short
  835. as possible.  It used to be as long as possible.  This is an unfortunate
  836. change stemming from switching the matching algorithm.  Example: with
  837. edit distance of two and substituting for C<"word"> from C<"cork"> and
  838. C<"wool"> previously did match C<"cork"> and C<"wool">.  Now it does
  839. match C<"or"> and C<"wo">.  As little as possible, or, in other words,
  840. with as much approximateness, as many edits, as possible.  Because
  841. there is no I<need> to match the C<"c"> of C<"cork">, it is not matched.
  842.  
  843. =item no more C<aregex()> because regular expressions are no more used
  844.  
  845. =item no more C<compat1> for String::Approx version 1 compatibility
  846.  
  847. =back
  848.  
  849. =head1 ACKNOWLEDGEMENTS
  850.  
  851. The following people have provided valuable test cases, documentation
  852. clarifications, and other feedback:
  853.  
  854. Jared August, Arthur Bergman, Anirvan Chatterjee, Steve A. Chervitz,
  855. Aldo Calpini, David Curiel, Teun van den Dool, Alberto Fontaneda,
  856. Rob Fugina, Dmitrij Frishman, Lars Gregersen, Kevin Greiner,
  857. B. Elijah Griffin, Mike Hanafey, Mitch Helle, Ricky Houghton,
  858. 'idallen', Helmut Jarausch, Damian Keefe, Ben Kennedy, Craig Kelley,
  859. Franz Kirsch, Dag Kristian, Mark Land, J. D. Laub, Tim Maher,
  860. Juha Muilu, Sergey Novoselov, Andy Oram, Ji Y Park, Eric Promislow,
  861. Nikolaus Rath, Stefan Ram, Dag Kristian Rognlien, Stewart Russell,
  862. Slaven Rezic, Chris Rosin, Pasha Sadri, Ilya Sandler, Bob J.A. Schijvenaars,
  863. Ross Smith, Frank Tobin, Greg Ward, Rich Williams, Rick Wise.
  864.  
  865. The matching algorithm was developed by Udi Manber, Sun Wu, and Burra
  866. Gopal in the Department of Computer Science, University of Arizona.
  867.  
  868. =head1 AUTHOR
  869.  
  870. Jarkko Hietaniemi <jhi@iki.fi>
  871.  
  872. =head1 COPYRIGHT AND LICENSE
  873.  
  874. Copyright 2001-2003 by Jarkko Hietaniemi
  875.  
  876. This library is free software; you can redistribute it and/or modify
  877. it under the same terms as Perl itself.
  878.  
  879. Furthermore: no warranties or obligations of any kind are given, and
  880. the separate file F<COPYRIGHT> must be included intact in all copies
  881. and derived materials.
  882.  
  883. =cut
  884.