Perl Weekly Challenge: Week 132
Challenge 1:
Pandigital Numbers
You are given a date (yyyy/mm/dd).
Assuming, the given date is your date of birth. Write a script to find the mirror dates of the given date.
Dave Crosshas built a cool site that does something similar.
Assuming today is 2021/09/22.
Example 1
Input: 2021/09/18
Output: 2021/09/14, 2021/09/26
On the date you were born, someone who was your current age, would have been born on 2021/09/14.
Someone born today will be your current age on 2021/09/26.
Example 2
Input: 1975/10/10
Output: 1929/10/27, 2067/09/05
On the date you were born, someone who was your current age, would have been born on 1929/10/27.
Someone born today will be your current age on 2067/09/05.
Example 3
Input: 1967/02/14
Output: 1912/07/08, 2076/04/30
On the date you were born, someone who was your current age, would have been born on 1912/07/08.
Someone born today will be your current age on 2076/04/30.
Dates and calendrical calculations are an abiding interest of mine. if there is one thing I have learned, it is that something so heavily intertwined with human cultures is full of special cases and gotchas so I definitely prefer using existent tried and tested code over rolling my own. Raku for instance has a class in its' standard library for dates which has everything we need to solve this problem so I used it.
This is my birthday:
my $birthday = Date.new('1971-03-22');
...and this Date object represents todays date:
my $today = Date.today;
...so the difference between the two dates in days can be derived with a simple subtraction. No need to worry about leap years, partial months etc. Raku will take care of all that.
my $diff = $today - $birthday;
Similarly the two dates we need to output can also be derived with simple arithmetic.
my $past = $birthday - $diff;
my $future = $today + $diff;
The only minor complication is making the output look exactly like that shown in the spec. Luckily the Raku Date class
has methods for that too.
say $past.yyyy-mm-dd(q{/}), q{, }, $future.yyyy-mm-dd(q{/});
For Perl, I used the DateTime library from CPAN.
use DateTime;
I thought this code which is a straight translation from Raku would work and at first it seemed to.
my $birthday = DateTime->new(year => 1971, month => 3, day => 22);
my $today = DateTime->today;
my $diff = $today - $birthday;
my $past = $birthday - $diff;
my $future = $today + $diff;
say $past->ymd(q{/}), q{, }, $future->ymd(q{/});
But as I tried verious examples, I noticed the answers were often slightly off when compared to the Raku version. After thinking about it for a while, it suddenly dawned on me why. Internally, Rakus' Date class is using Julian days (not to be confused with the Julian Calendar) for date arithmetic. A Julian day begins at noon. Whereas the Perl DateTime class starts a day at midnight. It can also use Julian days so when
that correction was made to the code like this:
my $diff = $today->jd - $birthday->jd;
my $past = $birthday->subtract(days => $diff);
my $future = $today->add(days => $diff);
...I got the same answers as in Raku. I told you working with dates is hard.
Challenge 2:
Hash Join
Write a script to implement Hash Join algorithm as suggested by wikipedia.
1. For each tuple r in the build input R
1.1 Add r to the in-memory hash table
1.2 If the size of the hash table equals the maximum in-memory size:
1.2.1 Scan the probe input S, and add matching join tuples to the output relation
1.2.2 Reset the hash table, and continue scanning the build input R
2. Do a final scan of the probe input S and add the resulting join tuples to the output relation
Example 1
Input:
@player_ages = (
[20, "Alex" ],
[28, "Joe" ],
[38, "Mike" ],
[18, "Alex" ],
[25, "David" ],
[18, "Simon" ],
);
@player_names = (
["Alex", "Stewart"],
["Joe", "Root" ],
["Mike", "Gatting"],
["Joe", "Blog" ],
["Alex", "Jones" ],
["Simon","Duane" ],
);
Output:
Based on index = 1 of @players_age and index = 0 of @players_name.
20, "Alex", "Stewart"
20, "Alex", "Jones"
18, "Alex", "Stewart"
18, "Alex", "Jones"
28, "Joe", "Root"
28, "Joe", "Blog"
38, "Mike", "Gatting"
18, "Simon", "Duane"
I dont think I've exactly followed the algorithm mentioned in the spec but my solution seems to work.
In Raku:
Contrary to what the title seems to suggest, the output requested looks like an array. So I have treated it as such in my solution. This is where we will place the results:
my @output;
These are the two arrays to be merged according to the example:
my @player_ages = (
[20, "Alex" ],
[28, "Joe" ],
[38, "Mike" ],
[18, "Alex" ],
[25, "David" ],
[18, "Simon" ],
);
my @player_names = (
["Alex", "Stewart"],
["Joe", "Root" ],
["Mike", "Gatting"],
["Joe", "Blog" ],
["Alex", "Jones" ],
["Simon","Duane" ],
);
As in several other recent challenges, a lot of the work involved in this solution is simply how to format everything nicely. These variables will hold the maximum width of each of the three columns in the output.
my $col0length = 0;
my $col1length = 0;
my $col2length = 0;
For each row in @player_ages, we go through @player_names:
for @player_ages -> @r {
for @player_names -> @s {
If the second column in @player_ages is the same as the first column in @player_names:
if @r[1] eq @s[0] {
...an array consisting of the two columns of @player_ages plus the first column in @player_names is added to @output:
@output.push([ @r[0], "\"@r[1]\"", "\"@s[1]\"" ]);
...the width of each column is compared to the current maximum width for that column. If the length is longer, it becomes the new maximum:
if @r[0].chars > $col0length {
$col0length = @r[0].chars;
}
if @r[1].chars > $col1length {
$col1length = @r[1].chars;
}
if @s[1].chars > $col2length {
$col2length = @s[1].chars;
}
}
}
}
These lines format each of the arrays in @output so that the columns are aligned correctly and print them:
for @output.sort({ @^a[1] cmp @^b[1] }) -> @row {
printf
"%-{$col0length + 1}s %-{$col1length + 3}s %-{$col2length + 2}s\n",
@row[0] ~ q{,}, @row[1] ~ q{,}, @row[2];
}
This is the Perl version. An annoyance in Perl is that you can only store array references in arrays not the arrays themselves. This means that to access them, you have to use the ungainly -> syntax.
my @output;
my @player_ages = (
[20, "Alex" ],
[28, "Joe" ],
[38, "Mike" ],
[18, "Alex" ],
[25, "David" ],
[18, "Simon" ],
);
my @player_names = (
["Alex", "Stewart"],
["Joe", "Root" ],
["Mike", "Gatting"],
["Joe", "Blog" ],
["Alex", "Jones" ],
["Simon","Duane" ],
);
my $col0length = 0;
my $col1length = 0;
my $col2length = 0;
for my $r (@player_ages) {
for my $s (@player_names) {
if ($r->[1] eq $s->[0]) {
push @output, [ $r->[0], "\"$r->[1]\"", "\"$s->[1]\"" ];
if (length $r->[0] > $col0length) {
$col0length = length $r->[0];
}
if (length $r->[1] > $col1length) {
$col1length = length $r->[1];
}
if (length $s->[1] > $col2length) {
$col2length = length $s->[1];
}
}
}
}
for my $row (sort { $a->[1] cmp $b->[1] } @output) {
printf
"%-${\($col0length + 1)}s %-${\($col1length + 3)}s %-${\($col2length + 2)}s\n",
$row->[0] . q{,}, $row->[1] . q{,}, $row->[2];
}