Merge pull request #3092 from jcrosswh/feature/c092

Feature/c092

2 files changed, 244 insertions, 0 deletions

diff --git a/challenge-092/jcrosswh/perl/ch-1.pl b/challenge-092/jcrosswh/perl/ch-1.pl
new file mode 100644
index 0000000000..0f4fcb4629
--- /dev/null
+++ b/challenge-092/jcrosswh/perl/ch-1.pl
@@ -0,0 +1,102 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+PWC 092 Challenge 1
+
+=head1 SYNOPSIS
+
+  $ ch-1.pl egg add
+  1
+
+  $ ch-1.pl foo bar
+  0
+
+=head1 DESCRIPTION
+
+Given two strings $A and $B, this script will check to see if the given strings
+are isomorphic.  It will print 1 if they are otherwise 0.
+
+=head1 SOLUTION
+
+This solution assumes that if the number of characters in each string is equal,
+then the two strings are isomorphic.  This script works by going though all
+characters, assuming case sensitivity, and determining in each inputed string
+the number of times that character appears.  Internally the script maintains a
+hash that keys on the number of times a character appears, and that key maps to
+an array that captures which characters appeared that number of times.
+
+Once all combinations are determined, the script will go through key values 1->
+the maximum number of characters found, and examining the sizes of the arrays
+for both strings for the given key.  If at any time these arrays don't match in
+size, then the script will print 0 and exit, otherwise we'll complete the
+examination and print 1.
+
+For example, for the given strings 'egg' and 'add', the two hashes will look
+like this:
+
+egg: (0, ["A" .. "Z", "a" .. "d", "f", "h" .. "z"], 1, ["e"], 2, ["g"])
+add: (0, ["A" .. "Z", "b", "c", "e" .. "z"], 1, ["a"], 2, ["d"])
+
+Ignoring the non-appearing characters (0), we see that the size of the '1' array
+is 1 for both strings, and the size of the '2' array is 1 for both strings,
+therefore, 'egg' and 'add' are isomorphic.
+
+=head1 AUTHORS
+
+Joel Crosswhite E<lt>joel.crosswhite@ix.netcom.comE<gt>
+
+=cut
+
+my $first_string = $ARGV[0];
+my $second_string = $ARGV[1];
+if ((!defined($first_string) || $first_string !~ m/^[a-zA-Z]*$/)
+    || (!defined($second_string) || $second_string !~ m/^[a-zA-Z]*$/)) {
+    print "Usage: ch-1.pl <string> <string>\n";
+    exit 1;
+}
+
+my (%char_map_first_string, %char_map_second_string);
+my $max_chars_found = 0;
+foreach my $starting_char ('A', 'a') {
+
+    foreach my $char ($starting_char..'z') {
+
+        find_number_of_characters($char, $first_string,
+            \%char_map_first_string, \$max_chars_found);
+        find_number_of_characters($char, $second_string,
+            \%char_map_second_string, \$max_chars_found);
+    }
+}
+
+foreach my $key (1..$max_chars_found) {
+
+    if (size_of_hash_array($char_map_first_string{$key})
+            != size_of_hash_array($char_map_second_string{$key})) {
+
+        print 0 . "\n";
+        exit 0;
+    }
+}
+
+print 1 . "\n";
+exit 0;
+
+sub find_number_of_characters {
+    my ($char, $string, $char_map, $max_chars_found) = @_;
+
+    my @chars_found = ($string =~ /$char/g);
+    push(@{$char_map->{scalar(@chars_found)}}, $char);
+    $$max_chars_found = (scalar(@chars_found) > $$max_chars_found)
+        ? scalar(@chars_found)
+        : $$max_chars_found;
+}
+
+sub size_of_hash_array {
+    my ($array) = @_;
+
+    return defined($array) ? scalar(@{$array}) : 0;
+}
\ No newline at end of file
diff --git a/challenge-092/jcrosswh/perl/ch-2.pl b/challenge-092/jcrosswh/perl/ch-2.pl
new file mode 100644
index 0000000000..352ada5ad7
--- /dev/null
+++ b/challenge-092/jcrosswh/perl/ch-2.pl
@@ -0,0 +1,142 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+PWC 092 Challenge 2
+
+=head1 SYNOPSIS
+
+  $ ch-2.pl (1,9),(13,19),(25,26) (8,14)
+  (1,19),(25,26)
+
+=head1 DESCRIPTION
+
+Given a set of sorted non-overlapping intervals and a new interval, this script
+will merge the new interval into the given set of intervals.
+
+=head1 SOLUTION
+
+This script takes in two inputs, the first is a list of intervals and the second
+is a new interval that should be added.  This script does not currently work
+with negative numbers, nor does it do any sanity checking that the input is
+sorted and non-overlapping (I didn't get around to checking that.)
+
+This script works by first parsing the existing intervals data into an array of
+arrays, with each array holding two values that denote the start and end of the
+interval.
+
+It then goes though to determine where to insert the new interval.  It checks:
+
+ 1. Does the new interval just go to the beginning of the set.
+ 2. Does the new interval just go to the end of the set.
+ 3. Does the new interval span all other intervals, so it just becomes the new
+interval.
+ 4. The new interval needs to go into the existing set, so starts looping
+through existing intervals:
+  a. Checks if the new interval lands in between the current and the next
+interval.
+  b. Checks if the start of the new interval is before the existing interval, if
+so, then set the current interval start to the new interval start.
+  c. Checks if the end of the new interval is after the existing interval, if so,
+then set the end of the current interval to the new interval end.
+  d. If the new interval connects two intervals, then set the correct beginning
+and end, then delete the second interval from the current set.
+
+=head1 AUTHORS
+
+Joel Crosswhite E<lt>joel.crosswhite@ix.netcom.comE<gt>
+
+=cut
+
+my $intervals = $ARGV[0];
+my $new_interval = $ARGV[1];
+if ((!defined($intervals) || $intervals !~ m/^(\(\d+\,\d+\),)*\(\d+\,\d+\)$/)
+    || (!defined($new_interval) || $new_interval !~ m/^\((\d+)\,(\d+)\)$/)) {
+    print "Usage: ch-2.pl (#,#),(#,#),..(#,#) (#,#)\n";
+    exit 1;
+}
+
+# fetched from input validation regex
+my $new_interval_start = $1;
+my $new_interval_end = $2;
+
+my @intervals_ds;
+extract_intervals($intervals, \@intervals_ds);
+
+# if new interval is before all others....
+if ($new_interval_end < $intervals_ds[0][0]) {
+    splice(@intervals_ds, 0, 0, [$new_interval_start, $new_interval_end]);
+    
+# if new inteval is after all others....
+} elsif ($new_interval_start > $intervals_ds[-1][1]) {
+    splice(@intervals_ds, scalar(@intervals_ds), 0,
+        [$new_interval_start, $new_interval_end]);
+        
+# if new interval spans all intervals....
+} elsif ($new_interval_start < $intervals_ds[0][0]
+    && $new_interval_end > $intervals_ds[-1][1]) {
+    @intervals_ds = [$new_interval_start, $new_interval_end];
+} else {
+    
+    # go through all existing intervals to see where new one should land
+    for (my $i = 0; $i < scalar(@intervals_ds) - 1; $i++) {
+        
+        # new interval falls in between existing intervals
+        if ($new_interval_start > $intervals_ds[$i][1]
+            && $new_interval_end < $intervals_ds[$i + 1][0]) {
+            splice(@intervals_ds, $i + 1, 0,
+                [$new_interval_start, $new_interval_end]);
+            last;
+        }
+        
+        # new interval will extend existing interval forward
+        if ($new_interval_start < $intervals_ds[$i][0]
+            && $new_interval_end > $intervals_ds[$i][0]) {
+            $intervals_ds[$i][0] = $new_interval_start;
+        }
+        
+        # new interval will extend existing interval further back
+        if ($new_interval_end > $intervals_ds[$i][1]
+            && $new_interval_end < $intervals_ds[$i + 1][0]) {
+            $intervals_ds[$i][1] = $new_interval_end;
+        }
+        
+        # new interval 'connects' two intervals, requiring the removal of one
+        if ($new_interval_start < $intervals_ds[$i][1]
+            && $new_interval_end > $intervals_ds[$i + 1][0]) {
+            $intervals_ds[$i][1] = $intervals_ds[$i + 1][1];
+            splice(@intervals_ds, $i + 1, 1);
+        }
+    }
+}
+
+print_intervals(\@intervals_ds);
+exit 0;
+
+sub extract_intervals {
+    my ($input, $intervals) = @_;
+    
+    my $pair_idx = 0;
+    foreach my $character (split(/[\)\,\(]/, $input)) {
+        next if $character eq ''; # just skip blank strings that can come in
+        if ($pair_idx++ % 2 == 0) {
+            push(@{$intervals}, [$character]);
+        } else {
+            push(@{$intervals->[-1]}, $character);
+        }
+    }
+}
+
+sub print_intervals {
+    my ($intervals) = @_;
+
+    my $output = '';
+    foreach my $interval (@{$intervals}) {
+        $output .= sprintf('(%d,%d),', $interval->[0], $interval->[1]);
+    }
+    chop($output);
+    print $output . "\n";
+}
\ No newline at end of file