Perl solution week 081/part 2.

3 files changed, 108 insertions, 0 deletions

diff --git a/challenge-081/abigail/input-2-1 b/challenge-081/abigail/input-2-1
new file mode 100644
index 0000000000..f7786e4f1b
--- /dev/null
+++ b/challenge-081/abigail/input-2-1
@@ -0,0 +1,15 @@
+West Side Story
+
+The award-winning adaptation of the classic romantic tragedy "Romeo
+and Juliet". The feuding families become two warring New York City
+gangs, the white Jets led by Riff and the Latino Sharks, led by
+Bernardo. Their hatred escalates to a point where neither can coexist
+with any form of understanding. But when Riff's best friend (and
+former Jet) Tony and Bernardo's younger sister Maria meet at a
+dance, no one can do anything to stop their love. Maria and Tony
+begin meeting in secret, planning to run away. Then the Sharks and
+Jets plan a rumble under the highway--whoever wins gains control
+of the streets. Maria sends Tony to stop it, hoping it can end the
+violence. It goes terribly wrong, and before the lovers know what's
+happened, tragedy strikes and doesn't stop until the climactic and
+heartbreaking ending.
diff --git a/challenge-081/abigail/output-2-1.exp b/challenge-081/abigail/output-2-1.exp
new file mode 100644
index 0000000000..014ffe9684
--- /dev/null
+++ b/challenge-081/abigail/output-2-1.exp
@@ -0,0 +1,9 @@
+1 But City It Jet Juliet Latino New Romeo Side Story Their Then West York adaptation any anything at award-winning away become before begin best classic climactic coexist control dance do doesn't end ending escalates families feuding form former friend gains gangs goes happened hatred heartbreaking highway hoping in know love lovers meet meeting neither no one plan planning point romantic rumble run secret sends sister streets strikes terribly their two under understanding until violence warring what when where white whoever wins with wrong younger
+
+2 Bernardo Jets Riff Sharks The by it led tragedy
+
+3 Maria Tony a can of stop
+
+4 to
+
+9 and the
diff --git a/challenge-081/abigail/perl/ch-2.pl b/challenge-081/abigail/perl/ch-2.pl
new file mode 100644
index 0000000000..1346f21257
--- /dev/null
+++ b/challenge-081/abigail/perl/ch-2.pl
@@ -0,0 +1,84 @@
+#!/opt/perl/bin/perl
+
+#
+# You are given file named input.
+# 
+# Write a script to find the frequency of all the words.
+# 
+# It should print the result as first column of each line should be
+# the frequency of the the word followed by all the words of that
+# frequency arranged in lexicographical order. Also sort the words
+# in the ascending order of frequency.
+# 
+# For the sake of this task, please ignore the following in the input file:
+# 
+#     . " ( ) , 's --
+#
+
+#
+# Note that the challenge says "please ignore the following in the input
+# file", but what it actually means is "treat it as a separator". The 
+# example contains "highway--whoever", but the output contains both
+# "highway" and "whoever", but no "highwaywhoever". If we were to just
+# ignore the "--", we would have expected the latter to appear.
+#
+# It's still a bit ambigious. If we have "foo---bar", should that count
+# as "foo" and "-bar", or as "foo-" and "bar". Our implementation uses
+# the former. (We could have split on /--+/ as well, resulting in counting
+# "foo" and "bar").
+#
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+use experimental 'signatures';
+use experimental 'lexical_subs';
+
+#
+# Read the input -- if there is a file "input", read from there.
+# Else, read STDIN.
+#
+
+my $fh;
+if (-f "input") {
+    open $fh, "<", "input" or die;
+}
+else {
+    $fh = \*STDIN;
+}
+
+local $/; # Slurp in the input.
+$_ = <$fh>;
+
+#
+# Split into words and count them.
+#
+my %words;
+$words {$_} ++ for split /(?:[\s."(),]|'s|--)+/;
+
+#
+# Bucket them
+#
+my %buckets;
+while (my ($word, $count) = each %words) {
+    push @{$buckets {$count}} => $word;
+}
+
+#
+# Print them, sorted by frequency, then words. Some fibbling because
+# we need a blank line *between* the buckets, but none after the last.
+#
+my @buckets = sort {$a <=> $b} keys %buckets;
+foreach my $i (keys @buckets) {
+    my $count = $buckets [$i];
+    print "\n" if $i;
+    print $count;
+    print " $_" for sort @{$buckets {$count}};
+    print "\n";
+}
+
+
+__END__