Merge pull request #3034 from simongreen-net/master

sgreen solution to challenge 092

4 files changed, 113 insertions, 2 deletions

diff --git a/challenge-092/sgreen/README.md b/challenge-092/sgreen/README.md
index 4c11a252b3..9d260cae74 100644
--- a/challenge-092/sgreen/README.md
+++ b/challenge-092/sgreen/README.md
@@ -1,3 +1,3 @@
-# The Weekly Challenge 091
+# The Weekly Challenge 092
 
-Solution by Simon Green. [Blog](https://dev.to/simongreennet/weekly-challenge-091-12l)
+Solution by Simon Green. [Blog](https://dev.to/simongreennet/weekly-challenge-092-1kim)
diff --git a/challenge-092/sgreen/blog.txt b/challenge-092/sgreen/blog.txt
new file mode 100644
index 0000000000..799d1cdf8c
--- /dev/null
+++ b/challenge-092/sgreen/blog.txt
@@ -0,0 +1 @@
+https://dev.to/simongreennet/weekly-challenge-092-1kim
diff --git a/challenge-092/sgreen/perl/ch-1.pl b/challenge-092/sgreen/perl/ch-1.pl
new file mode 100755
index 0000000000..5fba774fe9
--- /dev/null
+++ b/challenge-092/sgreen/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+sub _is_isomorphic {
+    my ( $first, $second ) = @_;
+    # If the strings aren't the same length, they can't be isomorphic
+    return if length($first) != length($second);
+
+    my %table = ();
+    for my $c ( 0 .. length($first) - 1 ) {
+        my $c1 = substr( $first,  $c, 1 );
+        my $c2 = substr( $second, $c, 1 );
+
+        if ( my $x = $table{$c1} ) {
+         # We've seen this letter before, return if the character isn't the same
+            return 0 if $x ne $c2;
+        }
+        else {
+            # Add this character to the hash in case we see it again
+            $table{$c1} = $c2;
+        }
+    }
+
+    return 1;
+}
+
+sub main {
+    my ( $A, $B ) = @_;
+    say _is_isomorphic( $A, $B ) && _is_isomorphic( $B, $A ) ? 1 : 0;
+}
+
+main(@ARGV);
diff --git a/challenge-092/sgreen/perl/ch-2.pl b/challenge-092/sgreen/perl/ch-2.pl
new file mode 100755
index 0000000000..9bd4690553
--- /dev/null
+++ b/challenge-092/sgreen/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use List::Util 'max';
+
+sub _new_intervals {
+    my @numbers = @_;
+
+    # The last two numbers are in the new interval
+    my ( $new_start, $new_end ) = splice( @numbers, -2 );
+    die "The end ($new_end) is less than the start ($new_start)\n"
+      if $new_end < $new_start;
+
+    # The rest of the numbers can be stuffed into a hash
+    my %intervals        = @numbers;
+    my @sorted_intervals = sort { $a <=> $b } keys %intervals;
+
+    foreach my $start (@sorted_intervals) {
+        my $end = $intervals{$start};
+        die "The end ($end) is less than the start ($start)\n" if $end < $start;
+
+        # Nothing to see here. Move on to the next interval
+        next if ( $new_start > $end );
+
+        if ( $new_start < $start ) {
+            if ( $new_end < $start ) {
+                # The new interval is between this interval and the
+                #  previous one (if any)
+                $intervals{$new_start} = $new_end;
+                return \%intervals;
+            }
+
+            # The new interval intersects this one, and the start has been moved
+            $intervals{$new_start} = delete $intervals{$start};
+            $start = $new_start;
+        }
+
+        # Get all intervals that intersect the new interval
+        my @grab = grep { $_ >= $start && $_ <= $new_end }
+          sort { $a <=> $b } keys %intervals;
+
+        # This interval ends at the greater of the new interval or the
+        #  end of the last interval we used.
+        $intervals{$start} = max( $new_end, $intervals{ $grab[-1] } );
+
+        if ( scalar(@grab) > 1 ) {
+            # We subsumed some other intervals, so delete them
+            shift @grab;
+            delete $intervals{$_} foreach @grab;
+        }
+
+        return \%intervals;
+    }
+
+    # If we got here, then the interval is beyond all intervals
+    $intervals{$new_start} = $new_end;
+    return \%intervals;
+}
+
+sub main {
+    my @numbers = ( join( ' ', @_ ) =~ /(-?\d+)/g );
+
+    # Sanity check
+    die "You must provide me some numbers\n" unless @numbers;
+    die "You must provide an even amount of numbers\n" if @numbers % 2;
+
+    # Get an new list of intervals and display the result
+    my $intervals = _new_intervals(@numbers);
+    say join ', ',
+      map { "($_,$$intervals{$_})" } sort { $a <=> $b } keys %$intervals;
+}
+
+main(@ARGV);