Perl Weekly Challenge: Week 385
Challenge 1:
Uncommon Words
You are given two sentences.
Write a script to return list of all uncommon words, order is not important.
Example 1
Input: $sentence1 = "apple banana apple"
$sentence2 = "banana orange"
Output: ("orange")
Example 2
Input: $sentence1 = "cat dog"
$sentence2 = "bird fish"
Output: ("cat", "dog", "bird", "fish")
Example 3
Input: $sentence1 = "the quick brown fox"
$sentence2 = "the quick"
Output: ("brown", "fox")
Example 4
Input: $sentence1 = "hello"
$sentence2 = "hello"
Output: ()
Example 5
Input: $sentence1 = "blue blue red"
$sentence2 = "red green green yellow"
Output: ("yellow")
Raku has a data structure called the BagHash
which is ideal for this challenge. It is a collection of items along with the
number of times, the item appears in the collection.
So first we create a BagHash called $allWords.
my $allWords = BagHash.new;
Then we split up $sentence1 and $sentence2 into words with .words() and add
those words to our BagHash.
$allWords.add($sentence1.words);
$allWords.add($sentence2.words);
The next line looks complicated but that's mainly so the output can be formatted in the same style as the spec. The interesting bits are...
say
q{(},
$allWords
...we get the .keys() of $allWords which give us the distinct words kept in it.
.keys
Then we filter those words with .grep() to check if the associated value is 1, meaning that theword only occurred once in the sentences. These are the uncommon
words we are looking for.
.grep({ $allWords{$_} == 1 })
.map({ "\"$_.\"" })
.join(q{, }),
q{)};
We can do the same in Perl just using standard Hashes but I thought it would be
fun to try and emulate a BagHash (see below.) This makes the body of the script
pretty similar to the Raku version.
my $allWords = BagHash->new;
$allWords->add(split /\s+/, $sentence1);
$allWords->add(split /\s+/, $sentence2);
say q{(},
(join q{, }, map { "\"$_\"" } grep { $allWords->valueFor($_) == 1 } $allWords->keys),
q{)};
My Perl BagHash uses the new OOP features in modern versions of Perl. As of 5.40.2, they are still not completely integrated so you need to add these lines to the top of the script.
use feature qw/ class /;
no warnings qw / experimental::class /;
A class is a block introduced by the class keyword and followed by the class name.
(and possibly other things which I haven't used here.)
class BagHash {
A field can by any kind of Perl variable. It will be private to each object
of this class type. Here, I've defined a hash that will hold the BagHash data so
is called %data. You can define accessors to publicly read and/or write a field
but I haven't here.
field %data;
A method is a subroutine public in each object of this class type. I have defined
three methods in this class.
Like the similarly named method in Raku's BagHash, add() adds items to the
object. Each item becomes a key in %data and its' value is incremented for each
occurrence.
method add(@items) {
for my $item (@items) {
$data{$item}++;
}
}
keys() just returns the keys of %data.
method keys() {
return keys %data;
}
Given a key, valueFor() will return the associated value from %data.
method valueFor($key) {
return $data{$key};
}
}
Challenge 2:
Outermost Parentheses
You are given a valid parentheses string.
Write a script to return the string after removing the outermost parentheses of every primitive string in the primitive decomposition of the given string.
Example 1
Input: $str = "()()()"
Output: ""
Primitive Decomposition: "()" + "()" + "()"
Example 2
Input: $str = "(((())))"
Output: "((()))"
Primitive Decomposition: "(((())))"
Example 3
Input: $str = "(()())(())"
Output: "()()()"
Primitive Decomposition: "(()())" + "(())"
Example 4
Input: $str = "()((()))()"
Output: "(())"
Primitive Decomposition: "()" + "((()))" + "()"
Example 5
Input: $str = "(()(()))(()())"
Output: "()(())()()"
Primitive Decomposition: "(()(()))" + "(()())"
We start by defining two variables. $level is the number of levels of nested
parentheses we are currently at. $result should be self-explanatory. It defaults
to an empty string.
my $level = 0;
my $result = q{};
$str is split into individual characters with .comb(). For each character...
for $str.comb -> $c {
...if it as open parenthesis...
if $c eq q{(} {
...and we are currently nested in parentheses... if $level > 0 {
...the character is appended to $result.
$result ~= $c;
}
The nesting level is incremented.
$level++;
}
If the character is a close parenthesis...
elsif $c eq q{)} {
...the nesting level is decremented.
$level--;
If it is still greater than 0, the character is appended to $result.
if $level > 0 {
$result ~= $c;
}
}
}
Finally, $result is printed enclosed in quotation marks like in the spec.
say "\"$result\"";
The Perl version works exactly the same as in Raku.
my $level = 0;
my $result = q{};
for my $c (split //, $str) {
if ($c eq q{(}) {
if ($level > 0) {
$result .= $c;
}
$level++;
}
elsif ($c eq q{)}) {
$level--;
if ($level > 0) {
$result .= $c;
}
}
}
say "\"$result\"";