Merge pull request #5321 from ccntrq/challenge-141

Challenge 141

2 files changed, 129 insertions, 0 deletions

diff --git a/challenge-141/alexander-pankoff/perl/ch-1.pl b/challenge-141/alexander-pankoff/perl/ch-1.pl
new file mode 100644
index 0000000000..bc2e50f85c
--- /dev/null
+++ b/challenge-141/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,67 @@
+use strict;
+use warnings;
+use feature qw'say signatures';
+no warnings 'experimental::signatures';
+
+use constant DEBUG => $ENV{DEBUG} // 0;
+
+run() unless caller();
+
+sub run() {
+    say join( ' ', find_k_lowest_integers_with_exactly_n_divisors( 10, 8 ) );
+}
+
+sub find_k_lowest_integers_with_exactly_n_divisors ( $k, $n ) {
+    my @out;
+
+    for ( my $i = 1 ; @out < $k ; $i++ ) {
+        my @divisors = find_divisors($i);
+        if ( @divisors == $n ) {
+            push @out, $i;
+            explain( $i, scalar @out, @divisors ) if DEBUG;
+        }
+    }
+    return @out;
+}
+
+sub find_divisors($x) {
+    return 1 if $x == 1;
+    my @out;
+    my $max = $x;
+    for ( my $i = 1 ; $i < $max ; $i++ ) {
+        if ( $x % $i == 0 ) {
+            $max = $x / $i;
+            push @out, $i;
+            push @out, $max if $i != $max;
+        }
+    }
+
+    return @out;
+}
+
+sub explain ( $x, $count, @divisors ) {
+    say "$x is the "
+      . to_ordinal($count)
+      . " such number having exactly "
+      . scalar @divisors
+      . " divisors.";
+    say join( ", ", sort { $a <=> $b } @divisors );
+
+}
+
+sub to_ordinal($x) {
+    my %map = (
+        1  => 'first',
+        2  => 'second',
+        3  => 'third',
+        4  => 'fourth',
+        5  => 'fifth',
+        6  => 'sixth',
+        7  => 'seventh',
+        8  => 'eigth',
+        9  => 'nineth',
+        10 => 'tenth',
+    );
+
+    return $map{$x} // $x . 'th';
+}
diff --git a/challenge-141/alexander-pankoff/perl/ch-2.pl b/challenge-141/alexander-pankoff/perl/ch-2.pl
new file mode 100644
index 0000000000..188ca57823
--- /dev/null
+++ b/challenge-141/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,62 @@
+use strict;
+use warnings;
+use feature qw'say signatures';
+no warnings 'experimental::signatures';
+
+use List::Util qw(reduce);
+
+use constant DEBUG => $ENV{DEBUG} // 0;
+
+run() unless caller();
+
+sub run() {
+    my $m = prompt_for_integer('m');
+    my $n = prompt_for_integer('n');
+
+    my @possible_integers = numbers_from_digits($m);
+    my @divisible_by_n    = grep { $_ % $n == 0 } @possible_integers;
+
+    explain( $m, $n, \@possible_integers, \@divisible_by_n ) if DEBUG;
+    say scalar @divisible_by_n;
+}
+
+sub explain ( $m, $n, $possible_integers, $divisible_by_n ) {
+
+    say "Possible integers created using the digits of $m are:";
+    say join( ', ', sort { $a <=> $b } @$possible_integers );
+
+    say "There are "
+      . scalar(@$divisible_by_n)
+      . " integers divisible by $n such as:";
+    say join( ', ', sort { $a <=> $b } @$divisible_by_n );
+}
+
+sub numbers_from_digits($x) {
+    my @digits  = split( '', $x );
+    my $numbers = reduce(
+        sub {
+            my $digit = $digits[$b];
+            return [
+                @$a,    #
+                $digit,
+                ( grep { length $_ < @digits } map { $_ . $digit } @$a ),
+            ];
+        },
+        [],
+        0 .. $#digits
+    );
+
+    return @$numbers;
+}
+
+sub prompt_for_integer($name) {
+    say "Enter positive integer '$name'";
+    chomp( my $number = <STDIN> );
+
+    if ( $number !~ m/^\d+$/ || $number < 1 ) {
+        say "Invalid integer.";
+        return prompt_for_integer($name);
+    }
+
+    return $number;
+}