Perl Weekly Challenge: Week 138
I guess this weeks theme is "recycling." Both my solutions to the challenges relied on code I had written for previous challenges.
Challenge 1:
Workdays
You are given a year,
$yearin 4-digits form.Write a script to calculate the total number of workdays in the given year.
For the task, we consider, Monday - Friday as workdays.
Example 1
Input: $year = 2021
Output: 261
Example 2
Input: $year = 2020
Output: 262
Case in point, just last week there
was a problem which involved finding out the first day of the year. The p() function from there will come in handy here.
sub p(Int $year) {
return (($year + ($year div 4) - ($year div 100) + ($year div 400)) % 7);
}
We will also need to know if this is a leap year. I also have a function ready for that.
sub isLeap(Int $year) {
return $year %% 4 && ($year !%% 100 || $year %% 400);
}
Now we can figure out the answer.
sub MAIN(Int $year) {
Every year has atleast 52 weeks so we know it's going to have at least 260 (52 x 5) work days.
my $workDays = 260;
But 52 weeks is only 364 days and a year has 365. What about that extra day? Well, if you think about it, the last day of the year is going to be the same as the first one. So if the first day is a work day, we can add one to our count. That's what the code below does.
my $firstDay = p($year);
if $firstDay ~~ 1 .. 5 {
$workDays++;
}
There is one other situation to consider. In a leap year, there are 366 days. In a leap year, the last day will be a work day in every case except if the first day was a Monday. Now, there is probably a mathematical way to prove this but I actually looked at a
lot of different years (the Unix cal command is so helpful) to determine this.
if isLeap($year) && $firstDay != 1 {
$workDays++;
}
say $workDays;
}
For completeness, here is the Perl code.
sub p {
my ($year) = @_;
return (($year + int($year / 4) - int($year / 100) + int($year / 400)) % 7);
}
sub isLeap {
my ($year) = @_;
return $year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0);
}
my $year = shift // die "Need a year\n";
my $workDays = 260;
my $firstDay = p($year);
if ($firstDay > 0 && $firstDay < 6) {
$workDays++;
}
if (isLeap($year) && $firstDay != 1) {
$workDays++;
}
say $workDays;
Challenge 2:
Split Number
You are given a perfect square.
Write a script to figure out if the square root the given number is same as sum of 2 or more splits of the given number.
Example 1
Input: $n = 81
Output: 1
Since, sqrt(81) = 8 + 1
Example 2
Input: $n = 9801
Output: 1
Since, sqrt(9801) = 98 + 0 + 1
Example 3
Input: $n = 36
Output: 0
Since, sqrt(36) != 3 + 6
This one was a lot harder to wrap my head around. Example 2 perfectly illustrates the issue. With two splits
we could have 9 + 80 + 1 or 98 + 0 + 1 or 9 + 8 + 01. With three splits we have to look at 9 + 8 + 0 + 1. And although
the spec says "2 or more" we actually have to deal with one split too (see Example 1 or 3) so we also need to test 9 + 801 or
980 + 1. Raku has .permutations() and .combinations() but I was disappointed to find out they don't do exactly what I need.
#!/usr/bin/raku
sub MAIN(Int $n) {
At least finding the square root was easy.
my $squareRoot = $n.sqrt;
The strategy I adopted was to add a separator between each digit, -, which would be selectively removed when making
all the different combinations. The forbidding looking line below does that converting e.g. 9801 to 9-8-0-1. A problem along
the way is that the Z or zip operator which combines two lists into one, stops once the arrays become unequal in length. So at
first I got 9-8-0-. So I just concatenate the last digit on the end with ~ and .substr().
my $separated = ($n.comb Z~ ('-' xx $n.chars - 1)).join ~ $n.substr(*-1, 1);
We have to consider anywhere from 1 to number of digits minus one splits in various combinations. For example if you wanted two splits in a four digit number, they could be after the first and second, the first and third or the second and third digits. (In hindsight @splits would have been a better variable name than @positions.)
for (1 .. $n.chars - 1).combinations -> @positions {
We have to make a copy of $separated because we will be altering it and we'll need a fresh copy every time we try a combination.
my $s = $separated;
Now for each combination, we remove a particular set of - separators.
for @positions -> $i {
$s.substr-rw(2 * $i - 1, 1) = q{};
}
And then we split the string based on -. This will give us an array of numbers, e.g. 98,0, and 1 or 9, 801 etc.
my @parts = $s.split('-');
We sum those numbers and if they are equal to the square root, we can print 1 and exit.
if ([+] @parts) == $squareRoot {
say 1;
exit;
}
}
If go through all the combinations without a match, we print 0.
say 0;
}
This is the Perl version. I was worried I would have to do it a completely different way because Perl lacks a lot of the bells and whistles that Raku provides but in fact it works exactly like the Raku version because I was able to fill in the gaps with Ztilde(), xx(), combinations(), and sum() functions which I had written previously.
my $squareRoot = sqrt $n;
my $separated = join q{}, Ztilde([split //, $n], [xx('-', length($n) - 1)]);
$separated .= substr $n, -1, 1;
for my $len (0 .. length($n) - 1) {
for my $positions (combinations([0 .. length($n) - 1], $len)) {
my $s = $separated;
for my $i (@{$positions}) {
if ($i != 0) {
substr $s, 2 * $i - 1, 1, q{};
}
}
my @parts = split '-', $s;
if (sum(\@parts) == $squareRoot) {
say 1;
exit;
}
}
}
say 0;