Merge pull request #4940 from choroba/ech132

Add solutions to 132: Mirror Dates & Hash Join by E. Choroba

2 files changed, 98 insertions, 0 deletions

diff --git a/challenge-132/e-choroba/perl/ch-1.pl b/challenge-132/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..6d3831dc9e
--- /dev/null
+++ b/challenge-132/e-choroba/perl/ch-1.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Time::Piece;
+
+# This should return localtime, but in order to verify the examples,
+# we need to set today to Wednesday September the 22nd.
+sub today {
+    return 'Time::Piece'->strptime('2021/09/22', '%Y/%m/%d');
+}
+
+sub mirror_dates {
+    my ($birthdate) = @_;
+    my $birthday = 'Time::Piece'->strptime($birthdate, '%Y/%m/%d');
+    my $today = today();
+    my $age = $today - $birthday;
+    return [map $_->ymd('/'),
+                $birthday - $age,
+                $today + $age]
+}
+
+use Test2::V0;
+plan 3;
+
+is mirror_dates('2021/09/18'),
+    ['2021/09/14', '2021/09/26'],
+    'Example 1';
+
+is mirror_dates('1975/10/10'),
+    ['1929/10/27', '2067/09/05'],
+    'Example 2';
+
+is mirror_dates('1967/02/14'),
+    ['1912/07/08', '2076/04/30'],
+    'Example 3';
+
diff --git a/challenge-132/e-choroba/perl/ch-2.pl b/challenge-132/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..bea7fb3bf1
--- /dev/null
+++ b/challenge-132/e-choroba/perl/ch-2.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+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 ($build, $probe, $limit) = @_;
+    my @out;
+    my %hash;
+    my $size = 0;
+    my $out = sub {
+        for my $s (@$probe) {
+            push @out, [$_, $s->[0], $s->[1]]
+                for @{ $hash{ $s->[0] } // []};
+        }
+        %hash = ();
+        $size = 0;
+    };
+    for my $r (@$build) {
+        push @{ $hash{ $r->[1] } }, $r->[0];
+        $out->() if ++$size >= $limit;
+    }
+    $out->();
+    return \@out
+}
+
+use Test2::V0;
+plan 6;
+
+for my $limit (1 .. 6) {
+    is hash_join(\@player_ages, \@player_names, $limit),
+        bag {
+            item [20, "Alex", "Stewart"];
+            item [20, "Alex", "Jones"];
+            item [18, "Alex", "Stewart"];
+            item [18, "Alex", "Jones"];
+            item [28, "Joe", "Root"];
+            item [28, "Joe", "Blog"];
+            item [38, "Mike", "Gatting"];
+            item [18, "Simon", "Duane"];
+            end();
+        }, "Limit $limit";
+}