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

4 files changed, 641 insertions, 0 deletions

diff --git a/challenge-149/athanasius/perl/ch-1.pl b/challenge-149/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..e91151a721
--- /dev/null
+++ b/challenge-149/athanasius/perl/ch-1.pl
@@ -0,0 +1,149 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 149
+=========================
+
+TASK #1
+-------
+*Fibonacci Digit Sum*
+
+Submitted by: Roger Bell_West
+
+Given an input $N, generate the first $N numbers for which the sum of their
+digits is a Fibonacci number.
+
+Example
+
+ f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41,
+        44]
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+The natural numbers are searched sequentially. For each number $i, the digits
+are summed and the sum is tested to discover whether it is a Fibonacci number.
+If it is, it is printed and the count is incremented. The search stops when the
+required number of solutions have been found.
+
+The is_fib() function, which determines whether a given number is a Fibonacci
+number, keeps track of known Fibonacci numbers in a hash. (A hash is used for
+ease of look-up.) Whenever the input number is greater than the largest known
+Fibonacci number, new Fibonacci numbers are generated and stored. This step
+proceeds in increments of $FIB_INC new Fibonacci numbers at a time. The value
+of the constant $FIB_INC may be adjusted according to the expected size(s) of
+the command-line input $N: for larger values of $N, larger values of $FIB_INC
+may be expected to produce more efficient results.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use feature        qw( state );
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $FIB_INC => 10;
+const my $USAGE   =>
+"Usage:
+  perl $0 <N>
+
+    <N>    Natural number: required output count\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 149, Task #1: Fibonacci Digit Sum (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $N = parse_command_line();
+
+    print "f($N) = [0";
+
+    for (my ($count, $i) = (1, 1); $count < $N; ++$i)
+    {
+        my $sum  = 0;
+           $sum += $_ for split '', $i;
+
+        if (is_fib( $sum ))
+        {
+            print ", $i";
+
+            ++$count;
+        }
+    }
+
+    print "]\n";
+}
+
+#------------------------------------------------------------------------------
+sub is_fib
+#------------------------------------------------------------------------------
+{
+    state %fib = (0 => undef, 1 => undef);
+    state $max =  1;
+    state $f2  =  0;
+    state $f1  =  1;
+
+    my ($n) = @_;
+
+    while ($max < $n)
+    {
+        for (1 .. $FIB_INC)
+        {
+            ($f2, $f1)  = ($f1, $f2 + $f1);
+
+            $fib{ $f1 } = undef;
+        }
+
+        $max += $FIB_INC;
+    }
+
+    return exists $fib{ $n };
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1 or error( "Expected 1 command line argument, found $args" );
+
+    my $N = $ARGV[ 0 ];
+
+    $N =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$N" is not a valid integer] );
+
+    $N > 0        or error( qq["$N" is not positive] );
+
+    return $N;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-149/athanasius/perl/ch-2.pl b/challenge-149/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..0d6f4125b3
--- /dev/null
+++ b/challenge-149/athanasius/perl/ch-2.pl
@@ -0,0 +1,214 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 149
+=========================
+
+TASK #2
+-------
+*Largest Square*
+
+Submitted by: Roger Bell_West
+
+Given a number base, derive the largest perfect square with no repeated digits
+and return it as a string. (For base>10, use 'A'..'Z'.)
+
+Example:
+
+    f(2)="1"
+    f(4)="3201"
+    f(10)="9814072356"
+    f(12)="B8750A649321"
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+Since a valid solution must have no repeated digits, the largest possible
+solution in base b has b digits, arranged from largest to smallest. From this
+number, the largest possible perfect square is easily found. The search then
+proceeds through successively smaller perfect squares until one is found which
+satisfies the no-repeated-digits rule: this is the desired solution.
+
+The "use bigint;" pragma is included to allow searches in bases of 16 or
+higher. If the input base is restricted to the range 1 to 15, commenting out
+this pragma will increase the speed of the search.
+
+As base sizes increase, computation times quickly become prohibitively long.
+The following table of solutions shows the rapid increase in the size of the
+search space as bases increase in size:
+
+     --------------------------------------------------------------------
+         n                  Base n                    Decimal (from [1])
+     --------------------------------------------------------------------
+      f( 1) =                    1 =                                   1
+      f( 2) =                    1 =                                   1
+      f( 3) =                    1 =                                   1
+      f( 4) =                 3201 =                                 225
+      f( 5) =                 4301 =                                 576
+      f( 6) =               452013 =                              38,025
+      f( 7) =              6250341 =                             751,689
+      f( 8) =             47302651 =                          10,323,369
+      f( 9) =            823146570 =                         355,624,164
+      f(10) =           9814072356 =                       9,814,072,356
+      f(11) =          A8701245369 =                     279,740,499,025
+      f(12) =         B8750A649321 =                   8,706,730,814,089
+      f(13) =         CBA504216873 =                  23,132,511,879,129
+      f(14) =       DC71B30685A924 =              11,027,486,960,232,964
+      f(15) =      EDAC93B24658701 =             435,408,094,460,869,201
+      f(16) =     FED5B39A42706C81 =          18,362,780,530,794,065,025
+      f(17) =     GFED5A31C6B79802 =          48,470,866,291,337,805,316
+      f(18) =    HGF80ADC53712EB64 =      39,207,739,576,969,100,808,801
+      f(19) =  IHGFD3408C6E715A2B9 =   1,972,312,183,619,434,816,475,625
+      f(20) = JIHG03DAC457BFE96281 = 104,566,626,183,621,314,286,288,961
+     --------------------------------------------------------------------
+
+It is noteworthy that even the OEIS [1] does not provide solutions for bases
+greater than 20.
+
+Output Display
+--------------
+As a search can take a considerable amount of time, a progressive output is
+provided showing the current number being tested -- this "counts down" to the
+solution. This display may be turned off by settng the constant VERBOSE to a
+false value.
+
+Reference
+---------
+[1] OEIS: A287298  a(n) is the largest square with distinct digits in base n.
+    https://oeis.org/A287298
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use bigint;
+use Const::Fast;
+use Math::BaseCalc;
+use Regexp::Common qw( number );
+
+use constant VERBOSE => 1;
+
+const my @CHARS    => (0 .. 9, 'A' .. 'Z');
+const my $MAX_BASE => 36;
+const my $BLANK    => ' ' x ($MAX_BASE + 10);
+const my $USAGE    =>
+"Usage:
+  perl $0 <base>
+
+    <base>    Number base: integer between 1 and 36\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 149, Task #2: Largest Square (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $base = parse_command_line();
+    my $squ  = 1;
+
+    if ($base > 1)
+    {
+        my $max = get_max_without_reps( $base );
+        my $cnv = Math::BaseCalc->new(digits => [ @CHARS[ 0 .. $base - 1 ] ]);
+
+        # Note: The more natural "for my $root (reverse 1 .. int sqrt $max)"
+        #       consumes too much memory for large bases
+
+        for (my $root = int sqrt $max; $root > 0; --$root)
+        {
+            $squ = $cnv->to_base($root * $root);
+
+            print   qq[\r$BLANK\rTrying: "$squ"] if VERBOSE;
+
+            if (has_no_reps( $squ ))
+            {
+                print "\r$BLANK\r"               if VERBOSE;
+                last;
+            }
+        }
+    }
+
+    print qq[f($base) = "$squ"\n];
+}
+
+#------------------------------------------------------------------------------
+sub has_no_reps
+#------------------------------------------------------------------------------
+{
+    my ($n)     = @_;
+    my  @digits = split //, $n;
+    my  %digits;
+
+    for my $d (@digits)
+    {
+        ++$digits{ $d };
+
+        return 0 if $digits{ $d } > 1;
+    }
+
+    return 1;
+}
+
+#------------------------------------------------------------------------------
+sub get_max_without_reps
+#------------------------------------------------------------------------------
+{
+    my ($base) = @_;
+    my  $max   = 0;
+
+    for (my $i = 1; $i <= $base - 1; ++$i)
+    {
+        $max += $i * ($base ** $i);
+    }
+
+    return $max;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1 or error( "Expected 1 command line argument, found $args" );
+
+    my $base = $ARGV[ 0 ];
+
+    $base =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$base" is not a valid integer] );
+
+    $base >= 1    or error( qq[Base "$base" is too small] );
+
+    $base <= $MAX_BASE
+                  or error( qq[Base "$base" is too large] );
+
+    return $base;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-149/athanasius/raku/ch-1.raku b/challenge-149/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..ea536158c5
--- /dev/null
+++ b/challenge-149/athanasius/raku/ch-1.raku
@@ -0,0 +1,122 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 149
+=========================
+
+TASK #1
+-------
+*Fibonacci Digit Sum*
+
+Submitted by: Roger Bell_West
+
+Given an input $N, generate the first $N numbers for which the sum of their
+digits is a Fibonacci number.
+
+Example
+
+ f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41,
+        44]
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+The natural numbers are searched sequentially. For each number $i, the digits
+are summed and the sum is tested to discover whether it is a Fibonacci number.
+If it is, it is printed and the count is incremented. The search stops when the
+required number of solutions have been found.
+
+The is-fib() function, which determines whether a given number is a Fibonacci
+number, keeps track of known Fibonacci numbers in a hash. (A hash is used for
+ease of look-up.) Whenever the input number is greater than the largest known
+Fibonacci number, new Fibonacci numbers are generated and stored. This step
+proceeds in increments of $FIB-INC new Fibonacci numbers at a time. The value
+of the constant $FIB-INC may be adjusted according to the expected size(s) of
+the command-line input $N: for larger values of $N, larger values of $FIB-INC
+may be expected to produce more efficient results.
+
+=end comment
+#==============================================================================
+
+my UInt constant $FIB-INC = 10;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 149, Task #1: Fibonacci Digit Sum (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D $N where { $N > 0 }         #= Natural number: required output count
+)
+#==============================================================================
+{
+    "f($N) = [0".print;
+
+    my UInt $count = 1;
+
+    for 1 .. Inf -> UInt $i
+    {
+        last if $count >= $N;
+
+        my UInt $sum = [+] $i.split: '', :skip-empty;
+
+        if is-fib( $sum )
+        {
+            ", $i".print;
+
+            ++$count;
+        }
+    }
+
+    ']'.put;
+}
+
+#------------------------------------------------------------------------------
+sub is-fib( UInt:D $n --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    state UInt  %fib = 0 => Nil, 1 => Nil;
+    state UInt ($max, $f2, $f1) = 1, 0, 1;
+
+    while $max < $n
+    {
+        for 1 .. $FIB-INC
+        {
+            ($f2, $f1)  = $f1, $f2 + $f1;
+
+            %fib{ $f1 } = Nil;
+        }
+
+        $max += $FIB-INC;
+    }
+
+    return %fib{ $n }:exists;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-149/athanasius/raku/ch-2.raku b/challenge-149/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..1fa31d6d80
--- /dev/null
+++ b/challenge-149/athanasius/raku/ch-2.raku
@@ -0,0 +1,156 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 149
+=========================
+
+TASK #2
+-------
+*Largest Square*
+
+Submitted by: Roger Bell_West
+
+Given a number base, derive the largest perfect square with no repeated digits
+and return it as a string. (For base>10, use ‘A’..‘Z’.)
+
+Example:
+
+    f(2)="1"
+    f(4)="3201"
+    f(10)="9814072356"
+    f(12)="B8750A649321"
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+Since a valid solution must have no repeated digits, the largest possible
+solution in base b has b digits, arranged from largest to smallest. From this
+number, the largest possible perfect square is easily found. The search then
+proceeds through successively smaller perfect squares until one is found which
+satisfies the no-repeated-digits rule: this is the desired solution.
+
+As base sizes increase, computation times quickly become prohibitively long.
+The following table of solutions shows the rapid increase in the size of the
+search space as bases increase in size:
+
+     --------------------------------------------------------------------
+         n                  Base n                    Decimal (from [1])
+     --------------------------------------------------------------------
+      f( 1) =                    1 =                                   1
+      f( 2) =                    1 =                                   1
+      f( 3) =                    1 =                                   1
+      f( 4) =                 3201 =                                 225
+      f( 5) =                 4301 =                                 576
+      f( 6) =               452013 =                              38,025
+      f( 7) =              6250341 =                             751,689
+      f( 8) =             47302651 =                          10,323,369
+      f( 9) =            823146570 =                         355,624,164
+      f(10) =           9814072356 =                       9,814,072,356
+      f(11) =          A8701245369 =                     279,740,499,025
+      f(12) =         B8750A649321 =                   8,706,730,814,089
+      f(13) =         CBA504216873 =                  23,132,511,879,129
+      f(14) =       DC71B30685A924 =              11,027,486,960,232,964
+      f(15) =      EDAC93B24658701 =             435,408,094,460,869,201
+      f(16) =     FED5B39A42706C81 =          18,362,780,530,794,065,025
+      f(17) =     GFED5A31C6B79802 =          48,470,866,291,337,805,316
+      f(18) =    HGF80ADC53712EB64 =      39,207,739,576,969,100,808,801
+      f(19) =  IHGFD3408C6E715A2B9 =   1,972,312,183,619,434,816,475,625
+      f(20) = JIHG03DAC457BFE96281 = 104,566,626,183,621,314,286,288,961
+     --------------------------------------------------------------------
+
+It is noteworthy that even the OEIS [1] does not provide solutions for bases
+greater than 20.
+
+Output Display
+--------------
+As a search can take a considerable amount of time, a progressive output is
+provided showing the current number being tested -- this "counts down" to the
+solution. This display may be turned off by settng the constant $VERBOSE to
+False.
+
+Reference
+---------
+[1] OEIS: A287298  a(n) is the largest square with distinct digits in base n.
+    https://oeis.org/A287298
+
+=end comment
+#==============================================================================
+
+my UInt constant $MAX-BASE = 36;
+my Str  constant $BLANK    = ' ' x ($MAX-BASE + 10);
+my Bool constant $VERBOSE  = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 149, Task #2: Largest Square (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    #| Number base: integer between 1 and 36
+
+    UInt:D $base where 0 < * <= $MAX-BASE
+)
+#==============================================================================
+{
+    my Str  $squ = '1';
+    my UInt $max = [+] (1 .. $base - 1).map: { $_ * ($base ** $_) };
+
+    if $base > 1
+    {
+        for $max.sqrt.floor ... 1 -> UInt $r
+        {
+            $squ = $r².base( $base );
+
+            qq[\r$BLANK\rTrying: "$squ"].print if $VERBOSE;
+
+            if has-no-reps( $squ )
+            {
+                "\r$BLANK\r".print             if $VERBOSE;
+                last;
+            }
+        }
+    }
+
+    qq[f(%d) = "%s"\n].printf: $base, $squ;
+}
+
+#------------------------------------------------------------------------------
+sub has-no-reps( Str:D $n --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    my UInt %digits;
+
+    for $n.split: '', :skip-empty
+    {
+        return False if ++%digits{ $_ } > 1;
+    }
+
+    return True;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################