laurent_r

These are some answers to the Week 156 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on March 20, 2022 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Pernicious Numbers

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

I’m not sure why the task description speaks about permuting the first 10 pernicious numbers. It seems we’re simply requested to display them.

Pernicious Numbers in Raku

In Raku, we can use the base method to convert a real number into a string representation with a chosen base. To find the number of 1 in the resulting binary string, we can just sum the digits. Then, Raku has the built in is-prime to find out whether the 1 count is a prime numbers. We end up with a method invocation pipeline ($n.base(2).comb.sum.is-prime) that does all the real work.

my $count = 0;
for 2..* -> $n {
    if $n.base(2).comb.sum.is-prime {
        $count++;
        print "$n, " and next if $count < 10;
        say $n and last;
    }
}

This program displays the following output:

$ raku ./pernicious.raku
3, 5, 6, 7, 9, 10, 11, 12, 13, 14

Pernicious Numbers in Perl

In Perl, we will simply use the sprintf built-in function with a %b formatting string to convert the input integer into a binary representation. The program is otherwise similar to the Raku implementation, except for finding if the 1 count is prime. We could write a subroutine for that (or, rather, re-use one of the numerous such subroutines that I have implemented for previous Perl Weekly Challenge task implementations, including last week for PWC 155). But since we don’t need any large prime, I’ll simply hard-code the first eight prime numbers (those less than 20) known to all people having even only a slight inclination for maths , and store them in a hash for fast lookup

use strict;
use warnings;
use feature "say";

my $count = 0;
my %primes = map { $_ => 1 } (2, 3, 5, 7, 11, 13, 17, 19);

for my $n (2..100) {
    my $bin = sprintf "%b", $n;
    my $num_1 = 0;
    $num_1 += $_ for split "", $bin;
    if (exists $primes{$num_1}) {
        $count++;
        print "$n, " and next if $count < 10;
        say $n and last;
    }
}

This script displays the following output:

$ perl pernicious.pl
3, 5, 6, 7, 9, 10, 11, 12, 13, 14

Pernicious Numbers in Julia

primes = Dict(2 => 1, 3 => 1, 5 => 1, 7 => 1, 11 => 1, 13 => 1, 17 => 1, 19 => 1)
count = 0
for n in 2:20
    n_bin = string(n, base=2)
    num_1 = 0
    for digit in n_bin
        num_1 += parse(Int64, digit)
    end
    if num_1 ∈ keys(primes)
        global count
        count += 1
        print(n, " ")
        count >= 10 && break
    end
end
println("")

Output:

3 5 6 7 9 10 11 12 13 14

Pernicious Numbers in Python

primeset = {2, 3, 5, 7, 11, 13, 17, 19}
count= 0
for n in range(2, 20):
    bin_n = format(n, 'b')
    num_1 = 0
    for x in bin_n:
        if x == '1':
            num_1 += 1

    if num_1 in primeset:
        count += 1
        print(n, end =" ")
        if count >= 10:
            break
print("")

Output:

$ python3 pernicious.py
3 5 6 7 9 10 11 12 13 14

Task 2: Weird Numbers

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.

If a number is equal to the sum of its proper divisors, it is said to be a perfect number (such as 6, 28, 496, etc.). If it it less than the sum of its divisors, it is said to be abundant and it it is more than the sum of its divisors, it is deficient. If a number is equal to the sum of a subset of its proper divisors (such as 12), it it said to be semi-perfect). With these definitions in mind, a weird number is an abundant number that is not semi-perfect.

Weird Numbers in Raku

The is-weird subroutine first finds the proper divisors of the input integer (testing divisibility for all integers less than or equal to the input integer). Then it returns False if the sum of the divisors is less than or equal to the input integer (i.e. if the input number is deficient or perfect). For the remaining integers (the so-called abundant numbers), it uses the combinations method on the @divisors list to test all subsets of at least 2 items and returns False if the sum of the items of any such subset is equal to the input numbers. If no such subset has been found, then the number is not semi-perfect and the subroutine returns True.

sub is-weird (Int $n where * > 0) {
    my @divisors = grep {$n %% $_}, 1..$n/2;
    return False if @divisors.sum <= $n;
    for @divisors.combinations: 2..@divisors.elems -> $subset {
        return False if $subset.sum == $n;
    }
    True;
}

for 2..1000 -> $m {
    say "Found $m" if is-weird($m);
}

This script finds only two integers less than 1000 that are weird:

raku ./wierd_nrs.raku
Found 70
Found 836

Weird Numbers in Perl

This is essentially a port to Perl of the Raku implementation above, except that we had to implement two helper subroutines, sum and combine. The first one simply computes the sum of the items of an input list or array, and the second is a recursive subroutine that computes all subsets of the input divisors list and returns a false value (0) if the sum of any subset is equal to the input integer, and a true value (1) otherwise.

use strict;
use warnings;
use feature "say";

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub combine {
    my ($test, $comb, $div) = @_;
    my @comb_so_far = @$comb;
    my @divisors = @$div;
    # say "(@comb_so_far) (@divisors)";
    return 0 if sum(@comb_so_far) == $test;
    return 1 if scalar @divisors == 0;
    for my $i (0..$#divisors) {
        my $result = combine($test, [@comb_so_far, $divisors[$i]],
                             [@divisors[($i+1)..$#divisors]]);
        return 0 if $result == 0;
    }
    return 1;
}

sub is_weird {
    my $n = shift;
    my @divisors = grep {$n % $_ == 0} 1..($n/2);
    return 0 if sum(@divisors) <= $n;
    return combine($n, [], [@divisors]);
}

for my $m (2..6000) {
    say "Found $m" if is_weird($m);
}

With the wider range used in this program, it displays the following output:

$ perl weird_nrs.pl
Found 70
Found 836
Found 4030
Found 5830

This program is becoming very slow for the larger values of the input integer. It took more than 25 minutes on my computer to find the four weird numbers below 6,000 above.

Note that all four weird numbers found above are even. In fact, although there are infinitely many weird numbers, all known weird numbers are even, and it is not known whether there exists any odd weird number (this is an unsolved problem in mathematics). So if you can find an odd weird number, or else if you can prove that no such number exists, you might become famous.

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on March 27, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.