Неограниченные списки в Perl
© Copyright 1997 The Perl Journal.
Многие обьекты могут быть неограниченными - например , лог с вебсервера или число пи .
Один из принципов программирования заключается в том , что модель таких обьектов
должна быть по возможности как можно проще .
С другой стороны , количество памяти у компьютера конечно .
Поэтому нам нужна такая структура , которая ведет себя так , как будто она неограниченная .
В этой статье демонстрируется структура данных , Stream.
Она может сохранить неограниченное количество данных .
С этой структурой можно выполнять операции фильтровки , изменять данные .
Программирование потоков аналогично программированию пайпов в шелле .
Проблема , которую мы сейчас решим с помощью потоков , является :
Рассмотрим последовательность вида
2i3j5k
для i,j,k
Такой массив называется последовательностью Hamming .
Например:
1 2 3 4 5 6 8 9 10 12 15 16 18 ...
Предположим , нам нужны первые 3 тысячи таких чисел .
Число входит в последовательность при условии , что его можно делить без остатка на три числа - 2,3,5 -
в произвольном порядке до тех пор , пока результат деления не станет равен единице .
Проблема в том , что для нахождения такой последовательности потребуется очень много времени .
Так , предпоследнее число в последовательности из 3000 таких чисел равно 278,628,139,008.
Но эта проблема разрешима с помощью обычных методов программирования .
Поток (stream) - это источник данных подобный шлангу с водой . И когда нам нужна очередная порция данных ,
нужно просто взять эту порцию из потока . Основное отличие потока от массива в том ,
что данные вычисляются и при этом нигде не лежат .
В отличие от массива , поток больше похож на связанный список , состоящий из нод .
Каждая нода состоит из 2-х частей - заголовка , в котором находятся данные ,
и тела , которое указывает на следующую ноду в потоке .
В перле для такой модели более всего подходит хэш .
При этом $node{h} будет заголовком , и $node{t} будет телом.
Поток будет связанным списком таких нод :
head tail head tail head tail
+-----+-----+ +-----+-----+ +-----+-----+
| | | | | | | | |
| foo | *-------}| 3 | *-------}| bar | *------} . . .
| | | | | | | | |
+-----+-----+ +-----+-----+ +-----+-----+
Поток : ('foo', 3, 'bar', ...).
При этом нода может не иметь тела , как показано на рисунке - оно будет вычеслено при необходимости :
____________
+-----+-----+ +-----+-----+ +-----+-----+ / /\
| | | | | | | | | |I'll do it |/
| foo | *-------}| 3 | *-------}| bar | *------}|when and if|
| | | | | | | | | |you need it|
+-----+-----+ +-----+-----+ +-----+-----+ | |
| Love, Perl|
_|__________ |
\___________\/
Вместо тела (tail) может быть псевдо-тело ( promise) , которое вычисляется с помощью функции :
$promise = sub { EXPRESSION };
Эта анонимная функция ничего не возвращает , она вернет результат лишь тогда , когда
мы ее вызовем как
$value = &$promise; # Evaluate EXPRESSION
Это можно сделать например так :
if (ref $something eq CODE) { # It's a promise... }
Далее идет простая функция для конструирования ноды потока . Ей нужны 2 аргумента - head и tail ,
которые размещаются в анонимный хэш :
package Stream;
sub new {
my ($package, $head, $tail) = @_;
bless { h => $head, t => $tail } => $package;
}
Метод head возвращает заголовок из этого хэша :
sub head { $_[0]{h} }
Метод tail либо возвращает существующий tail немедленно ,
либо вычисляет его :
sub tail {
my $tail = $_[0]{t};
if (ref $tail eq CODE) { # It's a promise
$_[0]{t} = &$tail(); # Collect on the promise
}
$_[0]{t};
}
Конструкция для пустого потока :
sub empty {
my $pack = ref(shift()) || Stream;
bless {e => 'I am empty.'} => $pack;
}
Функция . которая вычисляет - пустой поток или нет :
sub is_empty { exists $_[0]{e} }
Далее идет функция tabulate . Ей нужно дать ссылку на функцию $f,
и число $n, и она сконструирует поток чисел f(n), f(n+1), f(n+2), ...
sub tabulate {
my $f = shift;
my $n = shift;
Stream->new(&$f($n),
sub { &tabulate($f, $n+1) }
)
}
Теперь можно написать :
sub square { $_[0] * $[0] }
$squares = &tabulate( \&square, 1);
Функция show распечатывает результат :
$squares->show;
1 4 9 16 25 36 49 64 81 100
Для решения проблемы Hamming's напишем функцию merge.
Она берет 2 потока и обьединяет их , удаляя двойные элементы ;
1 3 5 7 9 11 13 15 17 ...
1 4 9 16 25 36 ...
1 3 4 5 7 9 11 13 15 16 17 19 ...
sub merge {
my $s1 = shift;
my $s2 = shift;
return $s2 if $s1->is_empty;
return $s1 if $s2->is_empty;
my $h1 = $s1->head;
my $h2 = $s2->head;
if ($h1 > $h2) {
Stream->new($h2, sub { &merge($s1, $s2->tail) });
} elsif ($h1 < $h2) {
Stream->new($h1, sub { &merge($s1->tail, $s2) });
} else { # heads are equal
Stream->new($h1, sub { &merge($s1->tail, $s2->tail) });
}
}
Мы знаем , что первый элемент последовательности - 1.
Остальные числа мы будем получать , умножая на 2 , 3 , 5 .
Взглянем еще раз на последовательность , где числа , кратные 2 , отмечены красным цветом :
1 2 3 4 5 6 8 9 10 12 15 16 18 ...
Теперь перемножим эту последовательность на 2 :
2 4 6 8 10 12 16 18 20 24 30 32 36 ...
Теперь видно , что все красные числа из первой последовательности входят во вторую .
Теперь , если выполнить точно такую же операцию с 1-й последовательностью , но вместо 2
мы перемножим на 3 , а потом еще раз на 5 , мы получим еще 2 последовательности ,
которые обьединив со второй и исключив повторы , мы и получим нужный результат .
Вот функция , которая перемножает последовательность на константу :
# Multiply every number in a stream `$self' by a constant factor `$n'
sub scale {
my $self = shift;
my $n = shift;
return &empty if $self->is_empty;
Stream->new($self->head * $n,
sub { $self->tail->scale($n) });
}
Следующий код решает проблему : мы используем функцию scale
для умножения последовательности на 2, 3, 5, затем обьединяем 3 потока :
# Construct the stream of Hamming's numbers.
sub hamming {
1 my $href = \1; # Dummy reference
2 my $hamming = Stream->new(
3 1,
4 sub { &merge($$href->scale(2),
5 &merge($$href->scale(3),
6 $$href->scale(5))) });
7 $href = \$hamming; # Reference is no longer a dummy
8 $hamming;
}
Вызов :
&hamming()->show(20);
1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 30 32 36 40
Распечатка первых 2000 чисел этой последовательности на P-III происходит практически мгновенно .
Ниже приведен полный код решения проблемы Hamming :
#!D:/install/perl/bin/perl
#
# Stream.pm
#
# Sample implementation of lazy, infinite streams with memoization
#
# Copyright 1997 M-J. Dominus (mjd@pobox.com)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of any of:
# 1. Version 2 of the GNU General Public License as published by
# the Free Software Foundation;
# 2. Any later version of the GNU public license, or
# 3. The Perl `Artistic License'
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the Artistic License with this
# Kit, in the file named "Artistic". If not, I'll be glad to provide one.
#
# You should also have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
package Stream;
use Exporter;
@ISA = (Exporter);
@EXPORT = qw(new iterate tabulate upto iota filter
primes merge hamming stats rand list2stream
iterate_chop chop_if mingle squares_from hailstones);
### Basic functions
&hamming()->show(2000);
## Manufacture a new stream node with given head and tail.
sub new {
my $what = shift;
my $pack = ref($what) || $what;
my ($h, $t) = @_;
bless { h => $h, t => $t } => $pack;
}
## Return the head of a stream
sub head {
$_[0]{h};
}
## return the tail of a stream, collecting on a promise
## if necessary
sub tail {
my $t = $_[0]{t};
if (ref $t eq CODE) { # It is a promise
$_[0]{t} = &$t;
}
$_[0]{t};
}
## Construct an empty stream
sub empty {
my $pack = ref(shift()) || Stream;
bless {e => q{Yes, I'm empty.}} => $pack;
}
## Is this stream the empty stream?
sub is_empty {
exists $_[0]{e};
}
### Tools
## Compute f(n), f(n+1), f(n+2) ...
sub tabulate {
my $f = shift;
my $n = shift;
Stream->new(&$f($n), sub { &tabulate($f, $n+1) });
}
## Compute i, f(i), f(f(i)), f(f(f(i))), ...
sub iterate {
my $f = shift;
my $i = shift;
Stream->new($i, sub { &iterate($f, &$f($i)) });
}
## Compute list of first n elements of stream.
sub take {
my $s = shift;
my $n = shift;
my @r;
while ($n-- && !$s->is_empty) {
push @r, $s->head;
$s = $s->tail;
}
@r;
}
## Return new stream of elements of $s with first
## $n elements skipped.
sub drop {
my $s = shift;
my $n = shift;
while ($n-- && !$s->is_empty) {
$s = $s->tail;
}
$s;
}
## Actually modify $s to discard first $n elements.
## Return undef if $s was exhausted.
sub discard {
my $s = shift;
my $n = shift;
my $d = $s->drop($n);
if ($d->is_empty) {
$s->{e} = q{Empty.};
delete $s->{h};
delete $s->{t};
} else {
$s->{h} = $d->{h};
$s->{t} = $d->{t};
}
$s;
}
## Display first few elements of a stream
$SHOWLENGTH = 10; # Default number of elements to show
sub show {
my $s = shift;
my $len = shift;
my $showall = $len eq ALL;
$len ||= $SHOWLENGTH;
for ($n = 0; $showall || $n < $len; $n++) {
if ($s->is_empty) {
print "\n";
return;
}
print $s->head, " ";
$s = $s->tail;
}
print "\n";
}
## $f, $f+1, $f+2, ... $t-1, $t.
sub upto {
my $f = shift;
my $t = shift;
return Stream->empty if $f > $t;
Stream->new($f, sub { &upto($f+1, $t) });
}
## 1, 2, 3, 4, 5, ...
sub iota {
&tabulate(sub {$_[0]}, 1); # Tabulate identity function
}
## Return a stream of all the elements of s for which predicate p is true.
sub filter {
my $s = shift;
# Second argument is a predicate function that returns true
# only when passed an interesting element of $s.
my $predicate = shift;
# Look for next interesting element
until ( $s->is_empty || &$predicate($s->head)) {
$s = $s->tail;
}
# If we ran out of stream, return the empty stream.
return $s->empty if $s->is_empty;
# Construct new stream with the interesting element at its head
# and the rest of the stream, appropriately filtered,
# at its tail.
Stream->new($s->head,
sub { $s->tail->filter($predicate) }
);
}
## Given a stream s1, s2, s3, ... return f(s1), f(s2), f(s3), ...
sub transform {
my $s = shift;
return $s->empty if $s->is_empty;
my $map_function = shift;
Stream->new(&$map_function($s->head),
sub { $s->tail->transform($map_function) }
);
}
# Emit elements of a stream s, chopping it off at the first element
# for which `$predicate' is true
sub chop_when {
my $s = shift;
my $predicate = shift;
return $s->empty if $s->is_empty || &$predicate($s->head);
Stream->new($s->head, sub {$s->tail->chop_when($predicate)});
}
# Return first element $h of $s, and sieve out
# subsequent elements, discarding those that are divisible by $h.
sub prime_filter {
my $s = shift;
my $h = $s->head;
Stream->new($h, sub { $s->tail
->filter(sub { $_[0] % $h })
->prime_filter()
});
}
# Multiply every element of a stream $s by a constant $n.
sub scale {
my $s = shift;
my $n = shift;
$s->transform(sub { $_[0] * $n });
}
# Merge two streams of numbers in ascending order, discarding duplicates
sub merge {
my $s1 = shift;
my $s2 = shift;
return $s2 if $s1->is_empty;
return $s1 if $s2->is_empty;
my $h1 = $s1->head;
my $h2 = $s2->head;
if ($h1 > $h2) {
Stream->new($h2, sub { &merge($s1, $s2->tail) });
} elsif ($h1 < $h2) {
Stream->new($h1, sub { &merge($s1->tail, $s2) });
} else { # heads are equal
Stream->new($h1, sub { &merge($s1->tail, $s2->tail) });
}
}
# Given two streams s1, s2, s3, ... and t1, t2, t3, ...
# construct s1, t1, s2, t2, s3, t3, ...
sub mingle {
my $s = shift;
my $t = shift;
return $t if $s->is_empty;
return $s if $t->is_empty;
Stream->new($s->head, sub {&mingle($t, $s->tail)});
}
# This is not a very good way to do it.
sub hamming_slow {
my $n = shift;
Stream->new($n,
sub { &merge(&hamming_slow(2*$n),
&merge(&hamming_slow(3*$n),
&hamming_slow(5*$n),
))
});
}
# This is the good one.
#
# The article says it takes a few minutes to compute 3,000 numbers on
# the dinky machine. That turns out to be not because the dinky
# machine was slow, but because it had so little memory. With an
# extra 24 MB of memory, computing 3,000 numbers takes just under 20
# seconds of CPU time.
#
sub hamming {
my $href = \1; # Dummy reference
my $hamming =
Stream->new(1,
sub { &merge($$href->scale(2),
&merge($$href->scale(3),
$$href->scale(5)
))
}
);
$href = \$hamming; # Reference is no longer a dummy
$hamming;
}
# Rujith S. de Silva points out that the `dummy reference' hack
# is unneccesary. This version is easier to understand and probably
# faster than the `hamming' above:
#
sub hamming_r {
my $hamming;
$hamming =
Stream->new(1,
sub { &merge($hamming_r->scale(2),
&merge($hamming_r->scale(3),
$hamming_r->scale(5)
))
}
);
}
sub squares_from {
my $n = shift;
print STDERR "SQUARES_FROM($n)\n" if $DEBUG;
Stream->new($n*$n,
sub { &squares_from($n+1) });
}
# Hailstone number iterator
sub next_hail {
my $n = shift;
($n % 2 == 0) ? $n/2 : 3*$n + 1;
}
# Return the Collatz 3n+1 sequence starting from n.
sub hailstones {
my $n = shift;
&iterate(\&next_hail, $n);
}
# Example random number generator from ANSI C standard
sub next_rand { int(($_[0] * 1103515245 + 12345) / 65536) % 32768 }
# Stream of random numbers, seeded by $seed.
sub rand {
my $seed = shift;
&iterate(\&next_rand, &next_rand($seed));
}
# Auxiliary function for &iterate_chop
sub iter_pairs {
my $s = shift;
my $ss = shift;
return $s->empty if $s->is_empty;
Stream->new([$s->head, $ss->head],
sub {&iter_pairs($s->tail, $ss->tail->tail)}
);
}
# Given a stream of numbers generated by `iterate',
# chop it off before it repeats.
# Not guaranteed to do anything useful if applied to a stream that was
# not produced by `iterate'
sub iterate_chop {
my $s = shift;
return $s->empty if $s->is_empty;
&iter_pairs($s, $s->tail)
->chop_when(sub {$_[0][0] == $_[0][1]})
->transform(sub {$_[0][0]});
}
# Given a regular list of values, produce a finite stream
sub list2stream {
return Stream->empty unless @_;
my @list = @_;
my $h = shift @list;
# print STDERR "list2stream @_\n";
return Stream->new($h, sub{&list2stream(@list)});
}
## Turn a stream into a regular Perl array
## Caution--only works on finite streams
sub stream2list {
my $s = shift;
my @r;
while (! $s->is_empty) {
push @r, $s->head;
$s = $s->tail;
}
@r;
}
## Compute length of given stream
sub length {
my $s = shift;
my $n = 0;
while (! $s->is_empty) {
$s = $s->tail;
$n++;
}
$n;
}
1;
|
LINUX