Merge pull request #7117 from ccntrq/challenge-191

Add solutions for challenge 191

2 files changed, 96 insertions, 0 deletions

diff --git a/challenge-191/alexander-pankoff/perl/ch-1.pl b/challenge-191/alexander-pankoff/perl/ch-1.pl
new file mode 100644
index 0000000000..435fc36222
--- /dev/null
+++ b/challenge-191/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+package challenge191::ch1;
+
+use strict;
+use warnings;
+use autodie;
+use feature qw'say state signatures';
+no warnings qw'experimental::signatures';
+
+use List::Util qw(reduce);
+
+use Test::More tests => 8;
+
+is( twice_largest( [ 1, 2, 3, 4 ] ), -1, "Example 1" );
+is( twice_largest( [ 1, 2, 0, 5 ] ), 1,  "Example 2" );
+is( twice_largest( [ 2, 6, 3, 1 ] ), 1,  "Example 3" );
+is( twice_largest( [ 4, 5, 2, 3 ] ), -1, "Example 4" );
+
+is( twice_largest_reduce( [ 1, 2, 3, 4 ] ), -1, "Example 1" );
+is( twice_largest_reduce( [ 1, 2, 0, 5 ] ), 1,  "Example 2" );
+is( twice_largest_reduce( [ 2, 6, 3, 1 ] ), 1,  "Example 3" );
+is( twice_largest_reduce( [ 4, 5, 2, 3 ] ), -1, "Example 4" );
+
+# using sort
+sub twice_largest ($xs) {
+    return 1 if @$xs < 2;
+    my @sorted      = sort { $b <=> $a } (@$xs);
+    my $max         = $sorted[0];
+    my $next_to_max = $sorted[1];
+
+    return $max >= $next_to_max * 2 ? 1 : -1;
+}
+
+# with a single iteration of the input list
+sub twice_largest_reduce ($xs) {
+    return 1 if @$xs < 2;
+    my $maximums = reduce(
+        sub {
+            if ( !defined $a->{max} || $b >= $a->{max} ) {
+                $a->{next_to_max} = $a->{max};
+                $a->{max}         = $b;
+                return $a;
+            }
+            if ( !defined $a->{next_to_max} || $b > $a->{next_to_max} ) {
+                $a->{next_to_max} = $b;
+                return $a;
+            }
+
+            return $a;
+
+        },
+        { max => undef, next_to_max => undef },
+        @$xs
+    );
+
+    return $maximums->{max} >= $maximums->{next_to_max} * 2 ? 1 : -1;
+
+}
diff --git a/challenge-191/alexander-pankoff/perl/ch-2.pl b/challenge-191/alexander-pankoff/perl/ch-2.pl
new file mode 100644
index 0000000000..3a505c346d
--- /dev/null
+++ b/challenge-191/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+package challenge191::ch2;
+
+use strict;
+use warnings;
+use autodie;
+use feature qw'say state signatures';
+no warnings qw'experimental::signatures';
+
+use List::Util qw(all);
+
+use constant DEBUG => $ENV{DEBUG} // 0;
+
+for ( 1 .. 15 ) {
+    my @cuties = cute_list($_);
+    say '$n = ' . sprintf( "%2d", $_ ) . ": " . scalar @cuties;
+
+    if (DEBUG) {
+        say "  " . join( ", ", @$_ ) for @cuties;
+    }
+}
+
+sub cute_list ( $size, $index = 1, $acc = [] ) {
+    return $acc if $index > $size;
+
+    my @xs         = 1 .. $size;
+    my @candidates = grep { $_ % $index == 0 || $index % $_ == 0 } @xs;
+
+    my @out;
+    for my $candidate (@candidates) {
+        if ( !grep { $candidate == $_ } @$acc ) {
+            push @out, cute_list( $size, $index + 1, [ @$acc, $candidate ] );
+        }
+    }
+
+    return @out;
+}
+