diff options
| -rw-r--r-- | challenge-003/duncan-c-white/perl5/README | 8 | ||||
| -rwxr-xr-x | challenge-003/duncan-c-white/perl5/ch-1.pl | 220 | ||||
| -rwxr-xr-x | challenge-003/duncan-c-white/perl5/ch-2.pl | 26 |
3 files changed, 254 insertions, 0 deletions
diff --git a/challenge-003/duncan-c-white/perl5/README b/challenge-003/duncan-c-white/perl5/README new file mode 100644 index 0000000000..d6a6cb2f04 --- /dev/null +++ b/challenge-003/duncan-c-white/perl5/README @@ -0,0 +1,8 @@ +I have investigated Challenge 1 (the Regular numbers) reasonably thoroughly, +building and comparing 4 iterative solutions to generate them. I also +investigated a Lazy List version, storing the tail of the list as a promise - +a function to call when you wanted the next head item, and the returned tail +is another promise - to generate the next item later when needed. However, +I couldn't get that to work so abandoned it:-) + +Challenge 2 (Pascal's Triangle) by contrast is pretty basic and simple-minded. diff --git a/challenge-003/duncan-c-white/perl5/ch-1.pl b/challenge-003/duncan-c-white/perl5/ch-1.pl new file mode 100755 index 0000000000..3e6cf63ed4 --- /dev/null +++ b/challenge-003/duncan-c-white/perl5/ch-1.pl @@ -0,0 +1,220 @@ +#!/usr/bin/perl +# +# iterative generation of the first N regular numbers +# (numbers of the form 2^i.3^j.5^k) +# in ascending order, using 4 different algorithms. +# +# This program takes two optional arguments: +# ch-1-pl [benchmark [firstN]] +# where benchmark defaults to 0, and firstN to 1000. +# - If benchmark is 0, we run each algorithm in turn +# and minimally checks that each algorithm generates +# the same list. +# - If benchmark is any non-zero value (+ or -), each +# algorithm is Benchmarked with the $benchmark value +# as Benchmark::timethese's first parameter. Thus, +# a +ve value means "benchmark this many iterations", +# while a -ve value means "benchmark for abs(this) seconds". +# +# So, for example: +# ./ch-1.pl 0 +# runs all 4 algorithms, telling you whether each result is the same.. +# but: +# ./ch-1.pl -60 +# runs all 4 algorithms repeatedly under Benchmark, and reports: +# Benchmark: running v1, v2, v3, v4 for at least 60 CPU seconds... +# v1: 69 wallclock secs (68.38 usr + 0.00 sys = 68.38 CPU) @ 0.06/s (n=4) +# v2: 64 wallclock secs (63.17 usr + 0.00 sys = 63.17 CPU) @ 26.29/s (n=1661) +# v3: 62 wallclock secs (62.54 usr + 0.00 sys = 62.54 CPU) @ 45.24/s (n=2829) +# v4: 63 wallclock secs (63.38 usr + 0.00 sys = 63.38 CPU) @ 127.90/s (n=8106) + +use strict; +use warnings; + +use Benchmark qw(:all) ; + +# +# my @result = firstn_regnos_v1( $n ); +# Generate the first N regular numbers via basic GENERATE AND TEST: +# generate every integer, then check "is it 2^i.3^j.5^k for any i,j,k"? +# Returns a list of the first N regular numbers. +# +sub firstn_regnos_v1 +{ + my( $n ) = @_; + my @result = (1); + for( my $x=2; @result<$n; $x++ ) + { + my $y=$x; + $y/=5 while $y%5==0; + $y/=3 while $y%3==0; + $y/=2 while $y%2==0; + push @result, $x if $y==1; + } + return @result; +} + + +# +# my @result = firstn_regnos_v2( $n ); +# Generate the first N regular numbers via a todo set +# of higher 2^i.3^j.5^k values that we haven't yet +# checked, and sorting the todo list to pick the smallest +# every time. Returns a list of the first N regular numbers. +# +sub firstn_regnos_v2 +{ + my( $n ) = @_; + my @result = (1); + my %todo = map { $_ => 1 } qw(2 3 5); + for( my $i=1; $i<$n; $i++ ) + { + my @todo = sort { $a <=> $b } keys %todo; + my $next = shift @todo; + push @result, $next; + # update the todo set: next is done, so remove it + delete $todo{$next}; + # update the todo set: add 2*next, 3*nect and 5*next + $todo{2*$next}++; + $todo{3*$next}++; + $todo{5*$next}++; + } + return @result; +} + + +# +# my @result = firstn_regnos_v3( $n ); +# Generate the first N regular numbers via a todo set +# of higher 2^i.3^j.5^k values that we haven't yet +# checked. It's the same as _v2 EXCEPT that we pick the +# smallest element in a different and more efficient way - +# by searching linearly through the todo set - instead of +# forming a list and sorting it, every time. +# Returns a list of the first N regular numbers. +# +sub firstn_regnos_v3 +{ + my( $n ) = @_; + my @result = (1); + my %v = map { $_ => 1 } qw(2 3 5); + for( my $i=1; $i<$n; $i++ ) + { + my $min = each %v; + while( my $v = each %v ) + { + $min = $v if $min>$v; + } + my $next = $min; + push @result, $next; + delete $v{$next}; + $v{2*$next}++; + $v{3*$next}++; + $v{5*$next}++; + } + return @result; +} + + +# +# my @result = firstn_regnos_v4( $firstn ); +# Generate the first $firstn regular numbers via a more +# constrained "todo set" that never has both than +# one term i-j-X or i-X-k or X-j-k in. This is faster +# and uses less memory. +# Returns a list of the first $firstn regular numbers. +# +sub firstn_regnos_v4 +{ + my( $firstn ) = @_; + my @result = (); + my @next = ( [ 1,0,0,0 ] ); # list of N-i-j-k 4-tuples + my %haveij; # distinct "i-j" pairs in @next + my %haveik; # distinct "i-k" pairs + my %havejk; # distinct "j-k" pairs + for( my $a=1; $a<=$firstn; $a++ ) + { + my $tuple = shift @next; + my( $n, $i, $j, $k ) = @$tuple; + #print "debug: result n=$n, i=$i, j=$j, k=$k\n"; + push @result, $n; + # remove i-j-k from have* now that n-i-j-k is done + delete $haveij{"$i-$j"}; + delete $haveik{"$i-$k"}; + delete $havejk{"$j-$k"}; + # consider each of (i+1,j,k), (i,j+1,k) and (i,j,k+1) + foreach my $newt ( [$n*2, $i+1, $j, $k], + [$n*3, $i, $j+1, $k], + [$n*5, $i, $j, $k+1] ) + { + my( $newn, $x, $y, $z ) = @$newt; + #print "debug: found possible next n=$newn, x=$x, y=$y, z=$z\n"; + + # skip newn-x-y-z if we already known x-y-? or x-?-z or ?-x-z + # as this is a higher power combination that we will discover later + next if $haveij{"$x-$y"} || $haveik{"$x-$z"} || $havejk{"$y-$z"}; + + # ok, so newn-x-y-z is genuinely new: add it, first to have* + $haveij{"$x-$y"}++; + $haveik{"$x-$z"}++; + $havejk{"$y-$z"}++; + #print "debug: found actual next n=$newn, x=$x, y=$y, z=$z\n"; + + # second, insert $newn, $x, $y, $z into @next in sorted-by-N order + # - find first pos s.t. next[pos]>newn + my $pos; + for( $pos=0; $pos < @next && $next[$pos]->[0] < $newn; $pos ++ ) + { + } + # - add new item in at pos $pos: + splice( @next, $pos, 0, $newt ); + } + } + return @result; +} + + +# -------------------------------- Main program -------------------------------- + + +my $benchmark = shift // 0; +my $firstn = shift // 1000; + +if( $benchmark ) +{ + timethese( $benchmark, { + 'v1' => sub { firstn_regnos_v1( $firstn ) }, + 'v2' => sub { firstn_regnos_v2( $firstn ) }, + 'v3' => sub { firstn_regnos_v3( $firstn ) }, + 'v4' => sub { firstn_regnos_v4( $firstn ) }, + }); +} else +{ + print "calculating first $firstn regular numbers by v1 (generate and test):\n"; + my @result = firstn_regnos_v1( $firstn ); + my $s1 = join(',', @result); + print "they are: $s1\n"; + + print "calculating first $firstn regular numbers via v2 (todo+sort):\n"; + @result = firstn_regnos_v2( $firstn ); + my $s2 = join(',', @result); + #print "they are: $s2\n"; + + my $same = $s1 eq $s2 ? "same" : "different"; + print "v1 and v2: $same\n"; + + print "calculating first $firstn regular numbers via v3 (todo+find-smallest):\n"; + @result = firstn_regnos_v3( $firstn ); + my $s3 = join(',', @result); + + $same = $s1 eq $s3 ? "same" : "different"; + print "v1 and v3: $same\n"; + + print "calculating first $firstn regular numbers via v4 (clever):\n"; + @result = firstn_regnos_v4( $firstn ); + my $s4 = join(',', @result); + #print "v4: result $s4\n"; + + $same = $s1 eq $s4 ? "same" : "different"; + print "v1 and v4: $same\n"; +} diff --git a/challenge-003/duncan-c-white/perl5/ch-2.pl b/challenge-003/duncan-c-white/perl5/ch-2.pl new file mode 100755 index 0000000000..5109322548 --- /dev/null +++ b/challenge-003/duncan-c-white/perl5/ch-2.pl @@ -0,0 +1,26 @@ +#!/usr/bin/perl +# +# generate the first N rows of Pascal's triangle, no cleverness, just the +# basic formula. + + +use strict; +use warnings; + +use Function::Parameters; + +my $n = shift // 1000; + +my @curr = (1); # current row +my @next; # next row, one element longer than @curr + +for( my $row=1; $row<=$n; $row++ ) +{ + print "row $row: ".join(',',@curr)."\n"; + @next = ( ); + for( my $i=0; $i<=@curr; $i++ ) + { + $next[$i] = ($i==0?0:$curr[$i-1]) + ($i==@curr?0:$curr[$i]); + } + @curr = @next; +} |