Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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 meditating upon the Monastery: (3)
As of 2020-04-05 21:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The most amusing oxymoron is:
















    Results (35 votes). Check out past polls.

    Notices?