diff options
| -rwxr-xr-x | challenge-069/jo-37/perl/ch-1.pl | 48 | ||||
| -rwxr-xr-x | challenge-069/jo-37/perl/ch-2.pl | 177 |
2 files changed, 225 insertions, 0 deletions
diff --git a/challenge-069/jo-37/perl/ch-1.pl b/challenge-069/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..6b3f954349 --- /dev/null +++ b/challenge-069/jo-37/perl/ch-1.pl @@ -0,0 +1,48 @@ +#!/usr/bin/perl + +use Test2::V0; +use List::Util qw(reduce); + +# Cartesian/outer product of left and right array as string concatenation. +# (Reusing the code from challenge 067.) +sub prod { + my ($left, $right) = @_; + [map {my $l = $_; map $l . $_, @$right} @$left]; +} + +# generate all strobogrammatic numbers of a given length +sub all_for_length { + my $length = shift; + return (0, 1, 8) if $length == 1; + + # generate heads without leading zero + # (Again taken from challenge 067, here utilizing List::Util's + # special behaviour when called with only one element.) + my $heads = reduce {prod $a, [0, 1, 6, 8, 9]} + [1, 6, 8, 9], (1 .. $length/2 - 1); + + # complete the heads by: + # - adding middle digits (or a dummy for even lengths) + # - adding the respective tail + # - removing any middle dummies + map y/X//dr, map {$_ . substr reverse(y/69/96/r), 1} + @{prod $heads, $length % 2 == 0 ? ['X'] : [0, 1, 8]}; +} + +# Task 1: generate strobogrammatic numbers in given range +sub strobogrammatic_numbers { + my ($from, $to) = @_; + + # generate numbers for all possible lengths + # and then filter values in range + grep {$_ >= $from && $_ <= $to} + map {all_for_length $_} (length($from) .. length($to)); +} + +is [strobogrammatic_numbers(50, 100)], [69, 88, 96], 'example from challenge'; +is [strobogrammatic_numbers(0, 9999)], [0, 1, 8, 11, 69, 88, 96, 101, 111, + 181, 609, 619, 689, 808, 818, 888, 906, 916, 986, 1001, 1111, 1691, + 1881, 1961, 6009, 6119, 6699, 6889, 6969, 8008, 8118, 8698, 8888, 8968, + 9006, 9116, 9696, 9886, 9966], 'taken from wikipedia'; + +done_testing; diff --git a/challenge-069/jo-37/perl/ch-2.pl b/challenge-069/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..c5c2c72c78 --- /dev/null +++ b/challenge-069/jo-37/perl/ch-2.pl @@ -0,0 +1,177 @@ +#!/usr/bin/perl + +use Test2::V0; +use Benchmark qw(cmpthese timeit); + +# Naming conventions: +# - The finite strings S0, S1, S2,... are named as such only if the +# order is fixed +# - finite strings of order k are denoted as S(k) +# - the infinite sequence S(k) for k -> inf is denoted as S +# - an individual element from S at position i is denoted as SI(i). + +# The first version of task #2 (generating S1000) was easy to +# solve with a one-liner: +# CORE::dump(); +# When Mohammad reduced this to S30, things started to become +# interesting. Indeed, looking at this sequence is like zooming +# into the Mandelbrot set. + +# A generalized construction of S(k+l) consists of: +# taking S(k), an empty starting string and repeating 2^(l-1) times: +# - append S(k) +# - append alternating 0/1 +# - append switched reversed S(k) +# - append the next single value from S starting with SI(0), +# but omit it at the end. The required SI(i) always exists in +# the so far generated output. +# +# This allows to build S(k+l) from S(k) for k >= 0 and l > 0 +# with a single switch/reverse operation. +# +sub sn_extend { + # first arg: S(k) + # prevent copying S(k) by aliasing it to $_ + local $_; + *_ = \shift; + # second arg: l + # get loop limit from l + my $upper = int 2**(shift() - 1) - 1; + + # reversed switched S(k) + my $rsw = reverse y/01/10/r; + + my $sl; + for my $i (0 .. $upper) { + $sl .= $_ . ($i % 2) . $rsw; + $sl .= substr $sl, $i, 1 if $i < $upper; + } + $sl; +} + +# Build S(n) by repeating sn_extend() with variable parametrization. +# First arg is a subref that gives the next value for l to be used. +# Second arg is the initial loop count. +# Third arg is the desired order n. +# +# Special cases: +# - Starting with S0, then taking S(k+1) = sn_extend(S(k), 1) +# reproduces the rule as described in the task +# - S(n) = sn_extend(S0, n) is a single-stepping, element-wise +# construction of S(n) +# - Starting with S1, then taking S(2*k) = sn_extend(S(k), k) +# grows very fast and takes only a few reverse/switch operations. +# +sub sn_build (&$$) { + # first arg: subref returning next order step, with $_ set + # to the current step + my $iterate = shift; + # second arg: start order for sn_extend + local $_ = shift; + # third arg: desired order n for building S(n) + my $n = shift; + + # perform parametrized extension of S(k) -> S(k+l) + # until the next step would exceed the target order + my ($cum, $next, $s) = (0, $iterate->(), ''); + while ($cum + $_ <= $n) { + $s = sn_extend($s, $_); + $cum += $_; + $_ = $next; + $next = $iterate->(); + } + + # get missing part of S(n) if necessary + $cum == $n ? $s : sn_extend $s, $n - $cum +} + +# Benchmarks are disabled by default +SKIP: { + skip "benchmarks"; + for my $n (5, 10, 15, 20) { + # It turns out that the doubling rule outperforms + # the others by increasing magnitude and the single-steping + # iterator performs poorly. + print "\nn=$n\n"; + cmpthese(-1, { + std => sub {sn_build {1} 1, $n}, + double => sub {sn_build {2 * $_} 1, $n}, + single => sub {sn_build {$n} $n, $n}, + }); + } +} + +# get S(n) from standard rule +my @S = map {sn_build {1} 1, $_} (0 .. 5); + +is $S[5], '0010011000110110001001110011011', 'S5'; + +# shortcut for the superiour doubling rule +sub sn { + sn_build {2 * $_} 1, shift; +} + +# check alternative building rules +for (1 .. 5) { + is sn($_), $S[$_], "S$_ doubling rule"; + is sn_build(sub{$_}, $_, $_), $S[$_], "S$_ single iteration"; +} + +# Finally: task 2: Generate S30. +my $s30; +my $t30 = timeit(1, sub {$s30 = sn 30}); +print 'S30: ', $t30->timestr, "\n"; +is length($s30), 2**30 - 1, 'check size of S30'; + +# NB 1: +# When using the sn_extend procedure with l <= k, then all the +# required SI(i) are already contained within S(k). Thus it is possible +# to generate S(k+l) without accessing anything from the newly generated +# string and thereby exceeding the limit of physical internal memory. +# Here S40 can be generated from S20 within half an hour by writing +# to /dev/null. S40 has a length of 1 TB. + +sub sn_print { + my $fh = shift; + local $_; + *_ = \shift; + my $upper = 2**(shift() - 1) - 1; + + my $rsw = reverse y/01/10/r; + + for my $i (0 .. $upper) { + print $fh $_, $i % 2, $rsw; + print $fh substr($_, $i, 1) if $i < $upper; + } +} + +# As the challenge says "generate SN", but not "print" or "store", +# the following might count as a valid solution to "generate S40": +SKIP: { + skip "S40"; + open my $null, '>', '/dev/null' or die; + my $t40 = timeit(1, sub {sn_print $null, sn(20), 20}); + print 'S40: ', $t40->timestr, "\n"; + close $null; +# gives here: +# S40: 1878 wallclock secs (1862.21 usr + 10.90 sys = 1873.11 CPU) @ 0.00/s (n=1) +} + +# NB 2: +# With the single-stepping rule it is possible to create each SI(i) +# with a very simple recursive procedure. The required heap size is +# O(1) and the stack size is O(n) for S(n). But, as this procedure +# is painfully slow, it is of no practical relevance. However, +# here it is: +sub sn_i { + my $i = shift; + if ($i % 2 == 0) { + return ($i / 2) % 2; + } else { + return sn_i(($i - 1) / 2); + } +} + +is join('', map {sn_i($_)} (0 .. 2**5 - 2)), sn(5), 'S5 iterative'; + +done_testing; |