人类能做到吗？
远方袋
远侧袋
背袋
远侧袋
您不仅必须使用字典，还可能必须使用统计方法来找出最有可能的内容（或者，上帝保佑，您选择的人类语言的实际 HMM...）
关于如何进行可能有用的统计，我请您咨询 Peter Norvig 博士，他在 21 行代码中解决了一个不同但相关的拼写检查问题：
http://norvig.com/spell-correct.html
（他确实通过将每个 for 循环折叠成一行来作弊……但仍然如此）。
更新这件事卡在我的脑海里，所以我今天不得不生下它。此代码与 Robert Gamble 描述的代码进行了类似的拆分，但随后它根据提供的字典文件中的词频对结果进行排序（现在预计该文件通常是代表您的域或英语的一些文本。我使用了 big来自 Norvig 的 .txt，上面有链接，并为它添加了一本字典，以覆盖缺失的单词）。
除非频率差异很大，否则两个词的组合在大多数情况下会胜过三个词的组合。
我在我的博客上发布了这段代码并做了一些小的改动
http://squarecog.wordpress.com/2008/10/19/splitting-words-joined-into-a-single-string/
并且还写了一些关于这段代码中的下溢错误。我很想悄悄地修复它，但认为这可能会帮助一些以前没有看过日志技巧的人：
http://squarecog.wordpress.com/2009/01/10/dealing-with-underflow-in-joint-probability-calculations/
输出你的话，加上我自己的话——注意“orcore”会发生什么：
perl splitwords.pl big.txt 单词
answerveal：2种可能性
- 回答小牛肉
- 回答ve al
邪恶的天气：4种可能性
- 恶劣的天气
- 邪恶的我们在她
- 邪恶的天气
- 邪恶的我们在她
液态天气：6种可能性
- 液态天气
- 我们对她的液体
- li quid 天气
- 我对她说我们
- li qu id 天气
- li qu id we at her
driveourtrucks: 1 种可能性
- 驾驶我们的卡车
gocompact：1 种可能性
- 紧凑
超薄投影仪：2 种可能性
- 超薄投影仪
- 苗条的项目或
orcore：3种可能性
- 或核心
- 或核心
- 兽人矿石
代码：
#!/usr/bin/env perl
use strict;
use warnings;
sub find_matches($);
sub find_matches_rec($\@\@);
sub find_word_seq_score(@);
sub get_word_stats($);
sub print_results($@);
sub Usage();
our(%DICT,$TOTAL);
{
my( $dict_file, $word_file ) = @ARGV;
($dict_file && $word_file) or die(Usage);
{
my $DICT;
($DICT, $TOTAL) = get_word_stats($dict_file);
%DICT = %$DICT;
}
{
open( my $WORDS, '<', $word_file ) or die "unable to open $word_file\n";
foreach my $word (<$WORDS>) {
chomp $word;
my $arr = find_matches($word);
local $_;
# Schwartzian Transform
my @sorted_arr =
map { $_->[0] }
sort { $b->[1] <=> $a->[1] }
map {
[ $_, find_word_seq_score(@$_) ]
}
@$arr;
print_results( $word, @sorted_arr );
}
close $WORDS;
}
}
sub find_matches($){
my( $string ) = @_;
my @found_parses;
my @words;
find_matches_rec( $string, @words, @found_parses );
return @found_parses if wantarray;
return \@found_parses;
}
sub find_matches_rec($\@\@){
my( $string, $words_sofar, $found_parses ) = @_;
my $length = length $string;
unless( $length ){
push @$found_parses, $words_sofar;
return @$found_parses if wantarray;
return $found_parses;
}
foreach my $i ( 2..$length ){
my $prefix = substr($string, 0, $i);
my $suffix = substr($string, $i, $length-$i);
if( exists $DICT{$prefix} ){
my @words = ( @$words_sofar, $prefix );
find_matches_rec( $suffix, @words, @$found_parses );
}
}
return @$found_parses if wantarray;
return $found_parses;
}
## Just a simple joint probability
## assumes independence between words, which is obviously untrue
## that's why this is broken out -- feel free to add better brains
sub find_word_seq_score(@){
my( @words ) = @_;
local $_;
my $score = 1;
foreach ( @words ){
$score = $score * $DICT{$_} / $TOTAL;
}
return $score;
}
sub get_word_stats($){
my ($filename) = @_;
open(my $DICT, '<', $filename) or die "unable to open $filename\n";
local $/= undef;
local $_;
my %dict;
my $total = 0;
while ( <$DICT> ){
foreach ( split(/\b/, $_) ) {
$dict{$_} += 1;
$total++;
}
}
close $DICT;
return (\%dict, $total);
}
sub print_results($@){
#( 'word', [qw'test one'], [qw'test two'], ... )
my ($word, @combos) = @_;
local $_;
my $possible = scalar @combos;
print "$word: $possible possibilities\n";
foreach (@combos) {
print ' - ', join(' ', @$_), "\n";
}
print "\n";
}
sub Usage(){
return "$0 /path/to/dictionary /path/to/your_words";
}