我最近一直在玩马尔科夫链,试图从大型语料库中生成文本只是为了看看我得到了什么(其中一些非常有趣)。
构建文本生成所需的数据结构的很大一部分是创建n-grams。给出一个小样本文本:“今天是星期四三月六号”一个示例n-gram,其中n = 3
将是:
Today is Thursday
is Thursday March
Thursday March the
March the sixth
# skipped lines that have < 3 words because is isn't enough for a 3-gram
根据文本的大小,我的代码生成的n-gram列表可能非常大,在某些语言中,generator的概念包含一个yield语句来制作自定义迭代器,但遗憾的是,Perl不是其中之一。
相反,在Perl中我们可以使用闭包而不是词法变量来创建Iterators,但是我在理解使用它们时真正获得的东西时遇到了一些麻烦。
这是我创建的用于创建n-gram的迭代器(假设n以$ self-&gt;顺序保存):
sub _ngrams {
my ($self, @words) = @_;
return sub {
while(@words) {
my @ngram = @words[0 .. $self->order]; # get $order + 1 words
shift @words; # drop the first word
return @ngram;
}
return; # nothing left to do
};
}
我是否真的从效率方面获得了这些代码?单词列表仍然完全保存在@words
的内存中。是否有可以减少内存占用的替代实现?
以下是使用迭代器生成字典的方法:
sub seed {
my $self = shift;
my $ngram_it = $self->_ngrams(split /\s+/, $self->text);
GRAM:
while (my @gram = $ngram_it->()) {
next GRAM unless @gram == scalar grep { $_ } @gram;
my $val = pop @gram;
my $key = join ' ', @gram;
if (exists $self->lexicon->{$key}) {
push @{$self->lexicon->{$key}}, $val;
}
else {
$self->lexicon->{$key} = [$val];
}
}
}
任何输入都会非常有用。
答案 0 :(得分:2)
首先,您的迭代器实现具有在最后几个值中返回undef
项的不良倾向。我将其改为
sub _ngrams {
my ($self, @words) = @_;
my $order = $self->order;
return sub {
if (@words > $order) {
my @ngram = @words[0 .. $order]; # get $order + 1 words
shift @words; # drop the first word
return @ngram;
}
return; # nothing left to do
};
}
接下来,这个迭代器是一个不错的抽象。它并不意味着以任何方式提高性能,只有使主代码更简单才有用。如果您没有将迭代分开,并且在主代码中完成所有操作,那么您的代码将更短(但并不简单)。
但是,迭代器可以处理有趣的事情,如延迟评估或无限流。为了有用,我们必须将完全切换到流:
# contract: an iterator returns a list of things
# or an empty list when depleted
sub _ngrams {
my ($self, $source) = @_;
my $order = $self->order;
my @ngram = (undef, map { $source->() } 1 .. $order);
return sub {
if (my ($next) = $source->()) {
(undef, @ngram) = (@ngram, $next); # or instead: shift/push
return @ngram;
}
return;
};
}
将初始化为
my $text = $self->text;
my $iter = $self->_ngrams(sub {
return $1 if $text =~ /\G\s*(\S+)/gc;
return;
});
这在这里有用吗?不,因为你立即从迭代器中获取所有元素。 最简单的解决方案不会使用任何花哨的抽象,只需这样:
sub seed {
my $self = shift;
my @words = split /\s+/, $self->text;
my $order = $self->order;
while (@words > $order) {
my @gram = @words[0 .. $order]; # get the next n-gram
shift @words;
my $val = pop @gram;
push @{$self->lexicon->{join ' ', @gram}}, $val;
}
}
我打赌它也是最具(时间)性能的变体。
注意:不需要测试exists
,因为Perl哈希自动生成。 (或者你使用的是奇怪的扩展吗?)