DAJ 199

2 files changed, 79 insertions, 0 deletions

diff --git a/challenge-199/dave-jacoby/perl/ch-1.pl b/challenge-199/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..1685992dbd
--- /dev/null
+++ b/challenge-199/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc say postderef signatures state };
+
+my @examples = (
+
+    [ 1, 2, 3, 1, 1, 3 ],
+    [ 1, 2, 3 ],
+    [ 1, 1, 1, 1 ],
+
+);
+
+for my $e (@examples) {
+    my @list = $e->@*;
+    my $out  = good_pairs(@list);
+    my $list = join ',', @list;
+    say <<"END";
+    Input:  \@list = ($list)
+    Output: $out
+END
+}
+
+sub good_pairs ( @list ) {
+    my $out = 0;
+    my $max = -1 + scalar @list;
+    for my $i ( 0 .. $max ) {
+        for my $j ( $i + 1 .. $max ) {
+            $out++ if $list[$i] == $list[$j];
+        }
+    }
+    return $out;
+}
diff --git a/challenge-199/dave-jacoby/perl/ch-2.pl b/challenge-199/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..5275629dec
--- /dev/null
+++ b/challenge-199/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+use Algorithm::Permute;
+
+my @examples = (
+
+    [ 7, 2, 3, 3, 0, 1, 1, 9, 7 ],
+    [ 0, 0, 1, 1, 1, 2, 2, 3 ],
+
+);
+
+for my $e (@examples) {
+    my $out  = good_triplets( $e->@* );
+    my ( $x, $y, $z, @array ) = $e->@*;
+    my $list = join ',', @array;
+    say <<"END";
+    Input:  \@array = ($list) and \$x = $x, \$y = $y, \$z = $z
+    Output: $out
+END
+}
+
+sub good_triplets ( $x, $y, $z, @array ) {
+    my $out = 0;
+    my $max = -1 + scalar @array;
+    for my $i ( 0 .. $max ) {
+        for my $j ( $i + 1 .. $max ) {
+            for my $k ( $j + 1 .. $max ) {
+                my $ij = abs( $array[$i] - $array[$j] );
+                my $jk = abs( $array[$j] - $array[$k] );
+                my $ik = abs( $array[$i] - $array[$k] );
+                next unless $ij <= $x;
+                next unless $jk <= $y;
+                next unless $ik <= $z;
+                $out ++;
+            }
+        }
+    }
+
+    say join ' ', $x, $y, $z, '|', @array;
+    return $out;
+}
+