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

4 files changed, 526 insertions, 0 deletions

diff --git a/challenge-148/athanasius/perl/ch-1.pl b/challenge-148/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..347f1da112
--- /dev/null
+++ b/challenge-148/athanasius/perl/ch-1.pl
@@ -0,0 +1,143 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 148
+=========================
+
+TASK #1
+-------
+*Eban Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate all Eban Numbers <= 100.
+
+    An Eban number is a number that has no letter 'e' in it when the number is
+    spelled in English (American or British).
+
+Example
+
+ 2, 4, 6, 30, 32 are the first 5 Eban numbers.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumption
+----------
+Eban numbers are a subset of the natural numbers.
+
+Solution
+--------
+My first solution used CPAN's Math::BigInt::Named module (isn't CPAN wonder-
+ful?), but in the end I went with a home-grown approach by listing the 28 names
+required to spell the integers 1 to 100 in English.
+
+Output
+------
+The output defaults to a list of Eban numbers, as shown in the Example. For a
+more detailed output showing the English names of the Eban numbers, set the
+constant $VERBOSE to a true value.
+
+References
+----------
+https://oeis.org/A006933
+https://en.wikipedia.org/wiki/Ban_number
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $MAX_EBAN     =>     100;
+const my @SINGLE_NAMES => qw( '' one two three four five six seven eight nine
+                              ten eleven twelve thirteen fourteen fifteen
+                              sixteen seventeen eighteen nineteen );
+const my @PREFIX_NAMES => qw( '' '' twenty thirty forty fifty sixty seventy
+                              eighty ninety );
+const my $ONE_HUNDRED  =>     'one hundred';
+const my $USAGE        =>     "Usage:\n  perl $0\n";
+const my $VERBOSE      =>     0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 148, Task #1: Eban Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' .
+                         "$args\n$USAGE";
+    my @eban_nums;
+
+    for my $n (1 .. 19)
+    {
+        push @eban_nums, $n unless $SINGLE_NAMES[ $n ] =~ /e/;
+    }
+
+    for my $p (2 .. 9)
+    {
+        next if $PREFIX_NAMES[ $p ] =~ /e/;
+
+        for my $n (0 .. 9)
+        {
+            push @eban_nums, $p * 10 + $n unless $SINGLE_NAMES[ $n ] =~ /e/;
+        }
+    }
+
+    push @eban_nums, 100 unless $ONE_HUNDRED =~ /e/;
+
+    printf "There are %d Eban numbers <= %d:\n", scalar @eban_nums, $MAX_EBAN;
+
+    if ($VERBOSE)
+    {
+        printf " %3d. %s\n", $_, get_name( $_ ) for @eban_nums;
+    }
+    else
+    {
+        printf "%s\n", join ', ', @eban_nums;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub get_name
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+    my  $name;
+
+    if ($n < 20)
+    {
+        $name  = $SINGLE_NAMES[ $n ];
+    }
+    elsif ($n < 100)
+    {
+        $name  = $PREFIX_NAMES[ $n / 10 ];
+        $name .= '-' .
+                 $SINGLE_NAMES[ $n % 10 ] if $n % 10 > 0;
+    }
+    else
+    {
+        $name  = $ONE_HUNDRED;
+    }
+
+    return $name;
+}
+
+###############################################################################
diff --git a/challenge-148/athanasius/perl/ch-2.pl b/challenge-148/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..f76e058f6b
--- /dev/null
+++ b/challenge-148/athanasius/perl/ch-2.pl
@@ -0,0 +1,115 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 148
+=========================
+
+TASK #2
+-------
+*Cardano Triplets*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 5 Cardano Triplets.
+
+    A triplet of positive integers (a,b,c) is called a Cardano Triplet if it
+    satisfies the below condition.
+
+    ∛(a + b√c) + ∛(a - b√c) = 1
+
+Example
+
+ (2,1,5) is the first Cardano Triplets.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Notes
+-----
+1. As with Week 147, Task 2: Pentagon Numbers, the notion of a "first" triplet
+   is not well-defined, because triplets form a partially-ordered set. For the
+   purposes of this Task, I (arbitrarily) assume that, for triplets A = (a,b,c)
+   and X = (x,y,z), A < X iff: a < x
+                            OR a = x AND b < y
+                            OR a = x AND b = y AND c < z.
+
+2. For a discussion of the complexities surrounding the derivation of cube
+   roots in Perl, see my PerlMonks thread "How to get better exponentiation?"
+   at https://www.perlmonks.com/index.pl?node_id=11140698
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use POSIX qw( cbrt ); # See https://www.perlmonks.com/index.pl?node_id=11140700
+
+const my $EPSILON => 1e-15;
+const my $MAX_X   => 11;
+const my $MAX_Y   =>  4;
+const my $MAX_Z   => 52;
+const my $TARGET  =>  5;
+const my $USAGE   => "Usage:\n  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 148, Task #2: Cardano Triplets (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' .
+                         "$args\n$USAGE";
+
+    print "The first $TARGET Cardano Triplets:\n";
+
+    my $count = 0;
+
+    L_OUTER:
+    for my $x (1 .. $MAX_X)
+    {
+        for my $y (1 .. $MAX_Y)
+        {
+            for my $z (1 .. $MAX_Z)
+            {
+                if (is_cardano_triplet( $x, $y, $z ))
+                {
+                    printf "    (%2d, %d, %2d)\n", $x, $y, $z;
+
+                    last L_OUTER if ++$count >= $TARGET;
+                }
+            }
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub is_cardano_triplet                            # ∛(x + y√z) + ∛(x - y√z) = 1
+#------------------------------------------------------------------------------
+{
+    my ($x, $y, $z) = @_;
+
+    my $term = $y * sqrt( $z );
+    my $lhs  = cbrt( $x + $term );
+    my $rhs  = cbrt( $x - $term );
+
+    return abs( $lhs + $rhs - 1 ) < $EPSILON;
+}
+
+###############################################################################
diff --git a/challenge-148/athanasius/raku/ch-1.raku b/challenge-148/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..59935aa835
--- /dev/null
+++ b/challenge-148/athanasius/raku/ch-1.raku
@@ -0,0 +1,146 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 148
+=========================
+
+TASK #1
+-------
+*Eban Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate all Eban Numbers <= 100.
+
+    An Eban number is a number that has no letter 'e' in it when the number is
+    spelled in English (American or British).
+
+Example
+
+ 2, 4, 6, 30, 32 are the first 5 Eban numbers.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumption
+----------
+Eban numbers are a subset of the natural numbers.
+
+Solution
+--------
+The solution is based on lists of the 28 names required to spell the integers 1
+to 100 in English.
+
+Output
+------
+The output defaults to a list of Eban numbers, as shown in the Example. For a
+more detailed output showing the English names of the Eban numbers, set the
+constant $VERBOSE to True.
+
+References
+----------
+https://oeis.org/A006933
+https://en.wikipedia.org/wiki/Ban_number
+
+=end comment
+#==============================================================================
+
+subset Pos of Int where * > 0;
+
+my UInt constant $MAX-EBAN     =   100;
+my      constant @SINGLE-NAMES = < '' one two three four five six seven eight
+                                   nine ten eleven twelve thirteen fourteen
+                                   fifteen sixteen seventeen eighteen
+                                   nineteen >;
+my      constant @PREFIX-NAMES = < '' '' twenty thirty forty fifty sixty
+                                   seventy eighty ninety >;
+my Str  constant $ONE-HUNDRED  =   'one hundred';
+my Bool constant $VERBOSE      =   False;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 148, Task #1: Eban Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my Pos @eban-nums;
+
+    for 1 .. 19 -> Pos $n
+    {
+        @eban-nums.push: $n unless @SINGLE-NAMES[ $n ] ~~ /e/;
+    }
+
+    for 2 .. 9 -> Pos $p
+    {
+        next if @PREFIX-NAMES[ $p ] ~~ /e/;
+
+        for 0 .. 9 -> UInt $n
+        {
+            @eban-nums.push: $p * 10 + $n unless @SINGLE-NAMES[ $n ] ~~ /e/;
+        }
+    }
+
+    @eban-nums.push: 100 unless $ONE-HUNDRED ~~ /e/;
+
+    "There are %d Eban numbers <= %d:\n".printf: @eban-nums.elems, $MAX-EBAN;
+
+    if $VERBOSE
+    {
+        " %3d. %s\n".printf: $_, get-name( $_ ) for @eban-nums;
+    }
+    else
+    {
+        "%s\n".printf: @eban-nums.join: ', ';
+    }
+}
+
+#------------------------------------------------------------------------------
+sub get-name( Pos:D $n --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my Str $name;
+
+    if $n < 20
+    {
+        $name  = @SINGLE-NAMES[ $n ];
+    }
+    elsif $n < 100
+    {
+        $name  = @PREFIX-NAMES[ $n / 10 ];
+        $name ~= '-' ~
+                 @SINGLE-NAMES[ $n % 10 ] if $n % 10 > 0;
+    }
+    else
+    {
+        $name  = $ONE-HUNDRED;
+    }
+
+    return $name;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-148/athanasius/raku/ch-2.raku b/challenge-148/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..bfedb6fbce
--- /dev/null
+++ b/challenge-148/athanasius/raku/ch-2.raku
@@ -0,0 +1,122 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 148
+=========================
+
+TASK #2
+-------
+*Cardano Triplets*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 5 Cardano Triplets.
+
+    A triplet of positive integers (a,b,c) is called a Cardano Triplet if it
+    satisfies the below condition.
+
+    ∛(a + b√c) + ∛(a - b√c) = 1
+
+Example
+
+ (2,1,5) is the first Cardano Triplets.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Notes
+-----
+1. As with Week 147, Task 2: Pentagon Numbers, the notion of a "first" triplet
+   is not well-defined, because triplets form a partially-ordered set. For the
+   purposes of this Task, I (arbitrarily) assume that, for triplets A = (a,b,c)
+   and X = (x,y,z), A < X iff: a < x
+                            OR a = x AND b < y
+                            OR a = x AND b = y AND c < z.
+
+2. For a discussion of the complexities surrounding the derivation of cube
+   roots in Perl (and, by extension, in Raku), see my PerlMonks thread "How to
+   get better exponentiation?" at
+   https://www.perlmonks.com/index.pl?node_id=11140698
+
+=end comment
+#==============================================================================
+
+my Real constant $EPSILON = 1e-15;
+my UInt constant $MAX-X   = 11;
+my UInt constant $MAX-Y   =  4;
+my UInt constant $MAX-Z   = 52;
+my UInt constant $TARGET  =  5;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 148, Task #2: Cardano Triplets (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    "The first $TARGET Cardano Triplets:".put;
+
+    my UInt $count = 0;
+
+    L-OUTER:
+    for 1 .. $MAX-X -> UInt $x
+    {
+        for 1 .. $MAX-Y -> UInt $y
+        {
+            for 1 .. $MAX-Z -> UInt $z
+            {
+                if is-cardano-triplet( $x, $y, $z )
+                {
+                    "    (%2d, %d, %2d)\n".printf: $x, $y, $z;
+
+                    last L-OUTER if ++$count >= $TARGET;
+                }
+            }
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub is-cardano-triplet( UInt:D $x, UInt:D $y, UInt:D $z --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    # ∛(x + y√z) + ∛(x - y√z) = 1
+
+    my Real $term = $y * sqrt( $z );
+    my Real $lhs  = cube-root( $x + $term );
+    my Real $rhs  = cube-root( $x - $term );
+
+    return ($lhs + $rhs - 1).abs < $EPSILON;
+}
+
+#------------------------------------------------------------------------------
+sub cube-root( Real:D $n --> Real:D )
+#------------------------------------------------------------------------------
+{
+    return ($n.abs ** (1 / 3)) * ($n < 0 ?? -1 !! 1);
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################