それPerlで書けるよ(当たり前だ)
http://www.aoky.net/articles/peter_norvig/spell-correct.htm
Pythonくんのことをもっと知りたくてPerlにしてみたが、多分、目的と効果が関係なかった。
元のコードと説明が不一致に見える部分が多い(Pythonわかんないからかな)。よくわかんなかったdefaultdictのあたりは実装してない。その他いろいろ変かも。
行数はあんまり意識していなかった(特に序盤)ので元のコードよりも増えているけど、意味論的にはそんなに苦しくないと思った。と、ちゃんと実装せぬままに言い放つ。
#!/usr/bin/env perl use List::MoreUtils qw/uniq/; use List::Util qw/reduce/; use File::Slurp; use strict; sub words { my $t = shift; my @ret = $t =~ m/([a-z]+)(?:.+?([a-z]+)+)/smg; return @ret; } sub train { my @features = @_; my $model = {}; map {$model->{$_}++;} @features; return $model; } my $NWORDS = train ( words( lc( read_file 'big.txt'))); my @al = "a" .. "z"; sub edits1 { my @chars = split//, $_[0]; my @ret = (); for(0 .. $#chars-1){ push @ret, join '', (@chars[0..$_-1], $chars[$_+1], $chars[$_], @chars[$_+2..$#chars]); } for(0 .. $#chars){ push @ret, join '', (@chars[0..$_-1], @chars[$_+1..$#chars]); for my $c(@al) { push @ret, join '', (@chars[0..$_-1], $c, @chars[$_ +1..$#chars]); push @ret, join '', (@chars[0..$_], $c, @chars[$_ +1..$#chars]); } } return uniq(@ret); } sub edits2 { map {edits1($_)} edits1(shift); } sub known_edits2 { uniq_known(edits2(shift)); } sub uniq_known { # `uniq' code From List::MoreUtils my %h; grep { $h{$_}++ == 0 and exists($NWORDS->{$_}) } @_; } sub known { grep { exists($NWORDS->{$_}) } @_; } sub correct { my $word = shift; my @candidates = (known($word), known(edits1($word)), known_edits2($word), $word); return reduce { $NWORDS->{$a} > $NWORDS->{$b} ? $a: $b } @candidates; } my $target = $ARGV[0]; print correct($target);