Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #069

challenge-069/athanasius/perl/ch-1.pl

@@ -0,0 +1,188 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 069
+=========================
+
+Task #1
+-------
+*Strobogrammatic Number*
+
+*Submitted by:* Mohammad S Anwar
+
+A strobogrammatic number is a number that looks the same when looked at upside
+down.
+
+You are given two positive numbers $A and $B such that 1 <= $A <= $B <= 10^15.
+
+Write a script to print all strobogrammatic numbers between the given two
+numbers.
+
+*Example*
+
+ Input: $A = 50, $B = 100
+     Output: 69, 88, 96
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#*******************************************************************************
+=comment
+
+"When written using standard characters (ASCII), the numbers, 0, 1, 8 are sym-
+metrical around the horizontal axis, and 6 and 9 are the same as each other when
+rotated 180 degrees. In such a system, the first few strobogrammatic numbers
+are:
+
+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, ... (sequence A000787 in the
+OEIS)"
+
+-- from https://en.wikipedia.org/wiki/Strobogrammatic_number
+
+See also https://oeis.org/A000787 and
+         https://oeis.org/A000787/b000787.txt
+
+=cut
+#*******************************************************************************
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $MAX   => 1e15;
+const my $USAGE =>
+"Usage:
+  perl $0 <A> <B>
+
+    <A>    Lower bound (UInt: 1 <= A <= 10^15)
+    <B>    Upper bound (UInt: A <= B <= 10^15)\n";
+
+const my %MIDDLE => (0 => 1, 1 => 8, 8 => undef);
+const my %OUTER  => (1 => 6, 6 => 8, 8 => 9, 9 => undef);
+const my %INNER  => (0 => 1), %OUTER;
+const my %PAIRS  => (0 => 0, 1 => 1, 6 => 9, 8 => 8, 9 => 6);
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 069, Task #1: Strobogrammatic Number (Perl)\n\n";
+
+    my ($A, $B) = parse_command_line();
+
+    print "Input:  A = $A, B = $B\nOutput: ";
+
+    if ((my $number = first_strobogrammatic_number($A)) <= $B)
+    {
+        print $number;
+        $number = next_strobogrammatic_number($number);
+
+        while ($number <= $B)
+        {
+            print ", $number";
+            $number = next_strobogrammatic_number($number);
+        }
+    }
+
+    print "\n";
+}
+
+#-------------------------------------------------------------------------------
+sub first_strobogrammatic_number
+#-------------------------------------------------------------------------------
+{
+    my ($min)  =  @_;
+    my  $size  =  length $min;
+    my  $first = ($size == 1) ? 1 : '1' . '0' x ($size - 2) . '1';
+
+        $first =  next_strobogrammatic_number($first) while $first < $min;
+
+    return $first;
+}
+
+#-------------------------------------------------------------------------------
+sub next_strobogrammatic_number
+#-------------------------------------------------------------------------------
+{
+    my ($number) = @_;
+    my  @digits  = split //, $number;
+    my  $size    = scalar @digits;
+    my  $middle  = int($size / 2);
+
+    return $MIDDLE{ $digits[0] } // 11 if $size == 1;     # single digit number
+
+    if ($size % 2 == 1)                                   # odd number of digits
+    {
+        if (defined(my $next = $MIDDLE{ $digits[$middle] }))
+        {
+            $digits[$middle] = $next;
+
+            return join('', @digits);
+        }
+
+        $digits[$middle] = 0;
+    }
+
+    for my $i (reverse 1 .. --$middle)
+    {
+        my $j = $size - $i - 1;
+
+        if (defined(my $next = $INNER{ $digits[$i] }))
+        {
+            $digits[$i] = $next;
+            $digits[$j] = $PAIRS{ $next };
+
+            return join('', @digits);
+        }
+
+        $digits[$i] = $digits[$j] = 0;
+    }
+
+    if (defined(my $next = $OUTER{ $digits[0] }))
+    {
+        $digits[ 0] = $next;
+        $digits[-1] = $PAIRS{ $next };
+
+        return join('', @digits);
+    }
+
+    $digits[ 0] = 0;
+    $digits[-1] = 1;
+    unshift @digits, 1;
+
+    return join('', @digits);
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    scalar @ARGV == 2                            or die $USAGE;
+
+    my ($A, $B) = @ARGV;
+
+    /\A$RE{num}{int}\z/ && 1 <= $_ && $_ <= $MAX or die $USAGE for $A, $B;
+
+    $A <= $B                                     or die $USAGE;
+
+    return ($A, $B);
+}
+
+################################################################################

challenge-069/athanasius/perl/ch-2.pl

@@ -0,0 +1,139 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 069
+=========================
+
+Task #2
+-------
+*0/1 String*
+
+*Submitted by:* Mohammad S Anwar
+
+A 0/1 string is a string in which every character is either 0 or 1.
+
+Write a script to perform switch and reverse to generate S30 as described
+below:
+
+  switch:
+
+  Every 0 becomes 1 and every 1 becomes 0. For example, "101" becomes "010".
+
+  reverse:
+
+  The string is reversed. For example, "001" becomes "100".
+
+[Redacted: To generate S1000 string, please follow the rule as below:]
+
+*UPDATE (2020-07-13 17:00:00):*
+
+It was brought to my notice that generating S1000 string would be nearly
+impossible. So I have decided to lower it down to S30. Please follow the rule as
+below:
+
+  S0 = ""
+  S1 = "0"
+  S2 = "001"
+  S3 = "0010011"
+  ...
+  SN = SN-1 + "0" + switch(reverse(SN-1))
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#*******************************************************************************
+=comment
+
+length(SN) = (length(SN-1) * 2) + 1  →  length(SN) = 2^N - 1
+
+So  length(S1000) = 2^1000 - 1 ≅ 1.07 * 10^301 (!)
+and length(S30)   = 2^30   - 1 = 1,073,741,823
+
+Note that 1 GiB is 2^30 bytes. So S30 will occupy at least 1 GB of RAM and take
+over a billion characters to display! My command prompt terminal is currently
+configured to display 45 lines of 80 characters each; so one screen can display
+3600 characters. For me to view S30 screen-by-screen I would need to page down
+298,262 times!
+
+I have below set $MAX_S to 11, because N = 11 gives the largest value of SN to
+fit on a single screen of my terminal. For the record, here it is:
+
+S11 = 00100110001101100010011100110110001001100011011100100111001101100010011000
+11011000100111001101110010011000110111001001110011011000100110001101100010011100
+11011000100110001101110010011100110111001001100011011000100111001101110010011000
+11011100100111001101100010011000110110001001110011011000100110001101110010011100
+11011000100110001101100010011100110111001001100011011100100111001101110010011000
+11011000100111001101100010011000110111001001110011011100100110001101100010011100
+11011100100110001101110010011100110110001001100011011000100111001101100010011000
+11011100100111001101100010011000110110001001110011011100100110001101110010011100
+11011000100110001101100010011100110110001001100011011100100111001101110010011000
+11011000100111001101110010011000110111001001110011011100100110001101100010011100
+11011000100110001101110010011100110110001001100011011000100111001101110010011000
+11011100100111001101110010011000110110001001110011011000100110001101110010011100
+11011100100110001101100010011100110111001001100011011100100111001101100010011000
+11011000100111001101100010011000110111001001110011011000100110001101100010011100
+11011100100110001101110010011100110110001001100011011000100111001101100010011000
+11011100100111001101110010011000110110001001110011011100100110001101110010011100
+11011000100110001101100010011100110110001001100011011100100111001101100010011000
+11011000100111001101110010011000110111001001110011011100100110001101100010011100
+11011000100110001101110010011100110111001001100011011000100111001101110010011000
+11011100100111001101110010011000110110001001110011011000100110001101110010011100
+11011000100110001101100010011100110111001001100011011100100111001101100010011000
+11011000100111001101100010011000110111001001110011011100100110001101100010011100
+11011100100110001101110010011100110111001001100011011000100111001101100010011000
+11011100100111001101100010011000110110001001110011011100100110001101110010011100
+11011100100110001101100010011100110110001001100011011100100111001101110010011000
+11011000100111001101110010011000110111001001110011011
+
+=cut
+#*******************************************************************************
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $MAX_S => 11;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 069, Task #2: 0/1 String (Perl)\n\n";
+
+    my $s = '';
+
+    # The call to switch() puts "reverse $s" into list context, which makes re-
+    # verse treat $s as a list of 1 element; when reversed, this "list" is, of
+    # course, unchanged. Addition of the explicit call to "scalar" forces re-
+    # verse to treat $s as a scalar, i.e., as a string, with the desired result
+    # that the string's _characters_ are reversed.
+
+    $s .= '0' . switch(scalar reverse $s) for 1 .. $MAX_S;
+
+    print "S$MAX_S = $s\n";
+}
+
+#-------------------------------------------------------------------------------
+sub switch
+#-------------------------------------------------------------------------------
+{
+    my ($string) = @_;
+
+    return $string =~ tr/01/10/r;
+}
+
+################################################################################