diff options
| -rw-r--r-- | challenge-092/jcrosswh/perl/ch-1.pl | 102 | ||||
| -rw-r--r-- | challenge-092/jcrosswh/perl/ch-2.pl | 142 |
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 |