Perl Weekly Challenge: Week 237
Challenge 1:
Seize The Day
Given a year, a month, a weekday of month, and a day of week (1 (Mon) .. 7 (Sun)), print the day.
Example 1
Input: Year = 2024, Month = 4, Weekday of month = 3, day of week = 2
Output: 16
The 3rd Tue of Apr 2024 is the 16th
Example 2
Input: Year = 2025, Month = 10, Weekday of month = 2, day of week = 4
Output: 9
The 2nd Thu of Oct 2025 is the 9th
Example 3
Input: Year = 2026, Month = 8, Weekday of month = 5, day of week = 3
Output: 0
There isn't a 5th Wed in Aug 2026
I love calendar problems. Perl has the best libraries for time and date problems in any major programming language in my opinion.
After getting the scripts parameters from the command-line...
my ($year, $month, $weekday, $dayofweek) = @ARGV;
...the first step is to create a DateTime object set to the first of the month specified in
the year specified. For this you have to use DateTime; at the top of the script. Normally
I don't use external modules in these solutions but it is well worth it in this case considering
the many edge cases and gotchas in calendar maths.
my $dt = DateTime->new(year => $year, month => $month, day => 1);
We need to know the difference between the day of week on the first of the month and the
day of week we are looking for. We are only interested in the magnitude of the difference not
the direction so I used the abs() function to avoid a negative result.
my $diff = abs($dayofweek - $dt->day_of_week);
Now we can calculate the date we are looking for. We subtract one from $weekday because
we are going to count weeks from the 0th one not the 1st. Then we multiply
that by 7 because there are seven days in a week and add the difference calculated in the last
line to the result. This is the number of days to be added to the DateTime object to get the
the date we want. (As we are already on the 1st of the month 1 is added.)
$dt->set(day => 1 + (7 * ($weekday - 1)) + $diff);
This will work for the first two examples but in the third, the date is invalid. In this case
DateTime throws an exception. We can catch it by enclosing the line in an eval() block.
eval { $dt->set(day => 1 + (7 * ($weekday - 1)) + $diff); };
If an exception was raised it is caught by this block. Adding use English; at the top of the script allows you to use the more descriptive EVAL_ERROR instead of $@. We print an error message in the format shown in the examples.
if ($EVAL_ERROR) {
$dt->set(day => 1 + $diff + 1);
say "There isn't a ", $weekday, ' ', $dt->day_abbr,' in ',
$dt->month_abbr, ' ', $year;
If there was no execption, we print the results, again, in the format shown in the examples.
} else {
say 'The ', $weekday, ' ', $dt->day_abbr,' of ', $dt->month_abbr,
' ', $year, ' is the ', $dt->day;
}
My output doesn't look quite the same as the examples though because in several places the latter
has the ordinal form of a number i.e. 1st, 2nd etc. Unfortunately DateTime doesn't have any
way of creating them so I wrote my own function.
ordinal() looks like this:
sub ordinal {
my ($day) = @_;
return $day . (
($day % 10 == 1 && $day != 11)
? 'st'
: ($day % 10 == 2 && $day != 12)
? 'nd'
: ($day % 10 == 3 && $day != 13)
? 'rd'
: "th"
);
}
Now I can go back to my previous output code and improve it.
if ($EVAL_ERROR) {
$dt->set(day => 1 + $diff + 1);
say "There isn't a ", ordinal($weekday), ' ', $dt->day_abbr,' in ',
$dt->month_abbr, ' ', $year;
} else {
say 'The ', ordinal($weekday), ' ', $dt->day_abbr,' of ', $dt->month_abbr,
' ', $year, ' is the ', ordinal($dt->day);
}
This is the Raku version:
sub MAIN(
$year, $month, $weekday, $dayofweek
) {
Raku's equivalent to DateTime is the Date class.
my $dt = Date.new(year => $year, month => $month, day => 1);
my $diff = abs($dayofweek - $dt.day-of-week);
You add days to a Date object like this:
$dt += (7 * ($weekday - 1)) + $diff;
Unlike DateTime, Date doesn't have functions for day and month abbreviations so
I added my own lookup tables. This is less flexible because it is English-only instead
of localizing to the users language as DateTime does via DateTime::Locale but
it is good enough for the current purpose.
my %d_abbr = (
1 => 'Mon',
2 => 'Tue',
3 => 'Wed',
4 => 'Thu',
5 => 'Fri',
6 => 'Sat',
7 => 'Sun',
);
my %m_abbr = (
1 => 'Jan',
2 => 'Feb',
3 => 'Mar',
4 => 'Apr',
5 => 'May',
6 => 'Jun',
7 => 'Jul',
8 => 'Aug',
9 => 'Sep',
10 => 'Oct',
11 => 'Nov',
12 => 'Dec',
);
Instead of throwing an exception when the days of a month are out of range, Date just continues
on to the next month.
So if the month in $dt is not the month we specified, we print the error meesage.
if $dt.month != $month {
say "There isn't a ", ordinal($weekday), ' ', %d_abbr{$dayofweek},
' in ', %m_abbr{$month}, ' ', $year;
Else we print the result message.
} else {
say 'The ', ordinal($weekday), ' ', %d_abbr{$dayofweek},' of ',
%m_abbr{$month}, ' ', $year, ' is the ', ordinal($dt.day);
}
}
In both cases we use an ordinal() function which works exactly the same as in Perl.
sub ordinal($day) {
return $day ~ (
$day % 10 == 1 && $day != 11
?? 'st'
!! $day % 10 == 2 && $day != 12
?? 'nd'
!! $day % 10 == 3 && $day != 13
?? 'rd'
!! "th"
);
}
Challenge 2:
Maximize Greatness
You are given an array of integers.
Write a script to permute the give array such that you get the maximum possible greatness.
To determine greatness, nums[i] < perm[i] where 0 <= i < nums.length
Example 1
Input: @nums = (1, 3, 5, 2, 1, 3, 1)
Output: 4
One possible permutation: (2, 5, 1, 3, 3, 1, 1) which returns 4 greatness as below:
nums[0] < perm[0]
nums[1] < perm[1]
nums[3] < perm[3]
nums[4] < perm[4]
Example 2
Input: @ints = (1, 2, 3, 4)
Output: 3
One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below:
nums[0] < perm[0]
nums[1] < perm[1]
nums[2] < perm[2]
A variable is defined to hold the maximum greatness score found so far. (Initially it will be 0.)
my $maxGreatness = 0;
Raku has a .permutations() method built in so it is very easy to get all permutations of the input.
for @nums.permutations -> $perm {
For each permutation, elements are compared to their corresponding element in the original input one by one.
This is easy to achieve with the Z operator which takes two lists and "zips" them, successively producing pairs
of elements, first the 0th ones from each list, then the 1st elements, 2nd and so on. We .grep() through these
pairs looking for ones where the first element is less than the second one. .elems() counts how many such
pairs were found; this is the greatness score.
my $greatness = (@nums Z @$perm).grep({ @$_[0] < @$_[1 ]}).elems;
If the greatness of the current permutation is greater than the current maximum greatness, it becomes
the new value of $maxGreatness.
if $greatness > $maxGreatness {
$maxGreatness = $greatness;
}
}
After all permutations have been examined, we output the value of $maxGreatness.
say $maxGreatness;
The Perl version has some slight differences.
my $maxGreatness = 0;
We don't have a .permutations() equivalent. Luckily this has come up several times
before so I was able to reuse code from previous challenges.
my @permutations;
permute { push @permutations, \@_; } @nums;
for my $perm (@permutations) {
my $greatness = 0;
There is no Z either so I just went through all the indices from 0 to the end of the permutation
(which is the same number as the end of @nums so I could have used that instead.)
for my $i (0 .. scalar @{$perm} - 1) {
if ($nums[$i] < $perm->[$i]) {
$greatness++;
}
}
if ($greatness > $maxGreatness) {
$maxGreatness = $greatness;
}
}
say $maxGreatness;