古い記事
ランダムジャンプ
新しい記事
Perl のモジュール Algorithm::Diff[2004-12-12-2]を使って、線形時間で類似文字列検索するサンプルプログラム。
まあ、 agrep があればそれでいいんですけどね。

サンプルコード(ads.pl):
#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Diff;
use utf8;
use Encode;
use open ':utf8';
binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";

my $key = shift;
my @seq1 = split(//, decode('utf-8', $key));
while (<>) {
    chomp;
    my @seq2 = split(//, $_);
    my @lcs = Algorithm::Diff::LCS(\@seq1, \@seq2);
    my $score = @lcs * 2 / (@seq1 + @seq2);
    print "$score [@seq1] vs [@seq2]\n";
}
第一引数が検索キー、第二引数が辞書ファイルです。

辞書ファイル(a.dic):
aab
karb
ab
abbbaab
qwerty

実行例:
% ./ads.pl aab a.dic
1 [a a b] vs [a a b]
0.571428571428571 [a a b] vs [k a r b]
0.8 [a a b] vs [a b]
0.6 [a a b] vs [a b b b a a b]
0 [a a b] vs [q w e r t y]

もうちょっと実践的なものとして、
検索キーと1文字違いまで許容するプログラム(ads2.pl):
#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Diff;
use Encode;
use utf8;
use open ':utf8';
binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";

my $key = shift;
my @seq1 = split(//, decode('utf-8', $key));
while (<>) {
    chomp;
    my @seq2 = split(//, $_);
    my @lcs = Algorithm::Diff::LCS(\@seq1, \@seq2);
    next if @lcs < ((@seq1 > @seq2) ? @seq1 : @seq2) - 1;
    print "$_\n";
}

辞書ファイル(a2.dic):
六本木
六本木心中
五本木
本木
本

実行例:
% ./ads2.pl 六本木 a2.dic
六本木
五本木
本木
なお、文字コードはすべて UTF-8 です。