2 files changed, 135 insertions, 0 deletions
diff --git a/challenge-123/perlboy1967/perl/ch-1.pl b/challenge-123/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..817161e3f1
--- /dev/null
+++ b/challenge-123/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 123
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-123/#TASK1
+#
+# Task 1 - Ugly Numbers
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use List::Util qw(min);
+
+use Test::More;
+
+# Prototype(s)
+sub uglyNumberN($);
+
+
+my $tests = [ 
+   [  1, 1 ],
+   [  2, 2 ],
+   [  3, 3 ],
+   [  4, 4 ],
+   [  5, 5 ],
+   [  6, 6 ],
+   [  6, 6 ],
+   [  7, 8 ],
+   [  9, 10],
+   [ 10, 12],
+   [100, 1536],
+];
+
+foreach my $t (@$tests) {
+  is(uglyNumberN($t->[0]),$t->[1]);
+}
+
+done_testing();
+
+
+#
+# Blatently 'borrowed' solution using Dynamic Programming from:
+# https://www.codesdope.com/blog/article/ugly-numbers/
+#
+sub uglyNumberN($) {
+  my ($n) = @_;
+
+  my @uN = (1);
+
+  # indices for multiples of 2,3,5 respectively
+  my ($u2, $u3, $u5) = (0,0,0);
+
+  # initial multiple value
+  my ($m2, $m3, $m5) = (2,3,5);
+
+  for my $i (1 .. $n - 1) {
+    $uN[$i] = min($m2, $m3, $m5);
+
+    $m2 = $uN[++$u2] * 2 if ($uN[$i] == $m2);
+    $m3 = $uN[++$u3] * 3 if ($uN[$i] == $m3);
+    $m5 = $uN[++$u5] * 5 if ($uN[$i] == $m5);
+  }
+
+  return $uN[$n-1];
+}
+
diff --git a/challenge-123/perlboy1967/perl/ch-2.pl b/challenge-123/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..cabec1e3e8
--- /dev/null
+++ b/challenge-123/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 123
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-123/#TASK2
+#
+# Task 1 - Square Points
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use List::MoreUtils qw(frequency);
+
+use Test::More;
+
+# Prototype(s)
+sub areSquarePoints(\@);
+
+
+my $tests = [ 
+   [ [10,20],[20,20],[20,10],[10,10], 1 ],
+   [ [12,24],[16,10],[20,12],[18,16], 0 ],
+   [ [10,24],[12,24],[10,12],[18,16], 0 ],
+   [ [20,20],[20,10],[10,10],[10,20], 1 ],
+   [ [ 0, 1],[ 1, 2],[ 2, 1],[ 1, 0], 1 ],
+   [ [-5, 0],[ 5, 0],[ 0, 1],[ 0,-1], 0 ],
+   [ [-1, 0],[ 5, 0],[ 0, 1],[ 0,-1], 0 ],
+];
+
+foreach my $t (@$tests) {
+  my $res = pop(@$t);
+  is(areSquarePoints(@$t),$res);
+}
+
+done_testing();
+
+
+sub areSquarePoints(\@) {
+  my ($ar) = @_;
+
+  my @dP;
+
+  # If all points given are coordinates of a square
+  # then the distance between one point and the other three
+  # will give 2 identical and on other
+  foreach my $i (0 .. 3) {
+    my @d;
+    foreach my $j (0 .. 3) {
+      next if ($i == $j);
+      push(@d,sqrt(($ar->[$i][0]-$ar->[$j][0])**2 +
+                   ($ar->[$i][1]-$ar->[$j][1])**2));
+    }
+    my %f = frequency @d;
+    push(@dP,keys %f);
+  }
+
+  # If all four points give same distance 'frequencies'
+  # then we have a square
+  my %f = frequency @dP;
+
+  return 1 if (scalar keys %f == 2);
+
+  return 0;
+}
+