Nathan Fellman 和 mobrule 都提出了一种常见的做法:标准化。
在执行作为程序或子例程的主要目标的实际计算之前,处理数据以使其符合预期的内容和结构规范通常更简单。
马尔可夫链程序很有趣,所以我决定尝试一下。
这是一个允许您控制马尔可夫链中层数的版本。通过更改$DEPTH
,您可以调整模拟的顺序。
我将代码分解为可重用的子程序。您可以通过更改规范化例程来修改规范化规则。您还可以根据定义的一组值生成链。
生成多层状态表的代码是最有趣的部分。我本可以使用 Data::Diver,但我想自己解决。
单词规范化代码确实应该允许规范化器返回要处理的单词列表,而不仅仅是一个单词——但我不觉得现在修复它可以返回单词列表.. 其他事情,比如序列化你处理的语料库会很好,并且使用 Getopt::Long 进行命令行切换仍有待完成。我只做了有趣的部分。
在不使用对象的情况下编写这个对我来说有点挑战——这真的是一个制作马尔可夫生成器对象的好地方。我喜欢物体。但是,我决定保留代码的程序性,以便保留原始的精神。
玩得开心。
#!/usr/bin/perl
use strict;
use warnings;
use IO::Handle;
use constant NONWORD => "-";
my $MAXGEN = 10000;
my $DEPTH = 2;
my %state_table;
process_corpus( \*ARGV, $DEPTH, \%state_table );
generate_markov_chain( \%state_table, $MAXGEN );
sub process_corpus {
my $fh = shift;
my $depth = shift;
my $state_table = shift || {};;
my @history = (NONWORD) x $depth;
while( my $raw_line = $fh->getline ) {
my $line = normalize_line($raw_line);
next unless defined $line;
my @words = map normalize_word($_), split /\s+/, $line;
for my $word ( @words ) {
next unless defined $word;
add_word_to_table( $state_table, \@history, $word );
push @history, $word;
shift @history;
}
}
add_word_to_table( $state_table, \@history, NONWORD );
return $state_table;
}
# This was the trickiest to write.
# $node has to be a reference to the slot so that
# autovivified items will be retained in the $table.
sub add_word_to_table {
my $table = shift;
my $history = shift;
my $word = shift;
my $node = \$table;
for( @$history ) {
$node = \${$node}->{$_};
}
push @$$node, $word;
return 1;
}
# Replace this with anything.
# Return undef to skip a word
sub normalize_word {
my $word = shift;
$word =~ s/[^A-Z]//g;
return length $word ? $word : ();
}
# Replace this with anything.
# Return undef to skip a line
sub normalize_line {
return uc shift;
}
sub generate_markov_chain {
my $table = shift;
my $length = shift;
my $history = shift || [];
my $node = $table;
unless( @$history ) {
while(
ref $node eq ref {}
and
exists $node->{NONWORD()}
) {
$node = $node->{NONWORD()};
push @$history, NONWORD;
}
}
for (my $i = 0; $i < $MAXGEN; $i++) {
my $word = get_word( $table, $history );
last if $word eq NONWORD;
print "$word\n";
push @$history, $word;
shift @$history;
}
return $history;
}
sub get_word {
my $table = shift;
my $history = shift;
for my $step ( @$history ) {
$table = $table->{$step};
}
my $word = $table->[ int rand @$table ];
return $word;
}
更新:
我修复了上面的代码来处理从normalize_word()
例程返回的多个单词。
要保持大小写不变并将标点符号视为单词,请替换normalize_line()
and normalize_word()
:
sub normalize_line {
return shift;
}
sub normalize_word {
my $word = shift;
# Sanitize words to only include letters and ?,.! marks
$word =~ s/[^A-Z?.,!]//gi;
# Break the word into multiple words as needed.
my @words = split /([.?,!])/, $word;
# return all non-zero length words.
return grep length, @words;
}
另一个潜伏的大问题是我用作-
NONWORD 字符。如果您想包含连字符作为标点符号,您需要在第 8 行更改 NONWORD 常量定义。只需选择永远不会是单词的东西。