Merge pull request #5310 from jacoby/master

141

3 files changed, 73 insertions, 0 deletions

diff --git a/challenge-141/dave-jacoby/blog.txt b/challenge-141/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..83cb987fe0
--- /dev/null
+++ b/challenge-141/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/11/29/i-like-numbers-and-hate-division-the-weekly-challenge-141.html
\ No newline at end of file
diff --git a/challenge-141/dave-jacoby/perl/ch-1.pl b/challenge-141/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..77368c6f5e
--- /dev/null
+++ b/challenge-141/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say state postderef signatures };
+no warnings qw{ experimental };
+
+my @num_divisors = get_number_divisors( 1, 10, 8 );
+
+sub get_number_divisors ( $start, $count, $divisors ) {
+    my @output;
+    my $s = $start;
+    while (1) {
+        my @divisors;
+        for my $i ( 1 .. $s ) {
+            push @divisors, $i if $s % $i == 0;
+        }
+        if ( scalar @divisors == $divisors ) {
+            say join " ", $s, ':', ( scalar @divisors ), ':', @divisors;
+            push @output, $s;
+        }
+        last if $count == scalar @output;
+        $s++;
+    }
+    return @output;
+}
+
diff --git a/challenge-141/dave-jacoby/perl/ch-2.pl b/challenge-141/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..2ecc251f97
--- /dev/null
+++ b/challenge-141/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use Carp;
+use Getopt::Long;
+
+my $m = 1234;
+my $n = 2;
+
+GetOptions(
+    'm=i' => \$m,
+    'n=i' => \$n,
+);
+
+croak q{$m is not positive} if $m < 1;
+croak q{$n is not positive} if $n < 1;
+
+my @like_numbers = like_numbers( $m, $n );
+say join ' ', @like_numbers;
+
+sub like_numbers ( $m, $n ) {
+    my @numbers = make_numbers($m);
+    return
+
+        sort { $a <=> $b }
+        grep { $_ % $n == 0 }
+        grep { $_ != $m }
+
+        @numbers;
+}
+
+sub make_numbers ( $number, $n = '' ) {
+    my @output;
+    for my $i ( 0 .. -1 + length $number ) {
+        my $x = $n . substr( $number, $i, 1 );
+        my $y = substr( $number, $i + 1 );
+        push @output, $x;
+        push @output, make_numbers( $y, $x ) if length $y;
+    }
+    return @output;
+}