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;
package LinkedList;
use WeakRef;
sub add_next {
my $self = shift;
$self->{current}->add_next(LinkedList::Node->new(shift));
return 1;
}
sub add_prev {
my $self = shift;
$self->{current}->add_prev(LinkedList::Node->new(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->{current} = LinkedList::Node->new($data);
$self->{is_clone} = {$self=>{$self}};
weaken($self->{is_clone}->{$self});
my $clone = $self->clone;
while (@_) {
$clone->add_next(shift);
$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;
#warn("Destroying linked list $self\n");
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};
}
}
#warn("Linked list $self destroyed\n");
}
package LinkedList::Node;
sub add_next {
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);
}
sub add_prev {
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");
}
|