Merge pull request #4955 from wanderdoc/master

Solutions to challenge-132

2 files changed, 151 insertions, 0 deletions

diff --git a/challenge-132/wanderdoc/perl/ch-1.pl b/challenge-132/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..30ba1d9dc8
--- /dev/null
+++ b/challenge-132/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,63 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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.
+
+=cut
+
+
+
+
+
+use Time::Piece;
+use Time::Seconds;
+
+
+
+my $FORMAT = '%Y/%m/%d';
+
+
+
+sub create_mirror_dates
+{
+     my $date = Time::Piece->strptime($_[0], $FORMAT);
+     my $today = Time::Piece->strptime('2021/09/22', $FORMAT); # or localtime
+     my $difference = $today - $date; # seconds
+     my $first = $date - $difference;
+     my $second = $today + $difference;
+     return $first->ymd('/'), $second->ymd('/'); 
+
+}
+
+print join(" ", create_mirror_dates('2021/09/18')), $/;
+print join(" ", create_mirror_dates('1975/10/10')), $/;
+print join(" ", create_mirror_dates('1967/02/14')), $/;
\ No newline at end of file
diff --git a/challenge-132/wanderdoc/perl/ch-2.pl b/challenge-132/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..f72bc3f97f
--- /dev/null
+++ b/challenge-132/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,88 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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"
+
+=cut
+
+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"  ],);
+
+
+sub hash_join
+{
+     my ( $tbl_1, $idx_1, $tbl_2, $idx_2 ) = @_;
+     my %seen;
+     my @groups = grep { not $seen{$_}++ } map { $_->[$idx_1] }  @{$tbl_1};
+     
+     my @output;
+
+
+     for my $name ( @groups )
+     {
+          my @slice = grep { $_->[$idx_1] eq $name } @{$tbl_1};
+
+          for my $probe ( grep { $_->[$idx_2] eq $name } @{$tbl_2} )
+          {
+               for my $item ( @slice )
+               {
+
+                    push @output, [@$item, $probe->[1]];
+               }
+          }
+     }
+
+     return @output;
+}
+
+
+
+my @result = hash_join(\@player_ages, 1, \@player_names, 0);
+print join(',', @$_), $/ for @result;
\ No newline at end of file