diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2020-10-11 16:21:57 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2020-10-11 16:21:57 +0100 |
| commit | ea74929211ddec973ed806f290e38b3ac11a0d01 (patch) | |
| tree | 86a1dbaaea7167360a1019afdec1fef9a10b10ff | |
| parent | 27e77e5a4cea303aff854d22341ba8c931ef866e (diff) | |
| parent | bd8d81e5312e7c08d9f494d46c21d539db1b72f2 (diff) | |
| download | perlweeklychallenge-club-ea74929211ddec973ed806f290e38b3ac11a0d01.tar.gz perlweeklychallenge-club-ea74929211ddec973ed806f290e38b3ac11a0d01.tar.bz2 perlweeklychallenge-club-ea74929211ddec973ed806f290e38b3ac11a0d01.zip | |
Merge pull request #2489 from Abigail/abigail/week-081
Abigail/week 081
| -rw-r--r-- | challenge-081/abigail/input-1-1 | 2 | ||||
| -rw-r--r-- | challenge-081/abigail/input-1-2 | 2 | ||||
| -rw-r--r-- | challenge-081/abigail/input-2-1 | 15 | ||||
| -rw-r--r-- | challenge-081/abigail/output-1-1.exp | 2 | ||||
| -rw-r--r-- | challenge-081/abigail/output-1-2.exp | 1 | ||||
| -rw-r--r-- | challenge-081/abigail/output-2-1.exp | 9 | ||||
| -rw-r--r-- | challenge-081/abigail/perl/ch-1.pl | 46 | ||||
| -rw-r--r-- | challenge-081/abigail/perl/ch-2.pl | 84 | ||||
| -rwxr-xr-x | challenge-081/abigail/test.pl | 77 |
9 files changed, 238 insertions, 0 deletions
diff --git a/challenge-081/abigail/input-1-1 b/challenge-081/abigail/input-1-1 new file mode 100644 index 0000000000..bcb118a7c2 --- /dev/null +++ b/challenge-081/abigail/input-1-1 @@ -0,0 +1,2 @@ +abcdabcd +abcdabcdabcdabcd diff --git a/challenge-081/abigail/input-1-2 b/challenge-081/abigail/input-1-2 new file mode 100644 index 0000000000..0917019ba6 --- /dev/null +++ b/challenge-081/abigail/input-1-2 @@ -0,0 +1,2 @@ +aaa +aa 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-1-1.exp b/challenge-081/abigail/output-1-1.exp new file mode 100644 index 0000000000..ddf5cedb9f --- /dev/null +++ b/challenge-081/abigail/output-1-1.exp @@ -0,0 +1,2 @@ +abcdabcd +abcd diff --git a/challenge-081/abigail/output-1-2.exp b/challenge-081/abigail/output-1-2.exp new file mode 100644 index 0000000000..7898192261 --- /dev/null +++ b/challenge-081/abigail/output-1-2.exp @@ -0,0 +1 @@ +a 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-1.pl b/challenge-081/abigail/perl/ch-1.pl new file mode 100644 index 0000000000..39e62fc635 --- /dev/null +++ b/challenge-081/abigail/perl/ch-1.pl @@ -0,0 +1,46 @@ +#!/opt/perl/bin/perl + +# +# You are given 2 strings, $A and $B. +# +# Write a script to find out common base strings in $A and $B. +# +# A substring of a string $S is called base string if repeated +# concatenation of the substring results in the string. +# + +use 5.032; + +use strict; +use warnings; +no warnings 'syntax'; + +use experimental 'signatures'; +use experimental 'lexical_subs'; + +chomp (my $A = <>); +chomp (my $B = <>); + +# +# Sort the strings by lenght, so $A isn't longer than $B. +# +($A, $B) = ($B, $A) if length $B < length $A; + +# +# Find a substring which cannot be part of either string, +# nor of its concatenation. +# +my $sep = "\x00" x (1 + length ($A) + length ($B)); + +# +# Now, use a regular expression to find common base strings. +# +$_ = "$A$sep$B"; +/^ (.+) \1* # Find base strings of $A + $sep # Match the separator + \1+ $ # Must be base string for $B + (?{say $1}) # Print it + (*FAIL) # Backtrack so we can try other base strings. +/x; + +__END__ 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__ diff --git a/challenge-081/abigail/test.pl b/challenge-081/abigail/test.pl new file mode 100755 index 0000000000..310382b62b --- /dev/null +++ b/challenge-081/abigail/test.pl @@ -0,0 +1,77 @@ +#!/opt/perl/bin/perl + +# +# Test the solutions. Either call it with the directory name you +# want to test in, or call it as "../test.pl" from within the directory. +# + +use 5.032; + +use strict; +use warnings; +no warnings 'syntax'; + +chdir ".." if -f "../test.pl"; + +use experimental 'signatures'; + +use Test::More; + + +my %languages = ( + Perl => { + exe => "/opt/perl/bin/perl", + ext => "pl", + }, + JavaScript => { + exe => "/usr/local/bin/node", + ext => "js", + dir => "node", + }, + bc => { + exe => "/usr/bin/bc", + ext => "bc", + filter => 's/.*/main($&)/', + }, + awk => { + exe => "/usr/bin/awk", + ext => "awk", + args => ["-f"], + }, +); + +my $perl_exe = $languages {Perl} {exe}; + +foreach my $challenge (1, 2) { + my @inputs = <input-$challenge-*> or next; + subtest "Challenge $challenge" => sub { + foreach my $language (sort keys %languages) { + my $info = $languages {$language}; + my $exe = $$info {exe}; + my $ext = $$info {ext}; + my $dir = $$info {dir} // lc $language; + my @args = @{$$info {args} // []}; + my $filter = $$info {filter} // ''; + my $solution = "$dir/ch-$challenge.$ext"; + next unless -r $solution; + + subtest $language => sub { + foreach my $input (@inputs) { + my $output_exp = ($input =~ s/input/output/r) . ".exp"; + my $exp = `cat $output_exp`; + + my $got = `$perl_exe -ple '$filter' $input |\ + $exe @args ./$solution`; + + s/\h+$//gm for $exp, $got; + is $got, $exp, $input; + } + } + } + } +} + +done_testing; + + +__END__ |
