Perl Weekly Challenge 156.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 156.

Task 1: Pernicious Numbers

Submitted by: Mohammad S Anwar
Write a script to permute first 10 Pernicious Numbers.

A pernicious number is a positive integer which has prime number of
ones in its binary representation.

The first pernicious number is 3 since binary representation of 3 =
(11) and 1 + 1 = 2, which is a prime.

Expected Output
3, 5, 6, 7, 9, 10, 11, 12, 13, 14

There is a straightforward solution: Convert the number to a binary string, split its digits, sum them and test their primality. It fits into a one-liner, using subroutines from Math::Prime::Util and from List::Util:

perl -MMath::Prime::Util=is_prime -MList::Util=sum0 -E '
for(1..10){say($n),next if is_prime(sum0 split "", sprintf "%b", ++$n); redo}'

Results:

3
5
6
7
9
10
11
12
13
14

A full version follows:

 1  # Perl weekly challenge 156
 2  # Task 1: Pernicious numbers
 3  #
 4  # See https://wlmb.github.io/2022/03/14/PWC156/#task-1-pernicious-numbers
 5  use v5.12;
 6  use warnings;
 7  use bigint;
 8  use Math::Prime::Util qw(is_prime);
 9  use List::Util qw(sum0);
10  my $N=shift//10; # How many pernicious numbers to calculate
11  my $candidate=0;
12  my @pernicious;
13  for(1..$N){
14      push(@pernicious, $candidate), next
15          if is_prime(sum0 split "", sprintf "%b", ++$candidate);
16      redo
17  }
18  say "The first $N pernicious numbers are ", join ", ",  @pernicious;

Example:

./ch-1.pl
./ch-1.pl 20

Results:

The first 10 pernicious numbers are 3, 5, 6, 7, 9, 10, 11, 12, 13, 14
The first 20 pernicious numbers are 3, 5, 6, 7, 9, 10, 11, 12, 13, 14,
17, 18, 19, 20, 21, 22, 24, 25, 26, 28

Just for fun, I try my luck now with a Raku oneliner using lazy lists:

raku -e 'say (1..Inf).grep({is-prime([+] split "", sprintf "%b", $_)})[^10]'

Results:

(3 5 6 7 9 10 11 12 13 14)

Task 2: Weird Number

Submitted by: Mohammad S Anwar
You are given number, $n > 0.

Write a script to find out if the given number is a Weird Number.

According to Wikipedia, it is defined as:

The sum of the proper divisors (divisors including 1 but not itself)
of the number is greater than the number, but no subset of those
divisors sums to the number itself.

Example 1:
Input: $n = 12
Output: 0

Since the proper divisors of 12 are 1, 2, 3, 4, and 6, which sum to
16; but 2 + 4 + 6 = 12.
Example 2:
Input: $n = 70
Output: 1

As the proper divisors of 70 are 1, 2, 5, 7, 10, 14, and 35; these sum
to 74, but no subset of these sums to 70.

For any number I can get its divisors using the Math::Prime::Util package. I can obtain all its subsets using the Algorithm::Combinataorics package and I can sum0 them using the List::Util package. Thus, there is not much remaining work to do and the problem may be solved with the following one-liner:

perl -MMath::Prime::Util=divisors -MAlgorithm::Combinatorics=subsets -MList::Util=sum0 -E '
M: for $N(@ARGV){@d=divisors($N); pop @d; $O=0, next unless sum0(@d)>$N; @s=subsets(\@d);
for(@s){$O=0, next M if sum0(@$_)==$N} $O=1;} continue{say "$N ", $O?"is":"is not", " weird"}
' 12 70 836 4030

Results:

12 is not weird
70 is weird
836 is weird
4030 is weird

I used the continue mechanism to print the results.

The full solution is

 1  # Perl weekly challenge 156
 2  # Task 2: Weird number
 3  #
 4  # See https://wlmb.github.io/2022/03/14/PWC156/#task-2-weird-number
 5  use v5.12;
 6  use warnings;
 7  use Math::Prime::Util qw(divisors);
 8  use Algorithm::Combinatorics qw(subsets);
 9  use List::Util qw(sum0);
10  die "Usage: ./ch-2.pl N1 N2... to test numbers N1, N2... for weirdness"
11      unless @ARGV;
12  my $is_weird;
13   WEIRD:
14      for my $N(@ARGV){
15          say("Arguments must be larger than 1"), next unless $N>=2;
16          my @divisors=divisors($N);
17          pop @divisors; # keep only proper divisors
18          $is_weird=0, next WEIRD unless sum0(@divisors)>$N; # Overabundant?
19          my @subsets=subsets(\@divisors);
20          for(@subsets){
21              $is_weird=0, next WEIRD if sum0(@$_)==$N; #Semiperfect, fail
22          }
23          $is_weird=1;
24  } continue {
25      say "$N ", $is_weird?"is":"is not", " weird";
26  }

Examples:

./ch-2.pl 12 70 836 4030

Results:

12 is not weird
70 is weird
836 is weird
4030 is weird

I also experiment with a little Raku. There must be better ways of programming this, but, anyway. For each number N I obtain its M proper-divisors using the Prime::Factor package, test that N is abundant and then test that it is not semiperfect. To that end, I build all non-empty subsets of its divisors by counting from 1 up to 2M-1, i.e., all non-zero M-bit numbers, assigning each bit to a divisor and interpreting its value (0 or 1) as membership in the set. Then I sum the chosen divisors and compare the result to N. I’m sure I won’t understand the following code after a few minutes, but it seems to work, and it was fun finding out about those strange Raku operators:

raku -MPrime::Factor -e 'for @*ARGS {my @d=proper-divisors $_; say "$_",
(sum(@d) > $_ && $_ == (map {my @b=(sprintf("%0" ~ @d.elems ~ "b", $_)
.split("",:skip-empty)); (@d Z @b).grep({+$_[1]}).map({$_[0]}).sum;},
(1..2**@d.elems-1)).none) ??" is" !! " is not", " weird"}' 12 70 836 4029 4030

Results:

12 is not weird
70 is weird
836 is weird
4029 is not weird
4030 is weird
Written on March 14, 2022