- Added solutions by Athanasius.

4 files changed, 502 insertions, 0 deletions

diff --git a/challenge-092/athanasius/perl/Interval.pm b/challenge-092/athanasius/perl/Interval.pm
new file mode 100644
index 0000000000..aed117cd96
--- /dev/null
+++ b/challenge-092/athanasius/perl/Interval.pm
@@ -0,0 +1,89 @@
+#!perl

+

+###############################################################################

+##

+## Perl Weekly Challenge 092, Task #2: Insert Interval

+##

+###############################################################################

+

+#--------------------------------------#

+# Copyright © 2020 PerlMonk Athanasius #

+#--------------------------------------#

+

+package Interval;

+

+use strict;

+use warnings;

+use Moo;

+use Regexp::Common qw( number );

+

+#------------------------------------------------------------------------------

+has start =>

+#------------------------------------------------------------------------------

+(

+    is  => 'ro',

+    isa =>  sub

+            {

+                $_[0] =~ / \A $RE{num}{int} \z /x

+                    or die qq[ERROR: "$_[0]" is not an integer];

+            },

+    required => 1,

+);

+

+#------------------------------------------------------------------------------

+has end =>

+#------------------------------------------------------------------------------

+(

+    is  => 'ro',

+    isa =>  sub

+            {

+                $_[0] =~ / \A $RE{num}{int} \z /x

+                    or die qq[ERROR: "$_[0]" is not an integer];

+            },

+    required => 1,

+);

+

+#------------------------------------------------------------------------------

+sub BUILD

+#------------------------------------------------------------------------------

+{

+    my ($self) = @_;

+

+    die sprintf qq[ERROR: Start "%d" is greater than end "%d"\n],

+                $self->start,   $self->end

+        unless  $self->start <= $self->end;

+}

+

+#------------------------------------------------------------------------------

+sub display

+#------------------------------------------------------------------------------

+{

+    my ($self) = @_;

+

+    return sprintf '(%d,%d)', $self->start, $self->end;

+}

+

+#------------------------------------------------------------------------------

+sub precedes

+#------------------------------------------------------------------------------

+{

+    my ($self, $rhs) = @_;

+

+    return $self->end < $rhs->start;

+}

+

+#------------------------------------------------------------------------------

+sub merge

+#------------------------------------------------------------------------------

+{

+    my ($self, $rhs) = @_;

+

+    my  $minimum = $self->start <= $rhs->start ? $self->start : $rhs->start;

+    my  $maximum = $self->end   >= $rhs->end   ? $self->end   : $rhs->end;

+

+    return Interval->new( start => $minimum, end => $maximum );

+}

+

+###############################################################################

+1;

+###############################################################################

diff --git a/challenge-092/athanasius/perl/ch-1.pl b/challenge-092/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..b3231dee6b
--- /dev/null
+++ b/challenge-092/athanasius/perl/ch-1.pl
@@ -0,0 +1,110 @@
+#!perl

+

+###############################################################################

+=comment

+

+Perl Weekly Challenge 092

+=========================

+

+Task #1

+-------

+*Isomorphic Strings*

+

+Submitted by: Mohammad S Anwar

+

+You are given two strings $A and $B.

+

+Write a script to check if the given strings are *Isomorphic*

+(https://www.educative.io/edpresso/how-to-check-if-two-strings-are-isomorphic).

+Print 1 if they are otherwise 0.

+

+Example 1:

+

+ Input: $A = "abc"; $B = "xyz"

+ Output: 1

+

+Example 2:

+

+ Input: $A = "abb"; $B = "xyy";

+ Output: 1

+

+Example 3:

+

+ Input: $A = "sum"; $B = "add"

+ Output: 0

+

+=cut

+###############################################################################

+

+#--------------------------------------#

+# Copyright © 2020 PerlMonk Athanasius #

+#--------------------------------------#

+

+use strict;

+use warnings;

+use Const::Fast;

+use Set::Scalar;

+

+const my $USAGE =>

+"Usage:

+  perl $0 <A> <B>

+

+    <A>    First string

+    <B>    Second string\n";

+

+#------------------------------------------------------------------------------

+BEGIN

+#------------------------------------------------------------------------------

+{

+    $| = 1;

+    print "\nChallenge 092, Task #1: Isomorphic Strings (Perl)\n\n";

+}

+

+#==============================================================================

+MAIN:

+#==============================================================================

+{

+    scalar @ARGV == 2 or die $USAGE;

+

+    my ($A, $B) = @ARGV;

+

+    print  qq[Input:  \$A = "$A"; \$B = "$B"\n];

+

+    printf   "Output: %d\n", strings_are_isomorphic($A, $B);

+}

+

+#------------------------------------------------------------------------------

+sub strings_are_isomorphic

+#------------------------------------------------------------------------------

+{

+    my ($A, $B) = @ARGV;

+    my  @A      = split //, $A;

+    my  @B      = split //, $B;

+

+    return 0 if scalar @A != scalar @B;

+

+    my %map;

+    my $set = Set::Scalar->new;

+

+    for my $i (0 .. $#A)

+    {

+        my $c1 = $A[$i];

+        my $c2 = $B[$i];

+

+        if (exists $map{$c1})

+        {

+            return 0 if $map{$c1} ne $c2;

+        }

+        else

+        {

+            return 0 if $set->has($c2);

+

+            $map{$c1} =  $c2;

+            $set->insert($c2);

+        }

+    }

+

+    return 1;

+}

+

+###############################################################################

diff --git a/challenge-092/athanasius/perl/ch-2.pl b/challenge-092/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..4ed5ce2f2b
--- /dev/null
+++ b/challenge-092/athanasius/perl/ch-2.pl
@@ -0,0 +1,197 @@
+#!perl

+

+###############################################################################

+=comment

+

+Perl Weekly Challenge 092

+=========================

+

+Task #2

+-------

+*Insert Interval*

+

+Submitted by: Mohammad S Anwar

+

+You are given a set of sorted non-overlapping intervals and a new interval.

+

+Write a script to merge the new interval to the given set of intervals.

+

+Example 1:

+

+ Input $S = (1,4), (8,10); $N = (2,6)

+ Output: (1,6), (8,10)

+

+Example 2:

+

+ Input $S = (1,2), (3,7), (8,10); $N = (5,8)

+ Output: (1,2), (3,10)

+

+Example 3:

+

+ Input $S = (1,5), (7,9); $N = (10,11)

+ Output: (1,5), (7,9), (10,11)

+

+=cut

+###############################################################################

+

+#--------------------------------------#

+# Copyright © 2020 PerlMonk Athanasius #

+#--------------------------------------#

+

+#==============================================================================

+=comment

+

+Assumptions:

+-- All intervals are either integer intervals, or they at least have only

+   integer end-points

+-- From the examples, it appears that intervals should be merged if, and only

+   if, they share one or more elements

+

+Algorithm:

+-- All intervals in $S that share one or more elements with $N are merged with

+   $N and with each other to form a single, merged interval that replaces them

+   all in the output

+-- All other intervals in $S remain unchanged in the output sequence

+

+Testing:

+-- Set $TEST to a true value to compare actual with expected output

+

+=cut

+#==============================================================================

+

+use strict;

+use warnings;

+use Const::Fast;

+use Test::More;

+use lib qw( . );

+use Interval;

+

+const my $TEST  => 0;

+

+const my @INPUT =>

+(

+    [ 'Example 1',    [ [1,4], [8,10]                            ], [ 2, 6] ],

+    [ 'Example 2',    [ [1,2], [3, 7], [ 8,10]                   ], [ 5, 8] ],

+    [ 'Example 3',    [ [1,5], [7, 9]                            ], [10,11] ],

+    [ 'N precedes S', [ [1,5], [7, 9]                            ], [-1, 0] ],

+    [ 'N follows S',  [ [1,4], [8,10]                            ], [12,14] ],

+    [ 'Multi-merge',  [ [0,2], [4,11], [11,11], [11,13], [15,17] ], [ 9,14] ],

+    [ 'N matches 1',  [ [0,1], [2, 3], [ 4, 5]                   ], [ 2, 3] ],

+    [ 'Merge start',  [ [0,3], [5, 7]                            ], [-4, 2] ],

+    [ 'Merge end',    [ [3,5], [7,10]                            ], [ 9,12] ],

+);

+

+const my @OUTPUT =>

+(

+    [ 'Example 1',    [ { start =>  1, end =>  6 },

+                        { start =>  8, end => 10 } ] ],

+    [ 'Example 2',    [ { start =>  1, end =>  2 },

+                        { start =>  3, end => 10 } ] ],

+    [ 'Example 3',    [ { start =>  1, end =>  5 },

+                        { start =>  7, end =>  9 },

+                        { start => 10, end => 11 } ] ], 

+    [ 'N precedes S', [ { start => -1, end =>  0 },

+                        { start =>  1, end =>  5 },

+                        { start =>  7, end =>  9 } ] ],

+    [ 'N follows S',  [ { start =>  1, end =>  4 },

+                        { start =>  8, end => 10 },

+                        { start => 12, end => 14 } ] ],

+    [ 'Multi-merge',  [ { start =>  0, end =>  2 },

+                        { start =>  4, end => 14 },

+                        { start => 15, end => 17 } ] ],

+    [ 'N matches 1',  [ { start =>  0, end =>  1 },

+                        { start =>  2, end =>  3 },

+                        { start =>  4, end =>  5 } ] ],

+    [ 'Merge start',  [ { start => -4, end =>  3 },

+                        { start =>  5, end =>  7 } ] ],

+    [ 'Merge end',    [ { start =>  3, end =>  5 },

+                        { start =>  7, end => 12 } ] ],

+);

+

+const my $USAGE =>

+"\nUsage:

+  perl $0

+  (Add new input to the \@INPUT array)\n";

+

+#------------------------------------------------------------------------------

+BEGIN

+#------------------------------------------------------------------------------

+{

+    $| = 1;

+    print "\nChallenge 092, Task #2: Insert Interval (Perl)\n";

+}

+

+#==============================================================================

+MAIN:

+#==============================================================================

+{

+    die $USAGE if scalar @ARGV > 0;

+

+    for my $i (0 .. $#INPUT)

+    {

+        my   $input = $INPUT[$i];

+        my   @S;

+        push @S, Interval->new(start => $_->[0], end => $_->[1])

+             for @{ $input->[1] };

+

+        my $N = Interval->new(start => $input->[2][0], end => $input->[2][1]);

+

+        unless ($TEST)

+        {

+            printf "\n%s\nInput:  \$S = %s; \$N = %s\n", $input->[0],

+                    join(', ', map { $_->display } @S),  $N->display;

+        }

+

+        my @out = insert_interval(\@S, $N);

+

+        if ($TEST)

+        {

+            is($input->[0],  $OUTPUT[$i]->[0],

+                             $input->[0] . ': Same names');

+

+            is_deeply(\@out, $OUTPUT[$i]->[1],

+                             $input->[0] . ': Interval inserted correctly');

+        }

+        else

+        {

+            printf "Output: %s\n", join ', ', map { $_->display } @out;

+        }

+    }

+

+    done_testing if $TEST;

+}

+

+#------------------------------------------------------------------------------

+sub insert_interval

+#------------------------------------------------------------------------------

+{

+    my ($S, $N) = @_;

+    my  $merged = 0;

+    my  @out;

+

+    # Note: The logic in the loop below relies on the Task requirement that the

+    #       input intervals be *sorted* (in increasing order)

+

+    for my $interval (@$S)

+    {

+        if ($merged || $interval->precedes($N))

+        {

+            push @out, $interval;

+        }

+        elsif ($N->precedes($interval))

+        {

+            push @out, $N, $interval;

+            $merged = 1;

+        }

+        else

+        {

+            $N = $N->merge($interval);

+        }

+    }

+

+    push @out, $N unless $merged;

+

+    return @out;

+}

+

+###############################################################################

diff --git a/challenge-092/athanasius/raku/ch-1.raku b/challenge-092/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..fd7517471a
--- /dev/null
+++ b/challenge-092/athanasius/raku/ch-1.raku
@@ -0,0 +1,106 @@
+use v6d;

+

+###############################################################################

+=begin comment

+

+Perl Weekly Challenge 092

+=========================

+

+Task #1

+-------

+*Isomorphic Strings*

+

+Submitted by: Mohammad S Anwar

+

+You are given two strings $A and $B.

+

+Write a script to check if the given strings are *Isomorphic*

+(https://www.educative.io/edpresso/how-to-check-if-two-strings-are-isomorphic).

+Print 1 if they are otherwise 0.

+

+Example 1:

+

+ Input: $A = "abc"; $B = "xyz"

+ Output: 1

+

+Example 2:

+

+ Input: $A = "abb"; $B = "xyy";

+ Output: 1

+

+Example 3:

+

+ Input: $A = "sum"; $B = "add"

+ Output: 0

+

+=end comment

+###############################################################################

+

+#--------------------------------------#

+# Copyright © 2020 PerlMonk Athanasius #

+#--------------------------------------#

+

+#------------------------------------------------------------------------------

+BEGIN

+#------------------------------------------------------------------------------

+{

+    "\nChallenge 092, Task #1: Isomorphic Strings (Raku)\n".put;

+}

+

+#==============================================================================

+sub MAIN

+(

+    Str:D $A,                         #= First  string

+    Str:D $B,                         #= Second string

+)

+#==============================================================================

+{

+    qq[Input:  \$A = "$A"; \$B = "$B"].put;

+

+    "Output: %d\n".printf: strings-are-isomorphic($A, $B) ?? 1 !! 0;

+}

+

+#------------------------------------------------------------------------------

+sub strings-are-isomorphic( Str:D $A, Str:D $B --> Bool:D )

+#------------------------------------------------------------------------------

+{

+    my Str @A = $A.split: '', :skip-empty;

+    my Str @B = $B.split: '', :skip-empty;

+

+    return False if @A.elems != @B.elems;

+

+    my Str     %map;

+    my SetHash $set;                      # or:  my SetHash $set = SetHash.new;

+

+    for 0 .. @A.end -> UInt $i

+    {

+        my Str $c1 = @A[$i];

+        my Str $c2 = @B[$i];

+

+        if %map{$c1}:exists

+        {

+            return False if %map{$c1} ne $c2;

+        }

+        else

+        {

+            return False if $set{$c2};    # or:  return False if $c2 ∈ $set;

+

+            %map{$c1} = $c2;

+            $set.set:   $c2;

+        }

+    }

+

+    return True;

+}

+

+#------------------------------------------------------------------------------

+sub USAGE()

+#------------------------------------------------------------------------------

+{

+    my Str $usage = $*USAGE;

+

+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;

+    $usage.put;

+}

+

+##############################################################################