From 3a960f97a9f0d123af243ad5e734f521081d7b36 Mon Sep 17 00:00:00 2001
From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com>
Date: Mon, 13 Jul 2020 17:39:04 +0200
Subject: solution for task 2

---
 challenge-069/jo-37/perl/ch-2.pl | 177 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 177 insertions(+)
 create mode 100755 challenge-069/jo-37/perl/ch-2.pl

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;
-- 
cgit 


From 7881013f7ca07132bd6fbbf43de7f7d4e0a6656a Mon Sep 17 00:00:00 2001
From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com>
Date: Wed, 15 Jul 2020 14:40:30 +0200
Subject: solution for task 1

---
 challenge-069/jo-37/perl/ch-1.pl | 48 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100755 challenge-069/jo-37/perl/ch-1.pl

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;
-- 
cgit