Merge pull request #4806 from PerlMonk-Athanasius/branch-for-challenge-127

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

4 files changed, 672 insertions, 0 deletions

diff --git a/challenge-127/athanasius/perl/ch-1.pl b/challenge-127/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..12e2e87836
--- /dev/null
+++ b/challenge-127/athanasius/perl/ch-1.pl
@@ -0,0 +1,137 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 127
+=========================
+
+TASK #1
+-------
+*Disjoint Sets*
+
+Submitted by: Mohammad S Anwar
+
+You are given two sets with unique integers.
+
+Write a script to figure out if they are disjoint.
+
+    The two sets are disjoint if they don't have any common members.
+
+Example
+
+ Input: @S1 = (1, 2, 5, 3, 4)
+        @S2 = (4, 6, 7, 8, 9)
+ Output: 0 as the given two sets have common member 4.
+
+ Input: @S1 = (1, 3, 5, 7, 9)
+        @S2 = (0, 2, 4, 6, 8)
+ Output: 1 as the given two sets do not have common member.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Note
+----
+Input set elements are verified as integers, but no check is made for dupli-
+cates as these are automatically removed during set creation.
+
+Algorithm
+---------
+Set intersection using the CPAN module Set::Scalar.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Set::Scalar;
+
+const my $USAGE =>
+qq[Usage:
+  perl $0 <S1> <S2>
+
+    <S1>    Set 1: a string of the form "( int-a, int-b, ... )"
+    <S2>    Set 2: a string of the form "( int-m, int-n, ... )"\n];
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 127, Task #1: Disjoint Sets (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($S1, $S2) = parse_command_line();
+
+    printf "Input:  \@S1 = (%s)\n", join ', ', @$S1;
+    printf "        \@S1 = (%s)\n", join ', ', @$S2;
+
+    my $set1  = Set::Scalar->new( @$S1 );
+    my $set2  = Set::Scalar->new( @$S2 );
+    my $inter = $set1 * $set2;                               # Set intersection
+
+    if ($inter->is_empty)
+    {
+        print  'Output: 1 (disjoint) as the given two sets do not have any ' .
+               "common members\n";
+    }
+    else
+    {
+        printf 'Output: 0 (not disjoint) as the given two sets have the ' .
+               "common member%s %s\n",
+                    scalar $inter->elements == 1 ? '' : 's',
+                    join ', ', sort { $a <=> $b } $inter->elements;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 2 or error( "Expected 2 command line arguments, found $args" );
+
+    my @array;
+
+    for my $i (0, 1)
+    {
+        my $S = $ARGV[ $i ];
+           $S =~ / ^ \( (.*) \) $ /x
+                  or error( qq[Malformed string "$S"] );
+
+        for (split / , \s* /x, $1)
+        {
+            / ^ $RE{num}{int} $ /x
+                  or error( qq["$_" is not a valid integer] );
+
+            push @{ $array[ $i ] }, $_;
+        }
+    }
+
+    return @array;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-127/athanasius/perl/ch-2.pl b/challenge-127/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..8a2b54e737
--- /dev/null
+++ b/challenge-127/athanasius/perl/ch-2.pl
@@ -0,0 +1,227 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 127
+=========================
+
+TASK #2
+-------
+*Conflict Intervals*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of intervals.
+
+Write a script to find out if the current interval conflicts with any of the
+previous intervals.
+
+Example
+
+ Input: @Intervals = [ (1,4), (3,5), (6,8), (12, 13), (3,20) ]
+ Output: [ (3,5), (3,20) ]
+
+     - The 1st interval (1,4) do not have any previous intervals to compare
+       with, so skip it.
+     - The 2nd interval (3,5) does conflict with previous interval (1,4).
+     - The 3rd interval (6,8) do not conflicts with any of the previous
+       intervals (1,4) and (3,5), so skip it.
+     - The 4th interval (12,13) again do not conflicts with any of the previous
+       intervals (1,4), (3,5) and (6,8), so skip it.
+     - The 5th interval (3,20) conflicts with the first interval (1,4).
+
+ Input: @Intervals = [ (3,4), (5,7), (6,9), (10, 12), (13,15) ]
+ Output: [ (6,9) ]
+
+     - The 1st interval (3,4) do not have any previous intervals to compare
+       with, so skip it.
+     - The 2nd interval (5,7) do not conflicts with the previous interval
+       (3,4), so skip it.
+     - The 3rd interval (6,9) does conflict with one of the previous intervals
+       (5,7).
+     - The 4th interval (10,12) do not conflicts with any of the previous
+       intervals (3,4), (5,7) and (6,9), so skip it.
+     - The 5th interval (13,15) do not conflicts with any of the previous
+       intervals (3,4), (5,7), (6,9) and (10,12), so skip it.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumptions
+-----------
+1. Interval endpoints must be integers.
+
+2. Single-point intervals are allowed; e.g., (10, 10) is a valid interval.
+
+3. An interval (a, b) has a <= b; so, if an interval is specified as (x, y)
+   with x > y, this will be silently converted to the interval (y, x).
+
+4. Two intervals with one shared endpoint but no additional overlap do not
+   "conflict." For example, (5, 9) does NOT conflict with (9, 13).
+
+5. All other overlaps constitute "conflicts"; for example:
+     -- (5, 10) conflicts with (7, 15) because there is a partial overlap, the
+                interval (7, 10)
+     -- (5, 10) conflicts with (7,  9) because (5, 10) contains (7, 9)
+     -- (5, 10) conflicts with (3, 20) because (5, 10) is contained by (3, 20)
+     -- (5, 10) conflicts with (8,  8) because (8,  8) is contained by (5, 10)
+                and the intervals do not share an endpoint.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<endpoints> ...]
+
+    [<endpoints> ...]    An even-numbered list of interval endpoints " .
+                                                                "(integers)\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 127, Task #2: Conflict Intervals (Perl)\n\n";
+}
+
+#==============================================================================
+package Interval;
+#==============================================================================
+
+#------------------------------------------------------------------------------
+sub new
+#------------------------------------------------------------------------------
+{
+    my ($class, $start, $end) = @_;
+    my  %self;
+
+    if ($start <= $end)
+    {
+        $self{ start } = $start;
+        $self{ end   } = $end;
+    }
+    else
+    {
+        $self{ start } = $end;
+        $self{ end   } = $start;
+    }
+
+    return bless \%self, $class;
+}
+
+#------------------------------------------------------------------------------
+sub start                                                            # Accessor
+#------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return $self->{ start };
+}
+
+#------------------------------------------------------------------------------
+sub end                                                              # Accessor
+#------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return $self->{ end };
+}
+
+#------------------------------------------------------------------------------
+sub conflicts
+#------------------------------------------------------------------------------
+{
+    my ($self, $rhs) = @_;
+
+    return !( $self->end   <= $rhs->start ||
+              $self->start >= $rhs->end );
+}
+
+#------------------------------------------------------------------------------
+sub display
+#------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return '(' . $self->start . ', ' . $self->end . ')';
+}
+
+#==============================================================================
+package main;
+MAIN:
+#==============================================================================
+{
+    my @endpoints = parse_command_line();
+    my @intervals;
+
+    while (@endpoints)
+    {
+        push @intervals, Interval->new( shift @endpoints, shift @endpoints );
+    }
+
+    printf "Input:  \@Intervals = [ %s ]\n",
+            join ', ', map { $_->display } @intervals;
+
+    my @conflicts;
+
+    L_OUTER:
+    for my $i (1 .. $#intervals)
+    {
+        my $interval = $intervals[ $i ];
+
+        for my $j (0 .. $i - 1)
+        {
+            if ($interval->conflicts( $intervals[ $j ] ))
+            {
+                push @conflicts, $interval;
+                next L_OUTER;
+            }
+        }
+    }
+
+    printf "Output: \@Conflicts = [ %s ]\n",
+            join ', ', map { $_->display } @conflicts;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args % 2 == 0
+            or error( 'Expected an even number of command line arguments, ' .
+                      "found $args" );
+
+    for (@ARGV)
+    {
+        / ^ $RE{num}{int} $ /x
+            or error( qq["$_" is not a valid integer] );
+    }
+
+    return @ARGV;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-127/athanasius/raku/ch-1.raku b/challenge-127/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..87ea320300
--- /dev/null
+++ b/challenge-127/athanasius/raku/ch-1.raku
@@ -0,0 +1,137 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 127
+=========================
+
+TASK #1
+-------
+*Disjoint Sets*
+
+Submitted by: Mohammad S Anwar
+
+You are given two sets with unique integers.
+
+Write a script to figure out if they are disjoint.
+
+    The two sets are disjoint if they don’t have any common members.
+
+Example
+
+ Input: @S1 = (1, 2, 5, 3, 4)
+        @S2 = (4, 6, 7, 8, 9)
+ Output: 0 as the given two sets have common member 4.
+
+ Input: @S1 = (1, 3, 5, 7, 9)
+        @S2 = (0, 2, 4, 6, 8)
+ Output: 1 as the given two sets do not have common member.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Note
+----
+Input set elements are verified as integers, but no check is made for dupli-
+cates as these are automatically removed during set creation.
+
+Algorithm
+---------
+Set intersection using Raku's core Set class.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 127, Task #1: Disjoint Sets (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D $S1,           #= Set 1: a string of the form "( int-a, int-b, ... )"
+    Str:D $S2            #= Set 2: a string of the form "( int-m, int-n, ... )"
+)
+#==============================================================================
+{
+    my @S1 = parse-set-str( $S1 );
+    my @S2 = parse-set-str( $S2 );
+
+    "Input:  \@S1 = (%s)\n".printf: @S1.join: ', ';
+    "        \@S1 = (%s)\n".printf: @S2.join: ', ';
+
+    my Set[Int] $set1  = Set[Int].new: @S1;
+    my Set[Int] $set2  = Set[Int].new: @S2;
+    my Set[Int] $inter = $set1 ∩ $set2;                      # Set intersection
+
+    if $inter.elems == 0
+    {
+        ('Output: 1 (disjoint) as the given two sets do not have any common ' ~
+         'members').put;
+    }
+    else
+    {
+        ('Output: 0 (not disjoint) as the given two sets have the common ' ~
+         "member%s %s\n").printf: $inter.elems == 1 ?? '' !! 's',
+                                  $inter.keys.sort.join: ', ';
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse-set-str( Str:D $S --> Array:D[Int:D] )
+#------------------------------------------------------------------------------
+{
+    my Int @array;
+
+    $S ~~ / ^ \( (.*) \) $ /
+        or error( qq[Malformed string "$S"] );
+
+    for $0.split: / \, \s* /, :skip-empty
+    {
+        if val( $_ ).^name eq 'IntStr'
+        {
+            @array.push: .Int;
+        }
+        else
+        {
+            error( qq[Element "$_" is not an integer] );
+        }
+    }
+
+    return @array;
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-127/athanasius/raku/ch-2.raku b/challenge-127/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..c2bc041edf
--- /dev/null
+++ b/challenge-127/athanasius/raku/ch-2.raku
@@ -0,0 +1,171 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 127
+=========================
+
+TASK #2
+-------
+*Conflict Intervals*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of intervals.
+
+Write a script to find out if the current interval conflicts with any of the
+previous intervals.
+
+Example
+
+ Input: @Intervals = [ (1,4), (3,5), (6,8), (12, 13), (3,20) ]
+ Output: [ (3,5), (3,20) ]
+
+     - The 1st interval (1,4) do not have any previous intervals to compare
+       with, so skip it.
+     - The 2nd interval (3,5) does conflict with previous interval (1,4).
+     - The 3rd interval (6,8) do not conflicts with any of the previous
+       intervals (1,4) and (3,5), so skip it.
+     - The 4th interval (12,13) again do not conflicts with any of the previous
+       intervals (1,4), (3,5) and (6,8), so skip it.
+     - The 5th interval (3,20) conflicts with the first interval (1,4).
+
+ Input: @Intervals = [ (3,4), (5,7), (6,9), (10, 12), (13,15) ]
+ Output: [ (6,9) ]
+
+     - The 1st interval (3,4) do not have any previous intervals to compare
+       with, so skip it.
+     - The 2nd interval (5,7) do not conflicts with the previous interval
+       (3,4), so skip it.
+     - The 3rd interval (6,9) does conflict with one of the previous intervals
+       (5,7).
+     - The 4th interval (10,12) do not conflicts with any of the previous
+       intervals (3,4), (5,7) and (6,9), so skip it.
+     - The 5th interval (13,15) do not conflicts with any of the previous
+       intervals (3,4), (5,7), (6,9) and (10,12), so skip it.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. Interval endpoints must be integers.
+
+2. Single-point intervals are allowed; e.g., (10, 10) is a valid interval.
+
+3. An interval (a, b) has a <= b; so, if an interval is specified as (x, y)
+   with x > y, this will be silently converted to the interval (y, x).
+
+4. Two intervals with one shared endpoint but no additional overlap do not
+   "conflict." For example, (5, 9) does NOT conflict with (9, 13).
+
+5. All other overlaps constitute "conflicts"; for example:
+     -- (5, 10) conflicts with (7, 15) because there is a partial overlap, the
+                interval (7, 10)
+     -- (5, 10) conflicts with (7,  9) because (5, 10) contains (7, 9)
+     -- (5, 10) conflicts with (3, 20) because (5, 10) is contained by (3, 20)
+     -- (5, 10) conflicts with (8,  8) because (8,  8) is contained by (5, 10)
+                and the intervals do not share an endpoint.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 127, Task #2: Conflict Intervals (Raku)\n".put;
+}
+
+#==============================================================================
+class Interval
+#==============================================================================
+{
+    has Int $.start;
+    has Int $.end;
+
+    #--------------------------------------------------------------------------
+    submethod BUILD( Int:D :$!start, Int:D :$!end )
+    #--------------------------------------------------------------------------
+    {
+        if $!start > $!end
+        {
+            ($!start, $!end) = $!end, $!start;
+        }
+    }
+
+    #--------------------------------------------------------------------------
+    method conflicts( Interval:D $rhs --> Bool:D )
+    #--------------------------------------------------------------------------
+    {
+        return !( $!end <= $rhs.start || $!start >= $rhs.end );
+    }
+
+    #--------------------------------------------------------------------------
+    method display( --> Str:D )
+    #--------------------------------------------------------------------------
+    {
+        return "($!start, $!end)";
+    }
+}
+
+#==============================================================================
+sub MAIN
+(
+    #| An even-numbered list of interval endpoints (integers)
+
+    *@endpoints where { .all ~~ Int && .elems % 2 == 0 }
+)
+#==============================================================================
+{
+    my Interval @intervals;
+
+    while @endpoints
+    {
+        @intervals.push: Interval.new( start => @endpoints.shift.Int,
+                                       end   => @endpoints.shift.Int );
+    }
+
+    "Input:  @Intervals = [ %s ]\n".printf:
+        @intervals.map( { .display } ).join: ', ';
+
+    my Interval @conflicts;
+
+    L-OUTER:
+    for 1 .. @intervals.end -> UInt $i
+    {
+        my Interval $interval = @intervals[ $i ];
+
+        for 0 .. $i - 1 -> UInt $j
+        {
+            if $interval.conflicts: @intervals[ $j ]
+            {
+                @conflicts.push: $interval;
+                next L-OUTER;
+            }
+        }
+    }
+
+    "Output: @Conflicts = [ %s ]\n".printf:
+        @conflicts.map( { .display } ).join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################