diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2022-03-16 18:50:54 +0000 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2022-03-16 18:50:54 +0000 |
| commit | a4267f8469fbc4a490616a4f2a12bc9036287ff5 (patch) | |
| tree | eecb9ab5e1446a283d4f275a9a512d7f4fc957ee | |
| parent | 56aff5b45b39779ae9686c267e489cd1c0165ef3 (diff) | |
| parent | 66d88ead1035db55e6cfd6c6c1a39c1c722a9768 (diff) | |
| download | perlweeklychallenge-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-x | challenge-156/e-choroba/perl/ch-1.pl | 22 | ||||
| -rwxr-xr-x | challenge-156/e-choroba/perl/ch-2.pl | 43 |
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; |
