DAJ Challenge 156

3 files changed, 74 insertions, 0 deletions

diff --git a/challenge-156/dave-jacoby/blog.txt b/challenge-156/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..fa094f46c2
--- /dev/null
+++ b/challenge-156/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2022/03/14/pernicious-and-weird-are-the-numbers-we-two-can-share-weekly-challenge-156.html
diff --git a/challenge-156/dave-jacoby/perl/ch-1.pl b/challenge-156/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..b62a8dd082
--- /dev/null
+++ b/challenge-156/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ product sum0 uniq };
+
+my @pernicious;
+my $i = 0;
+while ( scalar @pernicious < 10 ) {
+    $i++;
+    if ( is_prime( count_ones( to_binary($i) ) ) ) {
+        push @pernicious, $i;
+    }
+}
+say join ', ', @pernicious;
+
+sub count_ones( $n ) {
+    return sum0 split //, $n;
+}
+
+sub to_binary( $n ) {
+    return sprintf '%b', $n;
+}
+
+sub is_prime ($n) {
+    return 0 if $n == 0 || $n == 1;
+    for ( 2 .. sqrt $n ) { return 0 unless $n % $_ }
+    return 1;
+}
diff --git a/challenge-156/dave-jacoby/perl/ch-2.pl b/challenge-156/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..f95d49b464
--- /dev/null
+++ b/challenge-156/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use Carp;
+use Getopt::Long;
+use List::Util qw{ sum0 };
+use Scalar::Util qw{ looks_like_number };
+
+my $n = 12;
+GetOptions( 'number=i' => \$n );
+croak "Not Greater than 0" unless $n > 0;
+
+my $w = is_weird($n);
+say <<"END";
+    Input:  \$n = $n
+    Output: $w
+END
+
+sub is_weird ( $n ) {
+    my $m       = $n;
+    my @factors = grep { $n % $_ == 0 } 1 .. $n - 1;
+    my $sum     = sum0 @factors;
+    my $w       = subset_sum( $n, \@factors );
+    return ( $sum > $n && !$w ) ? 1 : 0;
+}
+
+sub subset_sum ( $n, $factors, $i = 0, @values ) {
+    if ( !defined $factors->[$i] ) {
+        my $sum = sum0 @values;
+        return $n == $sum ? 1 : 0;
+    }
+    my @o;
+    return 1 if subset_sum( $n, $factors, $i + 1, @values, $factors->[$i] );
+    return 1 if subset_sum( $n, $factors, $i + 1, @values, 0 );
+    return 0;
+}
+