Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

tilly's scratchpad

by tilly (Archbishop)
on Jun 01, 2004 at 17:27 UTC ( #358287=scratchpad: print w/replies, xml ) 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; 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"); }
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2020-02-16 21:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What numbers are you going to focus on primarily in 2020?










    Results (70 votes). Check out past polls.

    Notices?