Perl Weekly Challenge: Week 224
Challenge 1:
Special Notes
You are given two strings,
$sourceand$target.Write a script to find out if using the characters (only once) from source, a target string can be created.
Example 1
Input: $source = "abc"
$target = "xyz"
Output: false
Example 2
Input: $source = "scriptinglanguage"
$target = "perl"
Output: true
Example 3
Input: $source = "aabbcc"
$target = "abc"
Output: true
Once again, we can solve this in Raku as a one-liner.
say bag(@*ARGS[1].comb) ⊆ bag(@*ARGS[0].comb);
We use .comb to split the $source and $target arguments which we get from the command line. The resulting
arrays are used to initialize Bags. This datatype is like a multiset in C++ i.e. it can hold multiple items with
the same value (letters in this case.) Then we just check to see if the target bag is a subset of the source bag
with the subset or equal operator ⊆.
For Perl we can emulate Bags with a hash that has letters as keys and the number of times that letter occured
as values. The makeBag() function below handles that.
sub makeBag {
my ($string) = @_;
my %bag;
for my $c (split //, $string) {
$bag{$c}++;
}
return %bag;
}
Then we can make these pseudo-bags out of $source and $target just as in Raku.
my %s = makeBag($source);
my %t = makeBag($target);
Finding if $target is a subset of $source is a little tricky. I did it by grep()ing through
the keys of the target bag and filtering out those which do not exist in the source bag or whose values
(i.e. letter frequency) is less than the value of the same key in the source bag. If any such keys
were found, $target is not a subset of $source otherwise it is.
say 0+(scalar grep { !exists $s{$_} || $s{$_} < $t{$_} } keys %t) ? 'false' : 'true';
Challenge 2:
Additive Numbers
You are given a string containing digits
0-9only.Write a script to find out if the given string is additive number. An additive number is a string whose digits can form an additive sequence.
A valid additive sequence should contain at least 3 numbers. Except the first 2 numbers, each subsequent number in the sequence must be the sum of the preceding two.
Example 1
Input: $string = "112358"
Output: true
The additive sequence can be created using the given string digits: 1,1,2,3,5,8
1 + 1 => 2
1 + 2 => 3
2 + 3 => 5
3 + 5 => 8
Example 2
Input: $string = "12345"
Output: false
No additive sequence can be created using the given string digits.
Example 3
Input: $string = "199100199"
Output: true
The additive sequence can be created using the given string digits: 1,99,100,199
1 + 99 => 100
99 + 100 => 199
OK I'll admit it; I had only the foggiest idea of how to procede with this. After some failed attempts, I looked for clues on the Internet and found this page which has example code for solving similar problems. What I am going to show below is based on that.
The core of the script is this. We try and create an additive sequence as an array and if we were successful (i.e. the array is not empty) we print True otherwise false.
say additiveSequence($string).elems > 0;
additiveSequnce() is the function that looks for the sequence.
sub additiveSequence($n) {
We need a space to store the resulting sequence.
my @res;
We also need to know the length of the input number (i.e. how many digits it has.) my $l = $n.chars;
Then we loop through those digits checking two numbers at a time. (a number may be more than one digit as in e.g. example 3.) We only need to go halfway because if the first number is any bigger, it would be impossible to form a sequence. The outer loop forms the first number...
for 1 .. $l div 2 + 1 -> $i {
...while the inner forms the second number.
for 1 .. ($l - $i) div 2 + 1 -> $j {
All the digits not in the first two numbers are potentially in the number that results from the first two.
checkAddition(), mentioned below, tests that.
if checkAddition(@res, $n.substr(0, $i), $n.substr($i, $j), $n.substr($i + $j)) {
If the test was true, we add the first two numbers to the start of the additive sequence we are constructing and return the sequence.
@res.unshift($n.substr($i, $j));
@res.unshift($n.substr(0, $i));
return @res;
}
}
}
If we have managed to reach here, it means we didn't find an additive sequence so we just return an empty list.
return ();
}
checkAddition() is a function that determines if the sum of two numbers in the sequence (let's call them $a and $b) are equal to a third number (which we shall call $c) It is called recursively because we don't know how
many digits long $c might be.
sub checkAddition(@res, $a, $b, $c) {
Both $a and $b should be valid numbers. If they aren't, this function will return False. The isValid() function will be described below.
if !isValid($a) || !isValid($b) {
return False;
}
The sum of $a + $b is calculated.
my $sum = $a + $b;
If $a + $b = $c then return True.
if $sum == $c {
@res.push($sum);
return True;
}
If $sum has more digits than $c or the digits in $sum do not make up
the initial digits in $c, we will not be able to form another element for the
additive sequence so we return False.
if $c.chars <= $sum.chars || $sum != $c.substr(0, $sum.chars) {
return False;
If $sum can be found in $c...
} else {
...$sum is added to the results.
@res.push($sum);
The next recursive call will be made to find the next number in the additive sequence.
This time $b will be the first number, $sum the second number and $c minus its initial
digits which make up $sum will be the third number.
return checkAddition(@res, $b, $sum, $c.substr($sum.chars));
}
}
The numbers used as $a and $b in checkAddition() either have to be one digit long or not start with a 0
if they are more than one digit long. The isValid() function tests for these criteria.
# Checks whether num is valid or not, by checking first character and size
sub isValid($num) {
return $num.chars < 2 || $num.substr(0, 1) != '0';
}
This is the Perl version.
sub isValid {
my ($num) = @_;
return length $num < 2 || substr($num, 0, 1) != '0';
}
sub checkAddition {
my ($res, $a, $b, $c) = @_;
if (!isValid($a) || !isValid($b)) {
return undef;
}
my $sum = $a + $b;
if ($sum eq $c) {
push @{$res}, $sum;
return 1;
}
if (length $c <= length $sum || $sum != substr($c, 0, length $sum)) {
return undef;
} else {
push @{$res}, $sum;
return checkAddition($res, $b, $sum, substr($c, length $sum));
}
}
sub additiveSequence {
my ($n) = @_;
my @res;
my $l = length $n;
for my $i (1 .. int($l / 2) + 1) {
for my $j (1 .. int(($l - $i) / 2) + 1) {
if (checkAddition(\@res, substr($n, 0, $i), substr($n, $i, $j), substr($n, $i + $j))) {
unshift @res, substr($n, $i, $j);
unshift @res, substr($n, 0, $i);
return @res;
}
}
}
return ();
}
my $num = shift @ARGV;
my @seq = additiveSequence($num);
say scalar @seq > 0 ? 'true' : 'false';