Perl Weekly Challenge: Week 346
Challenge 1:
Longest Parenthesis
You are given a string containing only
(and).Write a script to find the length of the longest valid parenthesis.
Example 1
Input: $str = '(()())'
Output: 6
Valid Parenthesis: '(()())'
Example 2
Input: $str = ')()())'
Output: 4
Valid Parenthesis: '()()' at positions 1-4.
Example 3
Input: $str = '((()))()(((()'
Output: 8
Valid Parenthesis: '((()))()' at positions 0-7.
Example 4
Input: $str = '))))((()('
Output: 2
Valid Parenthesis: '()' at positions 6-7.
Example 5
Input: $str = '()(()'
Output: 2
Valid Parenthesis: '()' at positions 0-1 and 3-4.
The classic way to solvee this problem using a stack which we represent as a Perl array. We also need to store the maximum length found.
my $max = 0;
You will notice the stack is initialized with an element with the value of -1. The reason for this will be explained below
my @stack = (-1);
Now we split $str into characters with .comb() and go through it character by character. .kv()
gives us the index of the character as well as the character itself.
for $str.comb.kv -> $i, $c {
If the character is an open parenthesis, its' index is .push()ed onto the stack.
if $c eq q{(} {
@stack.push($i);
The spec tells that if the character is not an open parenthesis, it must be a close parenthesis.
} else {
In this case the stack is .pop()ed.
@stack.pop;
If the stack is empty, this means we have a valid parentheses sequence. the current index is pushed as a new anchor (this marks the boundary before any future valid sequence).
if @stack.elems == 0 {
@stack.push($i);
Otherwise we compute the current valid sequence length as the current index minus the value of the top of the stack. This will not work if the sequnce starts at index 0; the answer will be off by 1. This is why we had to place -1 as the initial value on the stack.
} else {
my $len = $i - @stack[*-1];
If the length is greater than $max, it becomes the new value of $max.
if $len > $max {
$max = $len;
}
}
}
}
When we reach the end of $str we print the value of $max.
say $max;
This is the Perl version which works the same way.
my $max = 0;
my @stack = (-1);
my @chars = split //, $str;
for my $i (keys @chars) {
if ($chars[$i] eq q{(}) {
push @stack, $i;
} else {
pop @stack;
unless (scalar @stack) {
push @stack, $i;
} else {
my $len = $i - $stack[-1];
if ($len > $max) {
$max = $len;
}
}
}
}
say $max;
Challenge 2:
Magic Expression
You are given a string containing only digits and a target integer.
Write a script to insert binary operators
+,-and*between the digits in the given string that evaluates to target integer.
Example 1
Input: $str = "123", $target = 6
Output: ("1*2*3", "1+2+3")
Example 2
Input: $str = "105", $target = 5
Output: ("1*0+5", "10-5")
Example 3
Input: $str = "232", $target = 8
Output: ("2*3+2", "2+3*2")
Example 4
Input: $str = "1234", $target = 10
Output: ("1*2*3+4", "1+2+3+4")
Example 5
Input: $str = "1001", $target = 2
Output: ("1+0*0+1", "1+0+0+1", "1+0-0+1", "1-0*0+1", "1-0+0+1", "1-0-0+1")
The MAIN() function is very simple.
We create an object of the DepthFirstSearch class which will be explained below.
As the name suggests, our strategy will be to examine all possible arithmetic expressions made from $str using
a depth-first tree search until we find one which results in the $target value.
my $dfs = DepthFirstSearch.new(str => $str, target => $target);
We use DepthFirstSearchs' .find() and .result() methods to get the final expression. The rest of the
code on this line is only for pretty-printing the output in the style of the spec.
say q{(}, $dfs.find.result.map({ "\"$_\"" }).join(q{, }), q{)};
The DepthFirstSearch class is where the core logic lies.
class DepthFirstSearch {
It has four data members.
$.str and $.target are brought in from the input. The . "twigil" indicates that
they are public and read accessors will be synthesized for them. The is required attribute
means the synthesized class constructor will require them as input as can be seen in MAIN().
has Str $.str is required;
has Int $.target is required;
$!n is private as indicated by the ! twigil. It holds the length of $str so is not strictly
necessary but it is an amount that will be used often so why keep recalculating it?
has Int $!n;
@!result is also private. As the name suggests, it will hold the result of the search.
has @!result;
$!n has to be calculated from $str but it cannot be done at initialization time (i.e.
we can't simply say $!n = $str.chars because $str itself would not have been initialized yet.
Now, I have implemented depth-first search for these challenges before and previously I would have
dealt with such a problem by overriding the new() method. But the right way to do this is
to override BUILD() which is a special submthod (i.e. a public but noninheritable method) that Raku
calls immediately after the object is constructed. In our overriden version we initialize $!n.
Unfortunately this mean we cannot rely on the default initialization of the other members so we have
to handle that too.
submethod BUILD(:$str, :$target) {
$!str = $str;
$!target = $target;
$!n = $str.chars;
@!result = ();
}
The find method kicks off the search process by calling !search() with initial values
and returns @!result.
method find() {
self!search(0, q{}, 0, 0);
return @!result;
}
The !search is private as indicated by the initial !. It will be called
recursively to traverse the list of possible expressions, stopping when it reaches
an expression which results in the target. It takes 4 parameters:
$i: The current position in the string.$expr: The expression built so far.$current: The current value of the expression.$previous: The previous operand. This is needed to solve the problem of operator precedence.method !search($i, $expr, $current, $previous) {
Every recursive function needs a halting condition. Ours is if we've reached the end of the string.
if $i == $!n {
if so, we check if we hit the target.
if $current == $!target {
And if this is true, we add the expression to the result.
@!result.push($expr);
}
In any case we return self so the method can be chained with others. We don't actually have
any other methods but this is a good convention to follow.
return self;
}
If we haven't reached the end of the string, we try different length substrings starting at position $i.
for 1 .. ($!n - $i) -> $len {
my $part = $!str.substr($i, $len);
Numbers with leading zeros get skipped to avoid invalid expressions.
if $part.chars > 1 && $part ~~ /^0/ {
next;
}
my $num = $part.Int;
If this is the first number, we just start building expressions.
if $i == 0 {
self!search($i + $len, $part, $num, $num);
For all subsequent numbers, we try all three operators (*, + and -) considering operator precedence.
} else {
self!search(
$i + $len, $expr ~ '*' ~ $part,
$current - $previous + $previous * $num, $previous * $num);
self!search($i + $len, $expr ~ '+' ~ $part,
$current + $num, $num);
self!search($i + $len, $expr ~ '-' ~ $part,
$current - $num, -$num);
}
}
This line is just to prevent a warning. We should never actually get here.
return self;
}
}
For the Perl version, we are going to use the new OOP features in modern varieties of Perl. For that (and to supress warnings because this feature is still considered experimental,) we need these two lines at the top of the script.
use feature qw/ class /;
no warnings qw/ experimental::class /;
class DepthFirstSearch {
We define data members in a similar way to Raku. Private members and methods are not
implemented yet but we can initialize $n as it is constructed.
field $str :param;
field $target :param;
field $n = length($str);
field @result = ();
The find() and search() methods work the same as in Raku.
method find() {
$self->search(0, '', 0, 0);
return @result;
}
method search($i, $expr, $current, $previous) {
if ($i == $n) {
if ($current == $target) {
push @result, $expr;
}
return $self;
}
for my $len (1 .. ($n - $i)) {
my $part = substr($str, $i, $len);
next if length($part) > 1 && $part =~ /^0/; # skip leading zeros
my $num = int($part);
if ($i == 0) {
$self->search($i + $len, $part, $num, $num);
} else {
$self->search(
$i + $len, $expr . '*' . $part,
$current - $previous + $previous * $num, $previous * $num);
$self->search($i + $len, $expr . '+' . $part,
$current + $num, $num);
$self->search($i + $len, $expr . '-' . $part,
$current - $num, -$num);
}
}
return $self;
}
}
For completeness, here is what the main code looks like in Perl.
my $dfs = DepthFirstSearch->new(str => $str, target => $target);
say q{(}, (join q{, }, map { "\"$_\"" } $dfs->find), q{)};