Easy as 1-2-3 or A-B-C-D

2 files changed, 88 insertions, 0 deletions

diff --git a/challenge-123/dave-jacoby/perl/ch-1.pl b/challenge-123/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..5b61a4aadc
--- /dev/null
+++ b/challenge-123/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+
+use feature qw{say state signatures};
+use strict;
+use warnings;
+use utf8;
+no warnings qw{ experimental };
+
+use Carp;
+use Getopt::Long;
+
+my $n = 8;
+
+GetOptions( 'n=i' => \$n, );
+carp 'Bad Input' unless $n > 0;
+
+my $u = get_ugly($n);
+say "Input:  \$n = $n";
+say "Output: $u";
+
+sub get_ugly ( $n ) {
+    return 1 if $n == 1;
+    my $c = 1;
+    my $u = 0;
+    while (1) {
+        $u++;
+        my $f = 0;
+        $f = 1 if $u % 2 == 0;
+        $f = 1 if $u % 3 == 0;
+        $f = 1 if $u % 5 == 0;
+        $c++      if $f;
+        return $u if $n == $c;
+    }
+}
diff --git a/challenge-123/dave-jacoby/perl/ch-2.pl b/challenge-123/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..2d9cbd34b5
--- /dev/null
+++ b/challenge-123/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+
+use feature qw{say state signatures};
+use strict;
+use warnings;
+use utf8;
+no warnings qw{ experimental };
+
+use JSON;
+
+my $json = JSON->new->canonical;
+my @data = (
+    [ [ 10, 20 ], [ 20, 20 ], [ 20, 10 ], [ 10, 10 ], ],
+    [ [ 12, 24 ], [ 16, 10 ], [ 20, 12 ], [ 18, 16 ], ],
+    [ [ 40, 40 ], [ 50, 30 ], [ 40, 20 ], [ 30, 30 ], ],
+    [ [ 10, 10 ], [ 15, 15 ], [ 20, 15 ], [ 15, 10 ], ],
+);
+
+for my $d (@data) {
+    say $json->encode($d);
+    say is_square($d);
+    say '';
+}
+
+sub is_square($d) {
+    my @objs = $d->@*;
+    my @distances;
+    push @distances, distance( @objs[ 0, 1 ] ); # A -> B
+    push @distances, distance( @objs[ 1, 2 ] ); # B -> C
+    push @distances, distance( @objs[ 2, 3 ] ); # C -> D
+    push @distances, distance( @objs[ 3, 0 ] ); # D -> A
+
+    push @distances, distance( @objs[ 0, 2 ] ); # A -> C
+    push @distances, distance( @objs[ 1, 3 ] ); # B -> D
+
+    # sides are of equal length
+    return 0 if $distances[0] != $distances[1];
+    return 0 if $distances[1] != $distances[2];
+    return 0 if $distances[2] != $distances[3];
+    return 0 if $distances[3] != $distances[0];
+
+    # distances throught the center are of equal length
+    # removing parallelograms
+    return 0 if $distances[4] != $distances[5];
+
+    return 1;
+}
+
+sub distance ( $p1, $p2 ) {
+    return
+        sqrt( ( ( $p1->[0] - $p2->[0] )**2 ) +
+            ( ( $p1->[1] - $p2->[1] )**2 ) );
+}
+