2 files changed, 122 insertions, 0 deletions
diff --git a/challenge-191/dave-jacoby/perl/ch-1.pl b/challenge-191/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..1b7728fd0d
--- /dev/null
+++ b/challenge-191/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc say postderef signatures state };
+
+my @input =
+    ( [ 1, 2, 3, 4 ], [ 1, 2, 0, 5 ], [ 2, 6, 3, 1 ], [ 4, 5, 2, 3 ] );
+
+for my $i (@input) {
+    my $input  = join ', ', $i->@*;
+    my $output = twice_largest($i);
+    say <<"END";
+        Input:  \$s = ($input)
+        Output: $output
+END
+}
+
+sub twice_largest ( $input ) {
+    my @input = $input->@*;
+    for my $n ( @input ) {
+        my $c = 0;
+        my @array = grep { $_ != $n } @input;
+        for my $o (@array) {
+            next if $o == $n;
+            $c++ if $n >= 2 * $o;
+        }
+        return 1 if $c == 3;
+    }
+    return -1;
+}
diff --git a/challenge-191/dave-jacoby/perl/ch-2.pl b/challenge-191/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..52989ce172
--- /dev/null
+++ b/challenge-191/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,91 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use Algorithm::Permute;
+use List::Util qw{ uniq };
+# use Memoize;
+# memoize('test');
+
+# before Memoize:
+# real    0m30.866s
+# user    0m10.766s
+# sys     0m1.016s
+
+# after Memoize:
+# real    1m28.003s
+# user    0m30.375s
+# sys     0m1.672s
+
+# to check your work: https://oeis.org/A320843
+
+my @input = 1 .. 15;
+for my $i (@input) {
+    my @list = cute_list($i);
+    my $list = join ",\n\t", @list;
+    say <<"END";
+    Input:  \$s = $i
+    Output: $list
+END
+}
+
+sub cute_list ( $input ) {
+    my $n;
+    $n->@* = 1 .. $input;
+    my @output = permute($n);
+    return scalar grep { defined } @output;
+}
+
+# this looks like a job for recursion!
+sub permute ( $remaining, $numbers = [] ) {
+    state $hash;
+    my @output;
+    if ( !scalar $remaining->@* ) {
+
+        # say join ' ', $numbers->@*;
+        return 1;
+    }
+    my $i = 1 + scalar $numbers->@*;
+    for my $r ( $remaining->@* ) {
+        next unless test( $i, $r );
+        my $rremaining->@* = grep { $_ != $r } $remaining->@*;
+        my $nnumbers->@*   = ( $numbers->@*, $r );
+        push @output, permute( $rremaining, $nnumbers );
+    }
+    return @output;
+}
+
+sub test ( $i, $j ) {
+    ( $i, $j ) = sort $i, $j;
+    return 0 == $i % $j || 0 == $j % $i ? 1 : 0;
+}
+
+# the call to pre-existing wheels is great. I hopped on the idea of
+# having Algorithm::Permute take the wheel was powerful, but the problem
+# is that it returns all the choices with no discernable order, so if you
+# know, for example, that a value won't fit in the 2nd position, then you
+# can eliminate every choice with that, turning this from an exponential
+# problem into one that's much more solvable.
+
+# which is to say that this is correct but unneccessarily slow.
+sub cute_list_slow ( $input ) {
+    my @output;
+    my @list = 1 .. $input;
+    my $p    = Algorithm::Permute->new( \@list );
+    while ( my @arr = $p->next ) {
+        my @copy = @arr;
+        unshift @arr, 0;
+        my $c = 0;
+        for my $i ( 1 .. -1 + scalar @arr ) {
+            my $j = $arr[$i];
+            next unless 0 == $i % $j || 0 == $j % $i;
+            $c++;
+        }
+        push @output, join ', ', @copy if $c == $input;
+    }
+    return scalar @output;
+    return map { qq{[$_]} } sort @output;
+}
+