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 Cross` has 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{/});
``````

(Full code on Github.)

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);
``````

(Full code on Github.)

...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];
}
``````

(Full code on Github.)

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];
}
``````

(Full code on Github.)