aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad S Anwar <Mohammad.Anwar@yahoo.com>2022-03-16 18:50:54 +0000
committerGitHub <noreply@github.com>2022-03-16 18:50:54 +0000
commita4267f8469fbc4a490616a4f2a12bc9036287ff5 (patch)
treeeecb9ab5e1446a283d4f275a9a512d7f4fc957ee
parent56aff5b45b39779ae9686c267e489cd1c0165ef3 (diff)
parent66d88ead1035db55e6cfd6c6c1a39c1c722a9768 (diff)
downloadperlweeklychallenge-club-a4267f8469fbc4a490616a4f2a12bc9036287ff5.tar.gz
perlweeklychallenge-club-a4267f8469fbc4a490616a4f2a12bc9036287ff5.tar.bz2
perlweeklychallenge-club-a4267f8469fbc4a490616a4f2a12bc9036287ff5.zip
Merge pull request #5786 from choroba/ech156
Add solutions to 156: Pernicious Numbers & Weird Number (E. Choroba)
-rwxr-xr-xchallenge-156/e-choroba/perl/ch-1.pl22
-rwxr-xr-xchallenge-156/e-choroba/perl/ch-2.pl43
2 files changed, 65 insertions, 0 deletions
diff --git a/challenge-156/e-choroba/perl/ch-1.pl b/challenge-156/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..d8323a3245
--- /dev/null
+++ b/challenge-156/e-choroba/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental 'signatures';
+
+use Math::Prime::Util qw{ is_prime };
+
+sub pernicious_numbers ($n) {
+ my @pn;
+ for (my $i = 1; @pn < 10; ++$i) {
+ push @pn, $i if is_pernicious_number($i);
+ }
+ return \@pn
+}
+
+sub is_pernicious_number ($i) {
+ return is_prime(unpack '%32b*', pack 'N', $i)
+}
+
+use Test::More tests => 1;
+is_deeply pernicious_numbers(10), [3, 5, 6, 7, 9, 10, 11, 12, 13, 14],
+ '10 pernicious numbers';
diff --git a/challenge-156/e-choroba/perl/ch-2.pl b/challenge-156/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..1717c1eb1d
--- /dev/null
+++ b/challenge-156/e-choroba/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental 'signatures';
+
+use List::Util qw{ sum };
+use Memoize qw{ memoize flush_cache };
+
+sub is_weird_number ($n) {
+ my @divisors = (1);
+ for my $d (2 .. sqrt $n) {
+ push @divisors, $d, $n / $d if 0 == $n % $d;
+ }
+ pop @divisors if @divisors > 1 && $divisors[-1] == $divisors[-2];
+
+ return $n <= sum(@divisors) && ! do {
+ flush_cache('sums_to');
+ sums_to($n, @divisors) }
+}
+
+memoize('sums_to');
+sub sums_to ($sum, @numbers) {
+ return $numbers[0] == $sum if 1 == @numbers;
+ my $s = sum(@numbers);
+ return $s == $sum if $s <= $sum;
+
+ for my $i (0 .. $#numbers) {
+ return 1 if sums_to($sum, @numbers[ grep $_ ne $i, 0 .. $#numbers ]);
+ }
+ return 0
+}
+
+use Test::More tests => 854;
+
+ok ! is_weird_number(12), 'Example 1';
+ok is_weird_number(70), 'Example 2';
+
+ok is_weird_number($_), "weird $_"
+ for 836, 4030, 5830, 7192, 7912, 9272, 10430, 10570, 10792, 10990,
+ 11410, 11690, 12110, 12530, 12670, 13370, 13510, 13790, 13930,
+ 14770;
+
+ok ! is_weird_number($_), "not weird $_" for 2 .. 11, 13 .. 69, 71 .. 835;