Merge pull request #11145 from PerlMonk-Athanasius/branch-for-challenge-294

3 solutions for Week 294

3 files changed, 704 insertions, 0 deletions

diff --git a/challenge-294/athanasius/perl/ch-1.pl b/challenge-294/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..a4920c12cd
--- /dev/null
+++ b/challenge-294/athanasius/perl/ch-1.pl
@@ -0,0 +1,267 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 294
+=========================
+
+TASK #1
+-------
+*Consecutive Sequence*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an unsorted array of integers, @ints.
+
+Write a script to return the length of the longest consecutive elements se-
+quence. Return -1 if none found. The algorithm must runs in O(n) time.
+
+Example 1
+
+  Input: @ints = (10, 4, 20, 1, 3, 2)
+  Output: 4
+
+  The longest consecutive sequence (1, 2, 3, 4).
+  The length of the sequence is 4.
+
+Example 2
+
+  Input: @ints = (0, 6, 1, 8, 5, 2, 4, 3, 0, 7)
+  Output: 9
+
+Example 3
+
+  Input: @ints = (10, 30, 20)
+  Output: -1
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A list of integers is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty, unsorted list of integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 294, Task #1: Consecutive Sequence (Perl)\n\n";
+}
+
+#-------------------------------------------------------------------------------
+package Range
+#-------------------------------------------------------------------------------
+{
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    sub new
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    {
+        my ($class, $low, $high) = @_;
+
+        my  %self = (low => $low, high => $high);
+
+        return bless \%self, $class;
+    }
+
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    sub size
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    {
+        my ($self) = @_;
+
+        return $self->{ high } - $self->{ low } + 1;
+    }
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+            for @ints;
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $max_seq = find_max_seq( \@ints );
+
+        print  "Output: $max_seq\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_max_seq
+#-------------------------------------------------------------------------------
+{
+    my ($ints)       = @_;
+    my  $max_seq_len = 1;
+    my (%n2seq, %edge, @seqs);
+
+    for my $n (@$ints)
+    {
+        unless (exists $n2seq{ $n })
+        {
+            if (exists  $edge{ $n })
+            {
+                my  $seq_len = merge( $n, \%n2seq, \%edge, \@seqs );
+                $max_seq_len = $seq_len if $seq_len > $max_seq_len;
+            }
+            else
+            {
+                add_singleton( $n, \%n2seq, \%edge, \@seqs );
+            }
+        }
+    }
+
+    return $max_seq_len <= 1 ? -1 : $max_seq_len;
+}
+
+#-------------------------------------------------------------------------------
+sub merge
+#-------------------------------------------------------------------------------
+{
+    my ($n, $n2seq, $edge, $seqs) = @_;
+    my ($left, $right) = @{ $edge->{ $n } };
+    my  $range;
+
+    if    (defined $left && defined $right)
+    {
+        my $seq_id_l = $n2seq  ->{ $n - 1    };
+           $range    = $seqs   ->[ $seq_id_l ];
+        my $seq_id_r = $n2seq  ->{ $n + 1    };
+        my $range_r  = $seqs   ->[ $seq_id_r ];
+        my $high     = $range_r->{ high      };
+
+        $range->{ high      } = $high;
+        $n2seq->{ $n        } = $n2seq->{ $high } = $seq_id_l;
+        $seqs ->[ $seq_id_r ] = undef;
+    }
+    elsif (defined $left)
+    {
+        my $seq_id = $n2seq->{ $n - 1  };
+           $range  = $seqs ->[ $seq_id ];
+
+        $range->{ high } = $n;
+        $n2seq->{ $n   } = $edge->{ $n + 1 }[ 0 ] = $seq_id;
+    }
+    else # defined $right
+    {
+        my $seq_id = $n2seq->{ $n + 1  };
+           $range  = $seqs ->[ $seq_id ];
+
+        $range->{ low  } = $n;
+        $n2seq->{ $n   } = $edge->{ $n - 1 }[ 1 ] = $seq_id;
+    }
+
+    delete $edge->{ $n };
+
+    return $range->size;
+}
+
+#-------------------------------------------------------------------------------
+sub add_singleton
+#-------------------------------------------------------------------------------
+{
+    my ($n, $n2seq, $edge, $seqs) = @_;
+    my  $seq = Range->new( $n, $n );
+
+    push @$seqs, $seq;
+
+    my $seq_id     = $#$seqs;
+    $n2seq->{ $n } = $seq_id;
+
+    if (exists $edge->{ $n - 1 })
+    {
+        $edge->{ $n - 1 }[ 1 ] = $seq_id;
+    }
+    else
+    {
+        $edge->{ $n - 1 } = [ undef, $seq_id ];
+    }
+
+    if (exists $edge->{ $n + 1 })
+    {
+        $edge->{ $n + 1 }[ 0 ] = $seq_id;
+    }
+    else
+    {
+        $edge->{ $n + 1 } = [ $seq_id, undef ];
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints    = split / \s+ /x, $ints_str;
+        my $max_seq = find_max_seq( \@ints );
+
+        is $max_seq, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|10  4 20 1 3 2        | 4
+Example 2| 0  6  1 8 5 2 4 3 0 7| 9
+Example 3|10 30 20              |-1
diff --git a/challenge-294/athanasius/perl/ch-2.pl b/challenge-294/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..3ee80b5147
--- /dev/null
+++ b/challenge-294/athanasius/perl/ch-2.pl
@@ -0,0 +1,222 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 294
+=========================
+
+TASK #2
+-------
+*Next Permutation*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to find out the next permutation of the given array.
+
+    The next permutation of an array of integers is the next lexicographically
+    greater permutation of its integer.
+
+Example 1
+
+  Input: @ints = (1, 2, 3)
+  Output: (1, 3, 2)
+
+  Permutations of (1, 2, 3) arranged lexicographically:
+  (1, 2, 3)
+  (1, 3, 2)
+  (2, 1, 3)
+  (2, 3, 1)
+  (3, 1, 2)
+  (3, 2, 1)
+
+Example 2
+
+  Input: @ints = (2, 1, 3)
+  Output: (2, 3, 1)
+
+Example 3
+
+  Input: @ints = (3, 1, 2)
+  Output: (3, 2, 1)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A list of integers is entered on the command-line.
+3. If the first integer is negative, it must be preceded by "--" to prevent it
+   from being interpreted as a command-line flag.
+
+Assumption
+----------
+Repetitions are allowed in the input list.
+
+Algorithm
+---------
+From [1]: "The following algorithm generates the next permutation lexicographi-
+cally after a given permutation. It changes the given permutation in-place.
+
+   "1. Find the largest index k such that a[k] < a[k + 1]. If no such index
+       exists, the permutation is the last permutation.
+   "2. Find the largest index l greater than k such that a[k] < a[l].
+   "3. Swap the value of a[k] with that of a[l].
+   "4. Reverse the sequence from a[k + 1] up to and including the final element
+       a[n]."
+
+Reference
+---------
+[1] https://en.wikipedia.org/wiki/Permutation#Generation_in_lexicographic_order
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures and warnings
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty list of integers
+
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 294, Task #2: Next Permutation (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+            for @ints;
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $next = find_next_perm( \@ints );
+
+        if (scalar @$next > 0)
+        {
+            printf "Output:         (%s)\n", join ', ', @$next;
+        }
+        else
+        {
+            print  "Output: This is the last permutation\n";
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_next_perm
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+
+    # 1. Find the largest index k such that a[k] < a[k + 1]. If no such index
+    #    exists, the permutation is the last permutation.
+
+    my $k = -1;
+
+    for my $i (reverse( 0 .. $#$ints - 1))
+    {
+        $k = $i, last if $ints->[ $i ] < $ints->[ $i + 1 ];
+    }
+
+    return [] if $k < 0;
+
+    # 2. Find the largest index l greater than k such that a[k] < a[l]
+
+    my $l;
+
+    for my $i (reverse( $k + 1 .. $#$ints))
+    {
+        $l = $i, last if $ints->[ $k ] < $ints->[ $i ];
+    }
+
+    # 3. Swap the value of a[k] with that of a[l]
+
+    @$ints[ $k, $l ] = @$ints[ $l, $k ];
+
+    # 4. Reverse the sequence from a[k + 1] up to and including the final
+    #    element a[n]
+
+    @$ints[ $k + 1 .. $#$ints ] = reverse @$ints[ $k + 1 .. $#$ints ];
+
+    return $ints;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expd_str) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expd_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints = split / \s+ /x, $ints_str;
+        my $next = find_next_perm( \@ints );
+        my @expd = split / \s+ /x, $expd_str;
+
+        is_deeply $next, \@expd, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 1  2  3| 1  3  2
+Example 2| 2  1  3| 2  3  1
+Example 3| 3  1  2| 3  2  1
+Inc 1st 1| 1  3  2| 2  1  3
+Inc 1st 2| 2  3  1| 3  1  2
+Negatives|-2 -1 -3|-1 -3 -2
+Last perm| 3  2  1|
diff --git a/challenge-294/athanasius/raku/ch-2.raku b/challenge-294/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..03dbdd339e
--- /dev/null
+++ b/challenge-294/athanasius/raku/ch-2.raku
@@ -0,0 +1,215 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 294
+=========================
+
+TASK #2
+-------
+*Next Permutation*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to find out the next permutation of the given array.
+
+    The next permutation of an array of integers is the next lexicographically
+    greater permutation of its integer.
+
+Example 1
+
+  Input: @ints = (1, 2, 3)
+  Output: (1, 3, 2)
+
+  Permutations of (1, 2, 3) arranged lexicographically:
+  (1, 2, 3)
+  (1, 3, 2)
+  (2, 1, 3)
+  (2, 3, 1)
+  (3, 1, 2)
+  (3, 2, 1)
+
+Example 2
+
+  Input: @ints = (2, 1, 3)
+  Output: (2, 3, 1)
+
+Example 3
+
+  Input: @ints = (3, 1, 2)
+  Output: (3, 2, 1)
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A list of integers is entered on the command-line.
+3. If the first integer is negative, it must be preceded by "--" to prevent it
+   from being interpreted as a command-line flag.
+
+Assumption
+----------
+Repetitions are allowed in the input list.
+
+Algorithm
+---------
+From [1]: "The following algorithm generates the next permutation lexicographi-
+cally after a given permutation. It changes the given permutation in-place.
+
+   "1. Find the largest index k such that a[k] < a[k + 1]. If no such index
+       exists, the permutation is the last permutation.
+   "2. Find the largest index l greater than k such that a[k] < a[l].
+   "3. Swap the value of a[k] with that of a[l].
+   "4. Reverse the sequence from a[k + 1] up to and including the final element
+       a[n]."
+
+Reference
+---------
+[1] https://en.wikipedia.org/wiki/Permutation#Generation_in_lexicographic_order
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 294, Task #2: Next Permutation (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of integers
+
+    *@ints where { .elems > 0 && .all ~~ Int:D }
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    my Int @next = find-next-perm( @ints );
+
+    if @next.elems > 0
+    {
+        "Output:         (%s)\n"\.printf: @next.join: ', ';
+    }
+    else
+    {
+        'Output: This is the last permutation'.put;
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-next-perm( List:D[Int:D] $ints --> List:D[Int:D] )
+#-------------------------------------------------------------------------------
+{
+    # 1. Find the largest index k such that a[k] < a[k + 1]. If no such index
+    #    exists, the permutation is the last permutation.
+
+    my Int $k = -1;
+
+    for (0 .. $ints.end - 1).reverse -> UInt $i
+    {
+        $k = $i, last if $ints[ $i ] < $ints[ $i + 1 ];
+    }
+
+    return () if $k < 0;
+
+    # 2. Find the largest index l greater than k such that a[k] < a[l]
+
+    my UInt $l;
+
+    for ($k + 1 .. $ints.end).reverse -> UInt $i
+    {
+        $l = $i, last if $ints[ $k ] < $ints[ $i ];
+    }
+
+    my Int @next = @$ints;
+
+    # 3. Swap the value of a[k] with that of a[l]
+
+    @next[ $k, $l ] = @next[ $l, $k ];
+
+    # 4. Reverse the sequence from a[k + 1] up to and including the final
+    #    element a[n]
+
+    @next[ $k + 1 .. * ] = @next[ $k + 1 .. * ].reverse;
+
+    return @next;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $expd-str) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $expd-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @ints = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Int @next = find-next-perm( @ints );
+        my Int @expd = $expd-str.split( / \s+ /, :skip-empty ).map: { .Int };
+
+        is-deeply @next, @expd, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1| 1  2  3| 1  3  2
+        Example 2| 2  1  3| 2  3  1
+        Example 3| 3  1  2| 3  2  1
+        Inc 1st 1| 1  3  2| 2  1  3
+        Inc 1st 2| 2  3  1| 3  1  2
+        Negatives|-2 -1 -3|-1 -3 -2
+        Last perm| 3  2  1|
+        END
+}
+
+################################################################################