diff options
Diffstat (limited to 'challenge-255')
| -rwxr-xr-x | challenge-255/mattneleigh/perl/ch-1.pl | 104 | ||||
| -rwxr-xr-x | challenge-255/mattneleigh/perl/ch-2.pl | 97 |
2 files changed, 201 insertions, 0 deletions
diff --git a/challenge-255/mattneleigh/perl/ch-1.pl b/challenge-255/mattneleigh/perl/ch-1.pl new file mode 100755 index 0000000000..e84c50f792 --- /dev/null +++ b/challenge-255/mattneleigh/perl/ch-1.pl @@ -0,0 +1,104 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @string_pairs = ( + # Given cases + [ "Perl", "Preel" ], + [ "Weekly", "Weeakly" ], + [ "Box", "Boxy" ], + + # Additional test cases + [ "Pizza", "Pizzeria" ], + [ "No", "Matches" ], + [ "Peer", "Peerless" ] +); + +print("\n"); +foreach my $string_pair (@string_pairs){ + printf( + "Input: \$s = \"%s\"\n \$t = \"%s\"\nOutput: %s\n\n", + @{$string_pair}, + join( + ", ", + find_additional_characters(@{$string_pair}) + ) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Given two strings, find the characters in the second that are NOT present in +# the first, with quantity of characters being taken into account rather than +# mere presence alone (see below) +# Takes two arguments: +# * The first string (e.g. "Peer" ) +# * The second string (e.g. "Peerless" ) +# Returns: +# * A lexicographically sorted list of characters that are present in the +# second string but not in the first (e.g. ( "e", "l", "s", "s" ) ). Note +# that 'e' is included once and 's' is included twice as that represents the +# number of times each appears more in the second string than in the first. +################################################################################ +sub find_additional_characters{ + + my $char; + my %chars; + + # Make a table of character counts from the second + # argument + foreach $char (split('', $ARG[1])){ + if($chars{$char}){ + $chars{$char}++; + } else{ + $chars{$char} = 1; + } + } + + # Decrement (or remove entirely) the counts of + # characters that appear in the first argument + foreach $char (split('', $ARG[0])){ + if(exists($chars{$char})){ + $chars{$char}--; + delete($chars{$char}) + unless($chars{$char}); + } + } + + # Return a lexicographically sorted list of + # remaining characters + return( + sort( + # Make a list of remaining characters + map( + { + $char = $_; + + # Repeat the character the appropriate + # number of times + map( + $char, + 1 .. $chars{$char} + ) + } + keys(%chars) + ) + ) + ); + +} + + + diff --git a/challenge-255/mattneleigh/perl/ch-2.pl b/challenge-255/mattneleigh/perl/ch-2.pl new file mode 100755 index 0000000000..9674ba97d9 --- /dev/null +++ b/challenge-255/mattneleigh/perl/ch-2.pl @@ -0,0 +1,97 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @paragraphs_and_words = ( + [ + "Joe hit a ball, the hit ball flew far after it was hit.", + "hit" + ], + [ + "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge.", + "the" + ] +); + +print("\n"); +foreach my $paragraph_and_word (@paragraphs_and_words){ + printf( + "Input: \$p = \"%s\"\n \$w = \"%s\"\nOutput: \"%s\"\n\n", + @{$paragraph_and_word}, + most_frequent_permitted_word(@{$paragraph_and_word}) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Given a paragraph and a banned word, find the permitted word that appears +# most frequently in the paragraph +# Takes two arguments: +# * The paragraph to examine (e.g. "Joe hit a ball, the hit ball flew far after +# it was hit." ) +# * The word to ban (e.g. "hit") +# Returns: +# * The permitted word that appears most frequently in the paragraph (e.g. +# "ball"). If there are multiple words tied for most frequent, the one that +# sorts first, lexicographically speaking, will be returned +################################################################################ +sub most_frequent_permitted_word{ + + my %words; + + # Get a table of counts of permitted words + foreach my $word (split(' ', $ARG[0])){ + # Stip anything that isn't a letter or number + $word =~ s/[^A-Za-z0-9]//g; + + # If the word isn't the forbidden one, add to + # its count in the word table + if($word ne $ARG[1]){ + if($words{$word}){ + $words{$word}++; + } else{ + $words{$word} = 1; + } + } + } + + return( + # 3: Get the 0th field of the 0th record in + # the sorted list- this will be the most + # frequently observed word + ( + # 2: Sort the list in descending order by + # count, unless the counts are equal, in + # which case sort lexicographically + sort( + { + $b->[1] == $a->[1] ? + $a->[0] cmp $b->[0] + : + $b->[1] <=> $a->[1] + } + # 1: Make a list of words and their counts + map( + [ $_, $words{$_} ], + keys(%words) + ) + ) + )[0][0] + ); + +} + + + |