diff options
| -rwxr-xr-x | challenge-239/mattneleigh/perl/ch-1.pl | 101 | ||||
| -rwxr-xr-x | challenge-239/mattneleigh/perl/ch-2.pl | 133 |
2 files changed, 234 insertions, 0 deletions
diff --git a/challenge-239/mattneleigh/perl/ch-1.pl b/challenge-239/mattneleigh/perl/ch-1.pl new file mode 100755 index 0000000000..9899519266 --- /dev/null +++ b/challenge-239/mattneleigh/perl/ch-1.pl @@ -0,0 +1,101 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @string_sets = ( + [ + [ "ab", "c" ], + [ "a", "bc" ] + ], + [ + [ "ab", "c" ], + [ "ac", "b" ] + ], + [ + [ "ab", "cd", "e" ], + [ "abcde" ] + ] +); + +print("\n"); +foreach my $string_set (@string_sets){ + printf( + "Input: \@arr1 = (%s)\n \@arr2 = (%s)\nOutput: %s\n\n", + join(", ", map("\"" . $_ . "\"", @{$string_set->[0]})), + join(", ", map("\"" . $_ . "\"", @{$string_set->[1]})), + string_arrays_concatenate_uniformly($string_set) ? + "true" + : + "false" + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Given a ref to an array of arrays of strings (see below) determine whether +# the strings in each array concatenate to the same word/string +# Takes one argument: +# * A ref to an array of arrays of strings, of which there must be at least two +# (e.g. +# [ +# [ "ab", "cd", "e" ], +# [ "abcde" ], +# [ "abcd", "e" ] +# ] +# ) +# Returns on success: +# * 0 if any array contains strings that do NOT concatenate to the same word as +# all the others +# * 1 if all arrays contain strings that concatenate to the same word +# Returns on error: +# * undef if there are not at least two arrays of strings +################################################################################ +sub string_arrays_concatenate_uniformly{ + + # Need at least two arrays of strings + return(undef) + if(scalar(@{$ARG[0]}) < 2); + + my $baseword; + + # Examine each array of strings + foreach my $i (0 .. $#{$ARG[0]}){ + my $word = ""; + + # Concatenate each string in this array + foreach my $string (@{$ARG[0][$i]}){ + $word .= $string; + } + + if($i){ + # Not the first word concatenated... + # return 0 if the new word doesn't match + # the first one + return(0) + if($word ne $baseword); + } else{ + # This is the first word concatenated- + # store it + $baseword = $word; + } + } + + # Everything matched + return(1); + +} + + + diff --git a/challenge-239/mattneleigh/perl/ch-2.pl b/challenge-239/mattneleigh/perl/ch-2.pl new file mode 100755 index 0000000000..52e2888f3b --- /dev/null +++ b/challenge-239/mattneleigh/perl/ch-2.pl @@ -0,0 +1,133 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @string_sets = ( + [ + [ "ad", "bd", "aaab", "baa", "badab" ], + "ab" + ], + [ + [ "a", "b", "c", "ab", "ac", "bc", "abc" ], + "abc" + ], + [ + [ "cc", "acd", "b", "ba", "bac", "bad", "ac", "d" ], + "cad" + ] +); + +print("\n"); +foreach my $string_set (@string_sets){ + printf( + "Input: \@str = (%s)\n \$allowed = \"%s\"\nOutput: %d\n\n", + join(", ", map("\"" . $_ . "\"", @{$string_set->[0]})), + $string_set->[1], + count_consistent_strings($string_set->[1], @{$string_set->[0]}) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Count the number of consistent strings within a set of strings- that is to +# say, the strings that only contain letters from a set of allowed letters; +# case will be ignored for matching purposes, as will be non-letter (not a-z) +# characters +# Takes two arguments: +# * A string containing "allowed" letters to be looked for in the other strings +# (e.g. "cad" ) +# * A list of other strings to examine (e.g. ( "cc", "acd", "b", "ba", "bac", +# "bad", "ac", "d" ) ) +# Returns: +# * The number of subsequent strings that were consistent- the ones that only +# contained letters from the first string (e.g. 4 ) +################################################################################ +sub count_consistent_strings{ + # Make a hash from the allowed characters in + # the first string for, easy lookup + my %allowed = map( + { $_ => 1 } + unique_sorted_letters(shift()) + ); + my $count = 0; + + # Examine each remaining string + foreach my $string (@ARG){ + my $increment = 1; + + # Compare each letter in the string with the + # set of permitted letters + foreach my $letter (unique_sorted_letters($string)){ + unless($allowed{$letter}){ + # Letter not allowed- clear the increment + # flag and stop examining letters + $increment = 0; + last; + } + } + + # Increment count if all letters were + # allowed + $count++ + if($increment); + } + + return($count); + +} + + + +################################################################################ +# Given a string, produce a sorted array of unique letters therefrom; all +# letters are lower-cased, and all non-letter characters (not a-z) are ignored +# Takes one argument: +# * The string to examine (e.g. "Hello there!" ) +# Returns: +# * A sorted list of the unique characters in the string (e.g. ( "e", "h", "l", +# "o", "r", "t" ) ) +################################################################################ +sub unique_sorted_letters{ + # Store the sorted characters from the + # arg with, all letters lower-cased + my @chars = sort(split("", lc(shift()))); + my $i = 0; + + # Examine each character within the + # (probably shrinking) list + while($i <= $#chars){ + if( + # Character is not a letter + !($chars[$i] =~ m/[a-z]/) + || + # Not the first character and it's a + # duplicate of the previous char + ($i && ($chars[$i] eq $chars[$i - 1])) + ){ + # Remove it + splice(@chars, $i, 1); + next; + } + + # Move on to the next character + $i++; + } + + return(@chars); + +} + + + |