Merge pull request #12471 from mauke/challenge-333

add perl solutions for 333

2 files changed, 80 insertions, 0 deletions

diff --git a/challenge-333/mauke/perl/ch-1.pl b/challenge-333/mauke/perl/ch-1.pl
new file mode 100644
index 0000000000..033213aecb
--- /dev/null
+++ b/challenge-333/mauke/perl/ch-1.pl
@@ -0,0 +1,48 @@
+use v5.40;
+
+sub gcd($x, $y) {
+    while () {
+        ($x, $y) = ($y, $x)
+            if $x > $y;
+        return $y
+            if $x == 0;
+        my $d = $y - $x;
+        $y = $x;
+        $x = $d;
+    }
+}
+
+sub shifted(@points) {
+    map {
+        my $vx = $_->[0] - $points[0][0];
+        my $vy = $_->[1] - $points[0][1];
+        $vx && $vy ? [$vx, $vy] : ()
+    } @points
+}
+
+sub reduce($f) {
+    my $t = gcd $f->[0], $f->[1];
+    [ $f->[0] / $t, $f->[1] / $t ]
+}
+
+sub forms_straight_line(@points) {
+    my @shifted = shifted @points
+        or return true;
+    my $g = reduce shift @shifted;
+    for my $point (@shifted) {
+        my $f = reduce $point;
+        $f->[0] == $g->[0] && $f->[1] == $g->[1]
+            or return false;
+    }
+    true
+}
+
+for my $input (
+    [[2, 1], [2, 3], [2, 5]],
+    [[1, 4], [3, 4], [10, 4]],
+    [[0, 0], [1, 1], [2, 3]],
+    [[1, 1], [1, 1], [1, 1]],
+    [[1000000, 1000000], [2000000, 2000000], [3000000, 3000000]],
+) {
+    say forms_straight_line(@$input) ? "true" : "false";
+}
diff --git a/challenge-333/mauke/perl/ch-2.pl b/challenge-333/mauke/perl/ch-2.pl
new file mode 100644
index 0000000000..4733a4147b
--- /dev/null
+++ b/challenge-333/mauke/perl/ch-2.pl
@@ -0,0 +1,32 @@
+use v5.36;
+
+sub dupz(@v) {
+    my @r = map $_ || (0, 0), @v;
+    splice @r, @v;
+    @r
+}
+
+sub dupz2(@v) {
+    my @r;
+    for my $v (@v) {
+        for my $x ($v || (0, 0)) {
+            push @r, $x;
+            return @r if @r >= @v;
+        }
+    }
+}
+
+for my $input (
+    [1, 0, 2, 3, 0, 4, 5, 0],
+    [1, 2, 3],
+    [1, 2, 3, 0],
+    [0, 0, 1, 2],
+    [1, 2, 0, 3, 4],
+) {
+    my @result = dupz @$input;
+    my @result2 = dupz2 @$input;
+    say "(@$input)";
+    say "a: (@result)";
+    say "b: (@result2)";
+    say "";
+}