Perl Weekly Challenge 132.

My solutions (task 1, and task 2 ) to the The Weekly Challenge - 132.

Task 1: Mirror Dates

Submitted by: Mark Anderson
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 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.

In principle the task is easy. You just subtract the given date D from todays date T to obtain de difference d. Then, the result is clearly the pair D-d and T+d. The complexity comes from subtracting dates and adding positive and negative numbers to dates. You would have to consider the length of the different months, the rules for determining leap years (every four years except multiples of 100, except for multiples of 400…). Thus I use a convenient module. I guess there are several alternatives, but I found DateTime on my system and installed DateTime::Format::DateParse to interpret date strings. I truncate the datetimes to days, so that there are no confusions due to the time of day and adding and subtracting fractions of day. The date is passed as the first argument in the command line. An optional second parameter is available to change the “current” date. I use the ISO standard for printing dates.

# Perl weekly challenge 131
# Task 1:  Consecutive arrays
#
# See https://wlmb.github.io/2021/09/28/PWC132/#task-1-mirror-dates

use v5.12;
use warnings;
use DateTime;
use DateTime::Format::DateParse;
my ($date_s, $current_s)=@ARGV;
my $date=DateTime::Format::DateParse->parse_datetime($date_s)->truncate(to=>'day');
die "Wrong date: ", $date_s//"" unless defined $date;
my $current=DateTime::Format::DateParse->parse_datetime($current_s)->truncate(to=>'day');
die "Wrong date: ", $current_s//"" if not defined $current and defined $current_s;
$current//=DateTime->today->truncate(to=>'day');
my $difference=$current-$date;
my $previous=$date-$difference;
my $next=$current+$difference;
say sprintf "Input: %s,  Current: %s\nOutput: %s, %s",
    map {$_->ymd} ($date, $current, $previous, $next);

Example 1:

./ch-1.pl 2021/09/18 2021/09/22

Results:

Input: 2021-09-18,  Current: 2021-09-22
Output: 2021-09-14, 2021-09-26

Example 2:

./ch-1.pl 1975/10/10 2021/09/22

Results:

Input: 1975-10-10,  Current: 2021-09-22
Output: 1929-10-28, 2067-09-04

This result is one day off from the given example!

Example 3:

./ch-1.pl 1967/02/14 2021/09/22

Results:

Input: 1967-02-14,  Current: 2021-09-22
Output: 1912-07-06, 2076-04-30

This also differs from the given example.

I wonder if the differences are due to the time of day where the examples were run, as it is ambiguous what to do if the difference between the given and current dates is fractional. Should it be rounded? Should it be truncated? In my code I eliminated this ambiguity by truncating the time of day, eliminating hours, minutes and seconds from the datetimes.

Further examples: I run same three examples above but with the actual date I’m writing this (the default).

./ch-1.pl 2021/09/18
./ch-1.pl 1975/10/10
./ch-1.pl 1967/02/14

Results:

Input: 2021-09-18,  Current: 2021-09-28
Output: 2021-09-08, 2021-10-07
Input: 1975-10-10,  Current: 2021-09-28
Output: 1929-10-22, 2067-09-15
Input: 1967-02-14,  Current: 2021-09-28
Output: 1912-06-30, 2076-05-11

Task 2: Hash Join

Submitted by: Mohammad S Anwar
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
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’ll assume that the tuples are input in STDIN as two YAML arrays and that the indices to use in the join are given in the command line. Given the indices I build a hash from the build input. Then I scan the probe input. For each record I produce output tuples from each matching entry in the hash.

# Perl weekly challenge 132
# Task 2: Hash join
#
# See https://wlmb.github.io/2021/09/28/PWC132/#task-2-hash-join
use v5.24; # To use the funny syntax ->@*
use warnings;
use YAML::XS;

my ($index_build, $index_probe)= map {shift} @ARGV; # indices for join comparison
$/=''; #slurp
my $input=Load(my $data=<>); # Parse input
my @build=$input->[0]->@*; # Array of build tuples
my @probe=$input->[1]->@*; # Array of probe tuples
my %build; # Build hash. Each entry is array of tuples.
# Build complete 'build' hash. I assume it fits in memory.
push $build{$_->[$index_build]}->@*,  $_ foreach(@build);
foreach my $tuple(@probe){ # Iterate over probe tuples
    my $key=splice @$tuple,$index_probe,1; # remove and assign key
    # Array of all matching build tuples. Empty if none
    my @matching=defined $build{$key}?$build{$key}->@*:(); # first parts of
    say join ", ", $_->@*, @$tuple foreach @matching; # Join one build one probe tuple
}

Example:

./ch-2.pl 1 0 <<EOF
-
  - [ 20, Alex ]
  - [ 28, Joe ]
  - [ 38, Mike ]
  - [ 18, Alex ]
  - [ 25, David ]
  - [ 18, Simon ]
-
  - [Alex, Stewart]
  - [Joe,  Root]
  - [Mike, Gatting]
  - [Joe,  Blog]
  - [Alex, Jones]
  - [Simon, Duane]
EOF

Results:

20, Alex, Stewart
18, Alex, Stewart
28, Joe, Root
38, Mike, Gatting
28, Joe, Blog
20, Alex, Jones
18, Alex, Jones
18, Simon, Duane
Written on September 28, 2021