by tilly (Archbishop)
 on Jun 01, 2004 at 17:27 UTC Need Help??

Partition code using the pentagonal numbers optimization. (Could be improved.)
```#! /usr/bin/perl
use strict;
use Math::BigInt lib=>"GMP";

sub partitions {
my \$n = shift;
my @partitions = Math::BigInt->new(1);
for my \$i (1..\$n) {
my \$sign = 1;
my \$j = 1;
while (1) {
my \$k = \$j*(3*\$j-1)/2;
last if \$k > \$i;
\$partitions[\$i] += \$sign*\$partitions[\$i-\$k];
\$k = \$j*(3*\$j+1)/2;
last if \$k > \$i;
\$partitions[\$i] += \$sign*\$partitions[\$i-\$k];
\$sign *= -1;
\$j++;
}
}
return \$partitions[\$n];
}

print "\$_: ", partitions(\$_), "\n" for @ARGV;

For Limbic~Region, count of partitions.
```#! /usr/bin/perl -w
use strict;
use Memoize;
memoize('partition_intermediate');

# This counts partitions of \$n whose smallest value is at least \$k
sub partition_intermediate {
my (\$n, \$k) = @_;
if (\$n == \$k) {
return 1;
}
elsif (\$n < \$k) {
return 0;
}
else {
return partition_intermediate(\$n, \$k+1) + partition_intermediate(\$
+n-\$k, \$k);  }
}

sub partitions {
my \$n = shift;
return partition_intermediate(\$n, 1);
}

print "\$_: ", partitions(\$_), "\n" for @ARGV;
Faster if you do it iteratively though.
```sub partitions {
my \$n = shift;
my @partitions = 1;
for my \$i (1..\$n) {
for my \$j (0..(\$n-\$i)) {
\$partitions[\$i+\$j] += \$partitions[\$j];
}
}
return \$partitions[\$n];
}
And that can be optimized...
```sub partitions {
my \$n = shift;
my @partitions = 1;
for my \$i (1..\$n) {
for my \$j (0..(\$n-2*\$i), \$n-\$i) {
\$partitions[\$i+\$j] += \$partitions[\$j];
}
}
return \$partitions[\$n];
}

A demonstration of calculating partial sums of infinite series in Perl.
```sub linear_sequence {
my (\$start, \$inc) = @_;
sub {
my \$value = \$start;
\$start += \$inc;
return \$value;
};
}

sub interleave_linear_sequences {
my @gen = map linear_sequence(@\$_), @_;
sub {
push @gen, shift @gen;
\$gen[-1]->();
}
}

sub alternating {
interleave_linear_sequences([1, 2], [-2, -2]);
}

sub rearranged {
interleave_linear_sequences([1, 4], [3, 4], [-2, -2]);
}

my \$a = alternating();
my \$r = rearranged();

my %do_report = map {\$_=>1} qw(10 100 1000 10000);

my \$count = 0;
my \$alternating_sum = my \$rearranged_sum = 0;
while (%do_report) {
\$count++;
\$alternating_sum += 1/\$a->();
\$rearranged_sum  += 1/\$r->();
if (delete \$do_report{\$count}) {

print "\$count terms:\n",
"  Alternating: \$alternating_sum\n",
"  Rearranged:  \$rearranged_sum\n";
}
}

A demonstration of implementing double linked lists in Perl while dealing with circular references.
```#! /usr/bin/perl
use strict;

my \$list = new LinkedList(qw(software cheese fruit wine pasta));
print "Listing list forward:\n";
do {
print "  Node: ", \$list->data, "\n";
} while \$list->move_next;
print "\nListing list backward:\n";
do {
print "  Node: ", \$list->data, "\n";
} while \$list->move_prev;

use WeakRef;

my \$self = shift;
return 1;
}

my \$self = shift;
return 1;
}

sub clone {
my \$self = shift;
my \$clone = bless { %\$self }, ref(\$self);
my \$is_clone = \$self->{is_clone};
\$is_clone->{\$clone} = \$clone;
weaken(\$is_clone->{\$clone});
return \$clone;
}

sub data {
(shift)->{current}->data;
}

sub move_next {
my \$self = shift;
my \$next = \$self->{current}->next();
\$self->{current} = \$next if defined(\$next);
return defined(\$next);
}

sub move_prev {
my \$self = shift;
my \$prev = \$self->{current}->prev();
\$self->{current} = \$prev if defined(\$prev);
return defined(\$prev);
}

sub new {
my \$class = shift;
my \$self = bless {}, \$class;
my \$data = shift;
\$self->{is_clone} = {\$self=>{\$self}};
weaken(\$self->{is_clone}->{\$self});
my \$clone = \$self->clone;
while (@_) {
\$clone->move_next;
}
return \$self;
}

sub next {
my \$clone = (shift)->clone;
\$clone->move_next ? \$clone : undef;
}

sub prev {
my \$clone = (shift)->clone;
\$clone->move_prev ? \$clone : undef;
}

sub DESTROY {
my \$self = shift;
delete \$self->{is_clone}->{\$self};
if (not keys %{\$self->{is_clone}}) {
# Clean up circular stuff
my \$node = \$self->{current};
while (defined(\$node)) {
\$node = delete \$node->{next};
}
\$node = \$self->{current};
while (defined(\$node)) {
\$node = delete \$node->{prev};
}
}
}

my (\$self, \$next) = @_;
my \$old_next = \$self->{next};
\$self->{next} = \$next;
\$next->{prev} = \$self;
\$next->{next} = \$old_next;
\$old_next->{prev} = \$next if defined(\$old_next);
}

my (\$self, \$prev) = @_;
my \$old_prev = \$self->{prev};
\$self->{prev} = \$prev;
\$prev->{next} = \$self;
\$prev->{prev} = \$old_prev;
\$old_prev->{next} = \$prev if defined(\$old_prev);
}

sub data {
(shift)->{data};
}

sub new {
my (\$class, \$data) = @_;
return bless { data => \$data}, \$class;
}

sub next {
(shift)->{next};
}

sub prev {
(shift)->{prev};
}

sub DESTROY {
my \$self = shift;
#warn("Node: \$self->{data} destroyed");
}

Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (3)
As of 2020-10-31 13:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My favourite web site is:

Results (289 votes). Check out past polls.

Notices?