Merge pull request #6284 from PerlMonk-Athanasius/branch-for-challenge-169

Perl & Raku solutions to Tasks 1 & 2 for Week 169

4 files changed, 685 insertions, 0 deletions

diff --git a/challenge-169/athanasius/perl/ch-1.pl b/challenge-169/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..af339c879f
--- /dev/null
+++ b/challenge-169/athanasius/perl/ch-1.pl
@@ -0,0 +1,168 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 169
+=========================
+
+TASK #1
+-------
+*Brilliant Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 Brilliant Numbers.
+
+    Brilliant numbers are numbers with two prime factors of the same length.
+
+The number should have _exactly_ two prime factors, i.e. it’s the product of
+two primes of the same length.
+
+For example,
+
+  24287 = 149 x 163
+  24289 = 107 x 227
+
+  Therefore 24287 and 24289 are 2-brilliant numbers.
+  These two brilliant numbers happen to be consecutive as there are no even
+  brilliant numbers greater than 14.
+
+Output
+
+  4, 6, 9, 10, 14, 15, 21, 25, 35, 49, 121, 143, 169, 187, 209, 221, 247, 253,
+  289, 299
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Note
+----
+If an n-brilliant number is defined as a product of n primes of the same length
+(i.e., of the same number of digits when represented in base 10), then this
+Task is a search for 2-brilliant numbers. [2]
+
+Algorithm
+---------
+The number of brilliant numbers required is specified in the constant $TARGET.
+Although the number is given as 20 in the Task description, I have designed the
+solution to accommodate larger numbers by making the generation of primes open-
+ended.
+
+Prime numbers are generated by get_primes(), which receives as input the number
+of digits required, and returns a sorted list of all the primes with that num-
+ber of digits. get_primes() uses a sieve of Eratosthenes, which on subsequent
+calls is extended as needed.
+
+The algorithm *constructs* brilliant numbers by producing all possible combina-
+tions of prime numbers of a given number of digits. As the brilliant numbers
+are produced out-of-order, they must be sorted to produce the required solu-
+tion. However, note that when the number of digits per prime number increases,
+the smallest new brilliant number is necessarily larger than the previously-
+largest one; e.g., 101² > 97². Therefore, when a given number of prime digits
+produces a total number of brilliant numbers greater than or equal to $TARGET,
+no further generation of brilliant numbers is needed.
+
+Reference
+---------
+[1] "A078972  Brilliant numbers: semiprimes (products of two primes, A001358)
+     whose prime factors have the same number of decimal digits.", OEIS,
+     https://oeis.org/A078972
+[2]  Dario Alpern, "Brilliant numbers",
+     https://www.alpertron.com.ar/BRILLIANT.HTM
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use feature         qw( state );
+use Const::Fast;
+use List::MoreUtils qw( after_incl );
+
+const my $TARGET =>  20;
+const my $USAGE  => "Usage:\n  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 169, Task #1: Brilliant Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' .
+                         "$args\n$USAGE";
+
+    my @brilliant;
+
+    for (my $digits = 1; scalar @brilliant < $TARGET; ++$digits)
+    {
+        my $primes = get_primes( $digits );
+
+        for my $p (@$primes)
+        {
+            for my $q (after_incl { $_ == $p } @$primes)
+            {
+                push @brilliant, $p * $q;
+            }
+        }
+    }
+
+    @brilliant = sort { $a <=> $b } @brilliant;
+
+    printf "The first %d brilliant numbers:\n%s\n",
+            $TARGET, join ', ', @brilliant[ 0 .. $TARGET - 1 ];
+}
+
+#------------------------------------------------------------------------------
+sub get_primes                               # Extensible sieve of Eratosthenes
+#------------------------------------------------------------------------------
+{
+    my   ($digits)  = @_;
+    my    $max_idx  = 10 ** $digits - 1;
+    state @sieve    = ((0, 0), (1) x ($max_idx - 1));
+    my    $orig_end = $#sieve;
+    state $first    = 1;
+
+    if ($first || $max_idx > $orig_end)
+    {
+        push @sieve, (1) x ($max_idx - $orig_end) if !$first;    # Extend sieve
+
+        for my $i (0 .. int sqrt $max_idx)
+        {
+            if ($sieve[ $i ])                                    # Prime
+            {
+                my $start = $first ? 2 : int( ($orig_end + 1) / $i );
+
+                for my $j ($start .. int( $max_idx / $i ))
+                {
+                    $sieve[ $i * $j ] = 0;                       # Composite
+                }
+            }
+        }
+
+        $first = 0;
+    }
+
+    # @range contains all integers of the required number of digits:
+    # e.g., if $digits = 2 then @range = 10 .. 99
+
+    my @range = 10 ** ($digits - 1) .. $max_idx;
+
+    return [ grep { $sieve[ $_ ] } @range ];                  # Apply the sieve
+}
+
+###############################################################################
diff --git a/challenge-169/athanasius/perl/ch-2.pl b/challenge-169/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..babe969342
--- /dev/null
+++ b/challenge-169/athanasius/perl/ch-2.pl
@@ -0,0 +1,132 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 169
+=========================
+
+TASK #2
+-------
+*Achilles Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 Achilles Numbers. Please checkout
+[ https://en.wikipedia.org/wiki/Achilles_number |wikipedia] for more informa-
+tion.
+
+    An Achilles number is a number that is powerful but imperfect. Named after
+    Achilles, a hero of the Trojan war, who was also powerful but imperfect.
+
+    A positive integer n is a powerful number if, for every prime factor p of
+    n, p^2 is also a divisor.
+
+    A number is a perfect power if it has any integer roots (square root, cube
+    root, etc.).
+
+For example 36 factors to (2, 2, 3, 3) - every prime factor (2, 3) also has its
+square as a divisor (4, 9). But 36 has an integer square root, 6, so the number
+is a perfect power.
+
+But 72 factors to (2, 2, 2, 3, 3); it similarly has 4 and 9 as divisors, but it
+has no integer roots. This is an Achilles number.
+
+Output
+
+  72, 108,  200,  288,  392,  432,  500,  648,  675,  800,  864, 968, 972,
+  1125, 1152, 1323, 1352, 1372, 1568, 1800
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+Note that the given definition of an imperfect number, viz., "has no integer
+roots", can also be expressed in terms of the number's prime factors: a number
+is imperfect if and only if the highest common factor of the exponents of its
+prime factors is 1. [1]
+
+Achilles numbers are identified as follows:
+
+    Beginning with the number 2, successive integers are tested as follows:
+
+        (1) Are they powerful? A number is powerful if and only if all of the
+            exponents of its prime factors are greater than 1.
+        (2) Are they imperfect? (see above).
+
+    Numbers meeting both criteria are recorded as Achilles numbers.
+
+Implementation
+--------------
+All the hard work is delegated to routines factor_exp() and gcd() in the CPAN
+module Math::Prime::Util:
+
+    factor_exp( $n ) returns an array of prime-factor/exponent pairs; e.g.,
+        factor_exp( 360 ) = ([2, 3], [3, 2], [5, 1]) meaning 360 = 2³ × 3² × 5¹
+
+    gcd( $p, $q ) returns the greatest common divisor (aka the highest common
+        factor) of $p and $q; e.g., gcd( 30, 72 ) = 6
+
+References
+----------
+[1] "A052486  Achilles numbers - powerful but imperfect...", OEIS,
+     https://oeis.org/A052486
+[2] "Achilles number", Wikipedia, https://en.wikipedia.org/wiki/Achilles_number
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use List::Util        qw( all );
+use Math::Prime::Util qw( factor_exp gcd );
+
+const my $TARGET => 20;
+const my $USAGE  => "Usage:\n  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 169, Task #2: Achilles Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' .
+                         "$args\n$USAGE";
+
+    my @achilles;
+
+    for (my $n = 2; scalar @achilles < $TARGET; ++$n)
+    {
+        my @fact_exps   = factor_exp( $n );
+        my @exponents   = map { $_->[ 1 ] } @fact_exps;
+        my $is_powerful = all { $_ >= 2   } @exponents;
+
+        if ($is_powerful)
+        {
+            my $is_perfect = gcd( @exponents ) == 1;
+
+            push @achilles, $n if $is_perfect;
+        }
+    }
+
+    printf "The first %d Achilles numbers:\n%s\n",
+            $TARGET, join ', ', @achilles;
+}
+
+###############################################################################
diff --git a/challenge-169/athanasius/raku/ch-1.raku b/challenge-169/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..b78d5dfcdf
--- /dev/null
+++ b/challenge-169/athanasius/raku/ch-1.raku
@@ -0,0 +1,168 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 169
+=========================
+
+TASK #1
+-------
+*Brilliant Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 Brilliant Numbers.
+
+    Brilliant numbers are numbers with two prime factors of the same length.
+
+The number should have _exactly_ two prime factors, i.e. it’s the product of
+two primes of the same length.
+
+For example,
+
+  24287 = 149 x 163
+  24289 = 107 x 227
+
+  Therefore 24287 and 24289 are 2-brilliant numbers.
+  These two brilliant numbers happen to be consecutive as there are no even
+  brilliant numbers greater than 14.
+
+Output
+
+  4, 6, 9, 10, 14, 15, 21, 25, 35, 49, 121, 143, 169, 187, 209, 221, 247, 253,
+  289, 299
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Note
+----
+If an n-brilliant number is defined as a product of n primes of the same length
+(i.e., of the same number of digits when represented in base 10), then this
+Task is a search for 2-brilliant numbers. [2]
+
+Algorithm
+---------
+The number of brilliant numbers required is specified in the constant $TARGET.
+Although the number is given as 20 in the Task description, I have designed the
+solution to accommodate larger numbers by making the generation of primes open-
+ended.
+
+Prime numbers are generated by get-primes(), which receives as input the number
+of digits required, and returns a sorted list of all the primes with that num-
+ber of digits. get-primes() uses a sieve of Eratosthenes, which on subsequent
+calls is extended as needed.
+
+The algorithm *constructs* brilliant numbers by producing all possible combina-
+tions of prime numbers of a given number of digits. As the brilliant numbers
+are produced out-of-order, they must be sorted to produce the required solu-
+tion. However, note that when the number of digits per prime number increases,
+the smallest new brilliant number is necessarily larger than the previously-
+largest one; e.g., 101² > 97². Therefore, when a given number of prime digits
+produces a total number of brilliant numbers greater than or equal to $TARGET,
+no further generation of brilliant numbers is needed.
+
+Reference
+---------
+[1] "A078972  Brilliant numbers: semiprimes (products of two primes, A001358)
+     whose prime factors have the same number of decimal digits.", OEIS,
+     https://oeis.org/A078972
+[2]  Dario Alpern, "Brilliant numbers",
+     https://www.alpertron.com.ar/BRILLIANT.HTM
+
+=end comment
+#==============================================================================
+
+my UInt constant $TARGET = 20;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 169, Task #1: Brilliant Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my UInt %brilliant{UInt};
+
+    loop (my UInt $digits = 1; %brilliant.keys.elems < $TARGET; ++$digits)
+    {
+        my UInt @primes = get-primes( $digits );
+
+        for @primes -> UInt $p
+        {
+            for @primes -> UInt $q
+            {
+                ++%brilliant{ $p * $q };
+            }
+        }
+    }
+
+    my UInt @brilliant = %brilliant.keys.sort;
+
+    "The first %d brilliant numbers:\n%s\n".printf:
+        $TARGET, @brilliant[ 0 .. $TARGET - 1 ].join: ', ';
+}
+
+#------------------------------------------------------------------------------
+# Extensible sieve of Eratosthenes
+#
+sub get-primes( UInt:D $digits --> Seq:D[UInt:D] )
+#------------------------------------------------------------------------------
+{
+    my    UInt $max-idx  = 10 ** $digits - 1;
+    state UInt @sieve    = False, False, |(1 xx ($max-idx - 1));
+    my    UInt $orig-end = @sieve.end;
+    state Bool $first    = True;
+
+    if $first || $max-idx > $orig-end
+    {
+        @sieve.push: |(1 xx ($max-idx - $orig-end)) if !$first;  # Extend sieve
+
+        for 0 .. $max-idx.sqrt.Int -> UInt $i
+        {
+            if @sieve[ $i ]                                      # Prime
+            {
+                my UInt $start = $first ?? 2 !! (($orig-end + 1) / $i).floor;
+
+                for $start .. ($max-idx / $i).floor -> UInt $j
+                {
+                    @sieve[ $i * $j ] = 0;                       # Composite
+                }
+            }
+        }
+
+        $first = False;
+    }
+
+    # @range contains all integers of the required number of digits:
+    # e.g., if $digits = 2 then @range = 10 .. 99
+
+    my UInt @range = 10 ** ($digits - 1) .. $max-idx;
+
+    return @range.grep: { @sieve[ $_ ] };                     # Apply the sieve
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################
diff --git a/challenge-169/athanasius/raku/ch-2.raku b/challenge-169/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..9c7ccdf455
--- /dev/null
+++ b/challenge-169/athanasius/raku/ch-2.raku
@@ -0,0 +1,217 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 169
+=========================
+
+TASK #2
+-------
+*Achilles Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 Achilles Numbers. Please checkout
+[ https://en.wikipedia.org/wiki/Achilles_number |wikipedia] for more informa-
+tion.
+
+    An Achilles number is a number that is powerful but imperfect. Named after
+    Achilles, a hero of the Trojan war, who was also powerful but imperfect.
+
+    A positive integer n is a powerful number if, for every prime factor p of
+    n, p^2 is also a divisor.
+
+    A number is a perfect power if it has any integer roots (square root, cube
+    root, etc.).
+
+For example 36 factors to (2, 2, 3, 3) - every prime factor (2, 3) also has its
+square as a divisor (4, 9). But 36 has an integer square root, 6, so the number
+is a perfect power.
+
+But 72 factors to (2, 2, 2, 3, 3); it similarly has 4 and 9 as divisors, but it
+has no integer roots. This is an Achilles number.
+
+Output
+
+  72, 108,  200,  288,  392,  432,  500,  648,  675,  800,  864, 968, 972,
+  1125, 1152, 1323, 1352, 1372, 1568, 1800
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+Note that the given definition of an imperfect number, viz., "has no integer
+roots", can also be expressed in terms of the number's prime factors: a number
+is imperfect if and only if the highest common factor of the exponents of its
+prime factors is 1. [1]
+
+Achilles numbers are identified as follows:
+
+    Beginning with the number 2, successive integers are tested as follows:
+
+        (1) Are they powerful? A number is powerful if and only if all of the
+            exponents of its prime factors are greater than 1.
+        (2) Are they imperfect? (see above).
+
+    Numbers meeting both criteria are recorded as Achilles numbers.
+
+Implementation
+--------------
+Routine prime-factors() is copied from the Raku solution to Week 168, Task 2.
+Routine prime-factor-pairs() transforms the output of prime-factors() into an
+array of prime-factor/exponent pairs; e.g., for $n = 360, the prime factors
+[2, 2, 2, 3, 3, 5] become [[2, 3], [3, 2], [5, 1]].
+
+Routine gcd() uses the Euclidean algorithm [3] to find the greatest common
+divisor of the first two input numbers, then repeats the algorithm with the gcd
+just found and the next input number, and so on until the input is exhausted.
+
+References
+----------
+[1] "Achilles numbers - powerful but imperfect...", OEIS,
+     https://oeis.org/A052486
+[2] "Achilles number", Wikipedia, https://en.wikipedia.org/wiki/Achilles_number
+[3] "Greatest common divisor", Wikipedia,
+     https://en.wikipedia.org/wiki/Greatest_common_divisor
+
+=end comment
+#==============================================================================
+
+my UInt constant $TARGET = 20;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 169, Task #2: Achilles Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my UInt @achilles;
+
+    loop (my UInt $n = 2; +@achilles < $TARGET; ++$n)
+    {
+        my Array[UInt] @factor-pairs =  prime-factor-pairs( $n );
+        my UInt        @exponents    =  @factor-pairs.map: { $_[ 1 ] };
+        my Bool        $is-powerful  = (@exponents.all >= 2).so;
+
+        if $is-powerful
+        {
+            my Bool $is-perfect = gcd( @exponents ) == 1;
+
+            @achilles.push: $n if $is-perfect;
+        }
+    }
+
+    "The first %d Achilles numbers:\n%s\n".printf:
+        $TARGET, @achilles.join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub prime-factor-pairs( UInt:D $n where * ≥ 2 --> Array:D[Array:D[UInt:D]] )
+#------------------------------------------------------------------------------
+{
+    my UInt @prime-factors = prime-factors( $n );
+    my UInt %factor2exp{UInt};
+
+    for @prime-factors.sort -> UInt $factor
+    {
+        ++%factor2exp{ $factor };
+    }
+
+    my Array[UInt] @prime-factor-pairs;
+
+    for %factor2exp.keys.sort -> UInt $factor
+    {
+        my UInt $exponent = %factor2exp{ $factor };
+
+        @prime-factor-pairs.push: Array[UInt].new: $factor, $exponent;
+    }
+
+    return @prime-factor-pairs;
+}
+
+#------------------------------------------------------------------------------
+sub prime-factors( UInt:D $n where * ≥ 2 --> Array:D[UInt:D] )
+#------------------------------------------------------------------------------
+{
+    my UInt @prime-factors;
+    my UInt $dividend = $n;
+
+    while $dividend %% 2
+    {
+        @prime-factors.push: 2;
+
+        $dividend = ($dividend / 2).Int;
+    }
+
+    my UInt $start = 3;
+
+    L-OUTER: while $dividend > 1
+    {
+        loop (my UInt $factor = $start; ; $factor += 2)
+        {
+            if $factor.is-prime && $dividend %% $factor
+            {
+                @prime-factors.push: $factor;
+
+                $dividend = ($dividend / $factor).Int;
+                $start    =  $factor;
+
+                if $dividend.is-prime
+                {
+                    @prime-factors.push: $dividend;
+                    last L-OUTER;
+                }
+
+                next L-OUTER;
+            }
+        }
+    }
+
+    return @prime-factors;
+}
+
+#------------------------------------------------------------------------------
+sub gcd( *@nums where { +@nums ≥ 1 && .all ~~ UInt:D && .all ≥ 1 } --> UInt:D )
+#------------------------------------------------------------------------------
+{
+    my UInt $a = @nums.shift;
+
+    while +@nums
+    {
+        my UInt $b = @nums.shift;
+
+        # Euclidean algorithm: "the algorithm replaces (a, b) by (b, a mod b)
+        #                       repeatedly until the pair is (d, 0)" [3]
+
+        ($a, $b) = $b, $a % $b until $b == 0;
+    }
+
+    return $a;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################