Merge pull request #5241 from PerlMonk-Athanasius/branch-for-challenge-139

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

4 files changed, 575 insertions, 0 deletions

diff --git a/challenge-139/athanasius/perl/ch-1.pl b/challenge-139/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..5ec411b460
--- /dev/null
+++ b/challenge-139/athanasius/perl/ch-1.pl
@@ -0,0 +1,136 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 139
+=========================
+
+TASK #1
+-------
+*JortSort*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of numbers.
+
+Write a script to implement JortSort. It should return true/false depending if
+the given list of numbers are already sorted.
+
+Example 1:
+
+  Input: @n = (1,2,3,4,5)
+  Output: 1
+
+  Since the array is sorted, it prints 1.
+
+Example 2:
+
+  Input: @n = (1,3,2,4,5)
+  Output: 0
+
+  Since the array is NOT sorted, it prints 0.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+References
+----------
+1. https://jort.technology/
+2. https://github.com/jennschiffer/jortsort
+3. Rosetta Code (https://rosettacode.org/wiki/JortSort):
+  "Note: jortSort is considered a work of satire. It achieves its result in an
+   intentionally roundabout way. You are encouraged to write your solutions in
+   the spirit of the original jortsort rather than trying to give the most
+   concise or idiomatic solution."
+
+Assumptions
+--------------
+Notwithstanding the Rosetta Code note quoted above, I consider the aim of the
+task to be the efficient (and straightforward) determination of whether a given
+list is sorted or not.
+
+Although the examples show only natural numbers, I can see no reason to exclude
+any real number from the list.
+
+From the examples, it is clear that "sorted" means "sorted in ascending
+numerical order". This still leaves open the question of how to classify a list
+containing identical adjacent elements. I have assumed that "sorted" means "in
+monotonically ascending order", so for a list such as (1, 2.5, 2.5, 3) the
+expected output will be 1.
+
+Algorithm
+---------
+The simplest approach I can think of is to compare each element F in the list
+with its predecessor E: if F < E then the list is unsorted and the search ends
+immediately. The worst case arises when the list is sorted (or when only the
+final element is out of order): then the number of comparisons required will be
+equal to the number elements in the list less one.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<n> ...]
+
+    [<n> ...]    A list of numbers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 139, Task #1: JortSort (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @n = parse_command_line();
+
+    printf "Input:  \@n = (%s)\n", join ', ', @n;
+
+    my $sorted = 1;
+
+    for my $i (1 .. $#n)
+    {
+        if ($n[ $i ] < $n[ $i - 1 ])
+        {
+            $sorted = 0;
+            last;
+        }
+    }
+
+    print "Output: $sorted\n";
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my @n = @ARGV;
+
+    for my $n (@n)
+    {
+        $n =~ / ^ $RE{num}{real} $ /x
+            or die qq[ERROR: "$n" is not a valid number\n$USAGE];
+    }
+
+    return @n;
+}
+
+###############################################################################
diff --git a/challenge-139/athanasius/perl/ch-2.pl b/challenge-139/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..a6f05cc6ea
--- /dev/null
+++ b/challenge-139/athanasius/perl/ch-2.pl
@@ -0,0 +1,181 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 139
+=========================
+
+TASK #2
+-------
+*Long Primes*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 5 Long Primes.
+
+    A prime number (p) is called Long Prime if (1/p) has an infinite decimal
+    expansion repeating every (p-1) digits.
+
+Example
+
+  7 is a long prime since 1/7 = 0.142857142857...
+  The repeating part (142857) size is 6 i.e. one less than the prime number 7.
+
+  Also 17 is a long prime since 1/17 = 0.05882352941176470588235294117647...
+  The repeating part (0588235294117647) size is 16 i.e. one less than the prime
+  number 17.
+
+  Another example, 2 is not a long prime as 1/2 = 0.5.
+  There is no repeating part in this case.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Reference
+---------
+The Online Encyclopedia of Integer Sequences: "A001913. Full reptend primes:
+primes with primitive root 10." at https://oeis.org/A001913:
+
+  7,  17,  19,  23,  29,  47,  59,  61,  97, 109, 113, 131, 149, 167, 179, 181,
+193, 223, 229, 233, 257, 263, 269, 313, 337, 367, 379, 383, 389, 419, 433, 461,
+487, 491, 499, 503, 509, 541, 571, 577, 593, 619, 647, 659, 701, 709, 727, 743,
+811, 821, 823, 857, 863, 887, 937, 941, 953, 971, 977, 983 
+
+Interface
+---------
+No command-line arguments are provided, but the script output may be altered
+by changing the constants $TARGET, $VERBOSE, and TIMER:
+ - $TARGET specifies the number of long primes to generate. (On my Core2 Duo
+   2.16GHz machine, and with $VERBOSE set to a false value, the first 500 long
+   primes are found and displayed in under 11 seconds.)
+ - If set to a true value (the default), $VERBOSE displays each long prime
+   together with its reciprocal; the repeating digits in the reciprocal are
+   enclosed in parentheses;
+ - Set TIMER to a true value to display the time elapsed.
+
+Implementation
+--------------
+Primes are identified by the is_prime() routine from the CPAN module Math::
+Prime::Util.
+
+The non-repeating and repeating parts of a rational number's decimal expansion
+are found by the base_repeating() routine ported from the source code for
+Raku's Rational role.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Math::Prime::Util qw( is_prime );
+
+use constant TIMER => 0;
+
+const my $TARGET   => 5;
+const my $VERBOSE  => 1;
+const my $USAGE    => "Usage:  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 139, Task #2: Long Primes (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    use if TIMER, 'Time::HiRes' => qw( gettimeofday tv_interval );
+    my $t0   = [gettimeofday] if TIMER;
+
+    my $args = scalar @ARGV;
+       $args == 0
+        or die "ERROR: Expected 0 command line arguments, found $args\n$USAGE";
+
+    print "The first $TARGET long primes:";
+
+    for (my ($n, $first, $count) = (2, 1, 0); $count < $TARGET; ++$n)
+    {
+        if (is_prime( $n ))
+        {
+            my ($non_rep, $repeating) = base_repeating( $n );
+
+            if (length $repeating == $n - 1)
+            {
+                if ($VERBOSE)
+                {
+                    printf "%s  %2d  because 1/%2d = %s(%s)\n",
+                          ($first ? "\n\n" : ''), $n, $n, $non_rep, $repeating;
+                }
+                else
+                {
+                    printf "%s%d", ($first ? ' ' : ', '), $n;
+                }
+
+                $first = 0;
+                ++$count;
+            }
+        }
+    }
+
+    print "\n" unless $VERBOSE;
+    print "\n", tv_interval($t0), " seconds\n" if TIMER;
+}
+
+#------------------------------------------------------------------------------
+# Ported from Raku (rakudo-2021.10/src/core.c/Rational.pm6) but simplified for
+# this task as follows:
+#  - the denominator is assumed to be a positive integer;
+#  - the numerator is not passed in, because it is always 1;
+#  - base 10 only is used because the task description specifies a *decimal*
+#    expansion.
+#
+sub base_repeating
+#------------------------------------------------------------------------------
+{
+    my ($denominator) = @_;                           # Must be an integer >= 1
+    my  @quotients    = 0;
+    my  $numerator    = 1;
+    my (@remainders, %remainders, @cycle);
+
+    while (1)
+    {
+        push @remainders, $numerator %= $denominator;
+
+        last if $remainders{ $numerator }++ || $numerator == 0;
+
+        $numerator *= 10;
+
+        push @quotients, int( $numerator / $denominator );
+    }
+
+    if ($numerator > 0)
+    {
+        my $idx = 0;
+
+        for my $remainder (@remainders)
+        {
+            last if $remainder == $numerator;
+            ++$idx;
+        }
+
+        @cycle = splice @quotients, $idx + 1;
+    }
+
+    splice @quotients, 1, 0, '.';
+
+    return (join( '', @quotients ), join( '', @cycle ));
+}
+
+###############################################################################
diff --git a/challenge-139/athanasius/raku/ch-1.raku b/challenge-139/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..b656503b9d
--- /dev/null
+++ b/challenge-139/athanasius/raku/ch-1.raku
@@ -0,0 +1,121 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 139
+=========================
+
+TASK #1
+-------
+*JortSort*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of numbers.
+
+Write a script to implement JortSort. It should return true/false depending if
+the given list of numbers are already sorted.
+
+Example 1:
+
+  Input: @n = (1,2,3,4,5)
+  Output: 1
+
+  Since the array is sorted, it prints 1.
+
+Example 2:
+
+  Input: @n = (1,3,2,4,5)
+  Output: 0
+
+  Since the array is NOT sorted, it prints 0.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+References
+----------
+1. https://jort.technology/
+2. https://github.com/jennschiffer/jortsort
+3. Rosetta Code (https://rosettacode.org/wiki/JortSort):
+  "Note: jortSort is considered a work of satire. It achieves its result in an
+   intentionally roundabout way. You are encouraged to write your solutions in
+   the spirit of the original jortsort rather than trying to give the most
+   concise or idiomatic solution."
+
+Assumptions
+--------------
+Notwithstanding the Rosetta Code note quoted above, I consider the aim of the
+task to be the efficient (and straightforward) determination of whether a given
+list is sorted or not.
+
+Although the examples show only natural numbers, I can see no reason to exclude
+any real number from the list.
+
+From the examples, it is clear that "sorted" means "sorted in ascending
+numerical order". This still leaves open the question of how to classify a list
+containing identical adjacent elements. I have assumed that "sorted" means "in
+monotonically ascending order", so for a list such as (1, 2.5, 2.5, 3) the
+expected output will be 1.
+
+Algorithm
+---------
+The simplest approach I can think of is to compare each element F in the list
+with its predecessor E: if F < E then the list is unsorted and the search ends
+immediately. The worst case arises when the list is sorted (or when only the
+final element is out of order): then the number of comparisons required will be
+equal to the number elements in the list less one.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 139, Task #1: JortSort (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    *@n where { .all ~~ Real:D }                           #= A list of numbers
+)
+#==============================================================================
+{
+    "Input:  \@n = (%s)\n".printf: @n.join: ', ';
+
+    my Bool $sorted = True;
+
+    for 1 .. @n.end -> UInt $i
+    {
+        if @n[ $i ] < @n[ $i - 1 ]
+        {
+            $sorted = False;
+            last;
+        }
+    }
+
+    "Output: %d\n".printf: $sorted ?? 1 !! 0;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-139/athanasius/raku/ch-2.raku b/challenge-139/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..5822ff1957
--- /dev/null
+++ b/challenge-139/athanasius/raku/ch-2.raku
@@ -0,0 +1,137 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 139
+=========================
+
+TASK #2
+-------
+*Long Primes*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 5 Long Primes.
+
+    A prime number (p) is called Long Prime if (1/p) has an infinite decimal
+    expansion repeating every (p-1) digits.
+
+Example
+
+  7 is a long prime since 1/7 = 0.142857142857...
+  The repeating part (142857) size is 6 i.e. one less than the prime number 7.
+
+  Also 17 is a long prime since 1/17 = 0.05882352941176470588235294117647...
+  The repeating part (0588235294117647) size is 16 i.e. one less than the prime
+  number 17.
+
+  Another example, 2 is not a long prime as 1/2 = 0.5.
+  There is no repeating part in this case.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Reference
+---------
+The Online Encyclopedia of Integer Sequences: "A001913. Full reptend primes:
+primes with primitive root 10." at https://oeis.org/A001913:
+
+  7,  17,  19,  23,  29,  47,  59,  61,  97, 109, 113, 131, 149, 167, 179, 181,
+193, 223, 229, 233, 257, 263, 269, 313, 337, 367, 379, 383, 389, 419, 433, 461,
+487, 491, 499, 503, 509, 541, 571, 577, 593, 619, 647, 659, 701, 709, 727, 743,
+811, 821, 823, 857, 863, 887, 937, 941, 953, 971, 977, 983 
+
+Interface
+---------
+No command-line arguments are provided, but the script output may be altered
+by changing the constants $TARGET and $VERBOSE:
+ - $TARGET specifies the number of long primes to generate. (On my Core2 Duo
+   2.16GHz machine, and with $VERBOSE set to a false value, the first 250 long
+   primes are found and displayed in just over 15 seconds.)
+ - If set to a true value (the default), $VERBOSE displays each long prime
+   together with its reciprocal; the repeating digits in the reciprocal are
+   enclosed in parentheses;
+ - Set $TIMER to True to display the time elapsed.
+
+Implementation
+--------------
+Primes are identified by Raku's in-built is-prime() method.
+
+The non-repeating and repeating parts of a rational number's decimal expansion
+are found by Raku's in-built base-repeating() method.
+
+=end comment
+#==============================================================================
+
+my UInt constant $TARGET  = 5;
+my Bool constant $VERBOSE = True;
+my Bool constant $TIMER   = False;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 139, Task #2: Long Primes (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my Instant $t0 = now if $TIMER;
+
+    "The first $TARGET long primes:".print;
+
+    my Bool $first = True;
+    my UInt $n     = 2;
+
+    loop (my UInt $count = 0; $count < $TARGET; ++$n)
+    {
+        if $n.is-prime
+        {
+            my Rat  $reciprocal = Rat.new: 1, $n;
+            my Str ($non-rep, $repeating) = $reciprocal.base-repeating: 10;
+
+            if $repeating.chars == $n - 1
+            {
+                if $VERBOSE
+                {
+                    "\n\n".print if $first;
+
+                    "  %2d  because 1/%2d = %s\(%s)\n".printf:
+                        $n, $n, $non-rep, $repeating;
+                }
+                else
+                {
+                    "%s%d".printf: ($first ?? ' ' !! ', '), $n;
+                }
+
+                $first = False;
+                ++$count;
+            }
+        }
+    }
+
+    "\n".print unless $VERBOSE;
+    "\n{now - $t0} seconds".put if $TIMER;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################