- Added solutions by Colin Crain.

4 files changed, 355 insertions, 0 deletions

diff --git a/challenge-092/colin-crain/blog.txt b/challenge-092/colin-crain/blog.txt
new file mode 100644
index 0000000000..a66f21edfc
--- /dev/null
+++ b/challenge-092/colin-crain/blog.txt
@@ -0,0 +1 @@
+https://colincrain.com/2020/12/27/my-lava-lamp-pulsates-in-harmony-with-the-string-section/
diff --git a/challenge-092/colin-crain/perl/ch-1.pl b/challenge-092/colin-crain/perl/ch-1.pl
new file mode 100644
index 0000000000..2d890bf27b
--- /dev/null
+++ b/challenge-092/colin-crain/perl/ch-1.pl
@@ -0,0 +1,152 @@
+#! /opt/local/bin/perl

+#

+#       harmonic_string_section.pl

+#

+#       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. 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

+

+#         method:

+

+#             From the link provided: "Two strings are isomorphic if one-to-one

+#             mapping is possible for every character of the first string to

+#             every character of the second string." They then provide an

+#             example of isomorphism, with the two strings “ACAB” and “XCXY”.

+#

+#             Being acutely aware, at this point, of how the ambiguities arising

+#             from written speech can confound seemingly innoculous definitions,

+#             I immediately set to consider exactly what was being asked of us.

+#

+#             Specifically, what do we mean by a "one-to-one" mapping?

+#

+#             Generally, this means there exists a function that for every

+#             character in string A, outputs one and only one character from

+#             string B. Such a fucntion is known as an *injective* function.

+#

+#             But there is a second qualifier buried in the wording: "*every*

+#             character of the second string". We can take this to mean that

+#             there are no characters in string B that are not mapped to by some

+#             character in string A. Such a function is called "surjective".

+#

+#             The two terms are not exclusiove: a function that is both

+#             injective and surjective is known as "bijective". This is what is

+#             being referred to; the relationship is also known as "one-to-one

+#             onto".

+#

+#             Or so it seems. Although not stated, the positions of the

+#             characters within the strings are important to the correspondence.

+#             For example, what of the two strings "abb" and "yyx"? If "a" maps to

+#             "x" and "b" maps to "y" these would seems to fit the definition. A

+#             little sleuthing suggests it does not, however, and so the

+#             definition should be amended to "if at each position in the first

+#             string an injective mapping can be made to the character in the

+#             corresponding position in the second string".

+#

+#             The terms "injection", "surjection" and "bijection" apply to sets,

+#             and we are adressing ordered sets here. The language can still be

+#             used, but requires qualification.

+#

+#             We're almost done, but not quite.

+#

+#             When we speak of a function that maps A → B, what of B → A? Is it

+#             the same function? A bijective function is known as "invertable",

+#             that is the one-t0-one correspondence goes both ways, but the

+#             function to invert is not likely to be the same mapping, except in

+#             trivial cases such f(x) = x ∀ x. The inverted function will be

+#             related, but the output of the first function, when fed to the

+#             second, will return the original input to the first. If we were to

+#             give the original input to the scond function, the output would

+#             not be immediately predictable.

+#

+#

+#             So with definitions out of the way, how do we do this?

+#

+#             We need to walk the first string position by position. If the

+#             character has not been seen yet, we add it to a hash that points

+#             to the the corresponding letter in string B. If that letter has

+#             already been seen in that string, then it has been allocated to

+#             another and this love affair is over. If the letter in A has been

+#             seen, it is validated be pointing to the same letter that it was

+#             before. If not, again we fail.

+#

+#             Working across we assume success unless we fail by one of the two

+#             methods. If we get to the end, the required mapping exists and the

+#             two strings are isometric.

+#

+#             We don't need to store the values for the invert function hash —

+#             we don't need to actually use the function. The logic demands that

+#             to establish a new key-value pair for the forward mapping both

+#             values need to be heretofore unseen, so a simple check for

+#             existence of the invert hash key is all we need from it.

+#

+

+

+#

+#       2020 colin crain

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

+

+

+

+use warnings;

+use strict;

+use feature ":5.26";

+

+sub check_iso {

+    my ($str_A, $str_B) = @_;

+    return 0 if length $str_A != length $str_B;

+

+    my (%forward, %invert);

+    for (0..length $str_A) {

+        my $char_A = substr $str_A, $_, 1;

+        my $char_B = substr $str_B, $_, 1;

+

+        ## key already in invert

+        return 0 if exists $invert{$char_B} and not exists $forward{$char_A};

+

+        ## key in forward matches char B

+        if (exists $forward{$char_A} ) {

+            return 0 if $forward{$char_A} ne $char_B;

+        }

+        else {             ## make new key

+            $forward{$char_A} = $char_B;

+            $invert{$char_B}  = undef;

+        }

+    }

+    return 1;

+}

+

+

+use Test::More;

+

+

+is check_iso( qw ( abc xyz ) ), 1, 'ex 1';

+is check_iso( qw ( abb xyy ) ), 1, 'ex 2';

+is check_iso( qw ( sum add ) ), 0, 'ex 3, many to one';

+

+is check_iso( qw ( abc bca ) ), 1, 'rearrangement';

+is check_iso( qw ( abb xxy ) ), 0, 'positions matter';

+is check_iso( qw ( abc abc ) ), 1, 'equality';

+is check_iso( qw ( abb xyx ) ), 0, 'one to many';

+

+

+

+

+

+

+done_testing();

+

+

+

diff --git a/challenge-092/colin-crain/perl/ch-2.pl b/challenge-092/colin-crain/perl/ch-2.pl
new file mode 100644
index 0000000000..6cc19858d5
--- /dev/null
+++ b/challenge-092/colin-crain/perl/ch-2.pl
@@ -0,0 +1,144 @@
+#! /opt/local/bin/perl

+#

+#       lava_lamp.pl

+#

+#         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)

+#

+#         method:

+#             we will need a way to abstract our intervals, and notice whether

+#             a given interval intersects with another.

+#

+#             This is like the who left the light on? task.

+#

+#             We start knowing that the intervals do not intersect.

+#

+#             1. sort the intervals by lower bound and secondarily by upper,

+#                 after adding the new interval to the list.

+#             2. working from index 0, check to see whether the upper bound is

+#                 greater than the lower bound of the next iterval. If it is, we have found the

+#                 index right before our interloper. We join

+#                 those two intervals. The lower bound will be the lower of the

+#                 first, the upper the greater of the two upper values. The added

+#                 interval will be assimilated and cease to exist.

+#             3. As the upper bound of the assimilated interval's relationship to

+#                 the existing intervals is unknown, we need to continue until the

+#                 upper bound of the current interval is less than the lower of the

+#                 next interval. Only then can we can stop.

+#             4. Or it it's the last interval, we should also stop then, lest we

+#                 loop forever.

+#

+#             To join an interval with the one following, we slice out the element

+#             at $idx + 1, remembering it's values. As we know the lower value of the

+#             current interval is less than or equal to that of the next, so it is left

+#             as-is. The upper value of the current interval is set to the greater of

+#             the two upper values, current and next. The next interval has been spliced

+#             and removed from the list.

+#

+#

+#

+#       2020 colin crain

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

+

+

+

+use warnings;

+use strict;

+use feature ":5.26";

+

+## ## ## ## ## MAIN:

+

+

+sub main {

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

+    say '';

+

+    say "input:  ", sprint_intervals( $S );

+    say "new:    ", sprint_intervals( [$N] );

+

+    my $idx = insert_and_find_merge($S, $N);

+

+    while (1) {

+        if (defined $S->[$idx+1] and $S->[$idx][1] >= $S->[$idx+1][0]) {

+            merge($S, $idx);

+        }

+

+        last if $idx == $S->@* - 1;

+        last if $S->[$idx][1] < $S->[$idx+1][0];

+    }

+

+    say "merged: ", sprint_intervals( $S );

+

+    return sprint_intervals( $S );   ## for testing purposes

+}

+

+sub insert_and_find_merge {

+## insert new interval into interval list

+## return index of interval to merge with next

+## this will either be the insert point or one before

+    my ($list, $new) = @_;

+    my $idx = 0;

+    my $merge;

+    while ($idx < $list->@*) {

+        last if $list->[$idx][0] >= $new->[0];

+        $idx++;

+    }

+    splice $list->@*, $idx, 0, $new;

+

+    return 0 if $idx == 0;

+    return $idx-1 if $list->[$idx-1][1] >= $new->[0];

+    return $idx;

+}

+

+sub merge {

+## given list ref and index, merges index and index + 1

+    my ($list, $idx) = @_;

+    $list->[$idx][1] = $list->[$idx][1] > $list->[$idx+1][1] ? $list->[$idx][1]

+                                                             : $list->[$idx+1][1];

+    splice $list->@*, $idx+1, 1;

+}

+

+sub sprint_intervals {

+## return formatted string

+    my $list = shift;

+    return  (join ' ', map { "($_->[0],$_->[1])" } $list->@*) ;

+}

+

+

+

+use Test::More;

+

+is main( [[1,4], [8,10]],        [2,6] ),    "(1,6) (8,10)",        'ex 1 - merge first';

+is main( [[1,2], [3,7], [8,10]], [5,8] ),    "(1,2) (3,10)",        'ex 2 - merge to last';

+is main( [[1,5], [7,9]],         [10,11] ),  "(1,5) (7,9) (10,11)", 'ex 3 - no merge';

+is main( [[4,5], [7,8], [10,12]], [1,2] ), "(1,2) (4,5) (7,8) (10,12)", 'add to front - no merge';

+is main( [[1,2], [4,5], [10,12]], [7,8] ), "(1,2) (4,5) (7,8) (10,12)", 'add to middle - no merge';

+is main( [[1,2], [4,5], [7,8]], [10,12] ), "(1,2) (4,5) (7,8) (10,12)", 'add to end - no merge';

+is main( [[4,5], [7,8], [10,12]], [1,12] ), "(1,12)", 'add to front - all merge';

+is main( [[4,5], [7,8], [10,12]], [5,15] ), "(4,15)", 'add to mid - all merge';

+is main( [[4,5], [7,8], [10,12]], [5,9] ), "(4,9) (10,12)", 'add to mid - head merge';

+is main( [[4,5], [6,8]], [8,12]), "(4,5) (6,12)", 'add to end - tail merge';

+

+

+

+

+

+# is main( ), "";

+

+

+

+done_testing();

+

diff --git a/challenge-092/colin-crain/raku/ch-1.raku b/challenge-092/colin-crain/raku/ch-1.raku
new file mode 100644
index 0000000000..1a72e80a5e
--- /dev/null
+++ b/challenge-092/colin-crain/raku/ch-1.raku
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl6
+#
+#
+#       harmonic_string_section.raku
+#
+#       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. 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
+#
+#
+#
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+unit sub MAIN (Str $A = 'xxy', Str $B = 'aab') ;
+
+
+say 0 and exit if $A.chars != $B.chars;
+
+my %forward;
+my %invert = SetHash.new;
+
+for 0..$A.chars {
+    my $ch-A = $A.substr($_,1);
+    my $ch-B = $B.substr($_,1);
+
+    say 0 and exit if $ch-B ∈ %invert and not %forward{$ch-A}:exists;
+
+    if %forward{$ch-A}:exists {
+        say 0 and exit if %forward{$ch-A} ne $ch-B;
+    }
+    else {
+        %forward{$ch-A} = $ch-B;
+#         %invert.set($ch-B);        ## needs 2020.2 ? not sure how to use this
+        %invert{$ch-B} = Nil;
+    }
+}
+
+say 1;
+
+
+
+