それ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);