← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/isdnutils/jaunty-proposed

« back to all changes in this revision

Viewing changes to isdnlog/tools/dest/wld.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matthias Klose
  • Date: 2004-09-04 08:20:20 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040904082020-g641px056lshw203
Tags: 1:3.3.0.20040728-2
http://bugs.debian.org/268767
http://bugs.debian.org/268716
http://bugs.debian.org/269666
* Put libcapi20 development files into new libcapi20-dev package,
  change libcapi20 soname to libcapi20-3, conflict with existing
  versions of packages depending on libcapi20-3 (closes: #268767).
* Update debconf translation strings (closes: #268716).
* Update french debconf translation (closes: #269666).

Show diffs side-by-side

added added

removed removed

Lines of Context:
isdnlog/tools/dest/wld.pm
1
1
package wld;
2
2
use strict;
 
3
use integer;
3
4
use vars qw($VERSION @ISA @EXPORT);
4
 
$VERSION=1.0;
 
5
$VERSION=1.1;
5
6
require Exporter;
6
7
@ISA=qw(Exporter);
7
8
@EXPORT=qw(wld);
8
9
sub min3 {
9
10
    my ($x, $y, $z)=@_;
10
 
    $y = $x if ($x lt $y);
11
 
    $z = $y if ($y lt $z);
 
11
    $y = $x if ($x < $y);
 
12
    $z = $y if ($y < $z);
12
13
    $z;
13
14
}
14
15
 
15
16
sub wld {       #/* weighted Levenshtein distance */
16
 
  my ($needle, $haystack) = @_;
 
17
  # $dmax is the smallest distance already found, only
 
18
  # smaller distances are computed, otherwise a number
 
19
  # equal or less than the real distance is returned  
 
20
  my ($needle, $haystack, $dmax) = @_;
 
21
  $dmax = 98 unless (defined($dmax));   # default when 3rd arg is missing 
17
22
  my($i, $j);
18
23
  my $l1 = length($needle);
19
24
  my $l2 = length($haystack);
 
25
  my @s1 = (0, unpack('A' x $l1, $needle));
 
26
  my @s2 = (0, unpack('A' x $l2, $haystack));
 
27
  my $ldiff = abs($l1-$l2);
 
28
  # the distance can not be less than the length difference
 
29
  return $ldiff unless ($ldiff < $dmax);
20
30
  my @dw;
21
 
  my ($WMAX,$P,$Q,$R);
22
 
  $WMAX=$l1>$l2?$l1:$l2;
 
31
  my $imin;     # minimum value of column $i, also lower limit of result
 
32
  my ($P,$Q,$R);
23
33
  $P=1;
24
34
  $Q=1;
25
35
  $R=1;
26
36
 
27
37
  $dw[0][0]=0;
28
 
  for ($j=1; $j<=$WMAX; $j++) {
 
38
  for ($j=1; $j<=$l2; $j++) {
29
39
    $dw[0][$j]=$dw[0][$j-1]+$Q;
30
40
  }
31
 
  for ($i=1; $i<=$WMAX; $i++) {
 
41
  for ($i=1; $i<=$l1; $i++) {
32
42
    $dw[$i][0]=$dw[$i-1][0]+$R;
33
43
  }
34
44
  for ($i=1; $i<=$l1; $i++) {
 
45
    $imin = $dw[$i][0];
35
46
    for($j=1; $j<=$l2; $j++) {
36
 
      $dw[$i][$j]=&min3($dw[$i-1][$j-1]+((substr($needle,$i-1,1) eq
37
 
        substr($haystack,$j-1,1))?0:$P),$dw[$i][$j-1]+$Q,$dw[$i-1][$j]+$R);
 
47
      $dw[$i][$j] = &min3( $dw[$i-1][$j-1] + ( ($s1[$i] eq $s2[$j])?0:$P ),
 
48
                           $dw[$i][$j-1]+$Q, $dw[$i-1][$j]+$R );
 
49
      $imin = $dw[$i][$j] if ($dw[$i][$j]<$imin);
38
50
    }   
 
51
    # abort if complete column makes results less than $dmax impossible
 
52
    return ($imin) unless ($imin<$dmax);
39
53
  }
40
54
  return($dw[$l1][$l2]);
41
55
}