RogerBW's Blog

I’ve been doing the Weekly Challenges. The latest involved more number-theory definitions. (Note that this is open until 20 March 2022.)

Task 1: Pernicious Numbers

Write a script to calculate first 10 Pernicious Numbers.

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

Also found as OEIS A052294, and one could take code from Rosetta Code, though I didn't because where would be the fun in that?

The problem falls nearly into two parts: count set bits (Hamming weight), and test the result for primality. The latter I've done in earlier PWCs (though I had to modify the tester to return correctly false for 1 and 0, which hadn't previously been a concern); the former is one of the quite hard problems.

Some of the languages have this built in: specifically, Rust offers count_ones() and Kotlin countOneBits(). Apparently Python has got it too, but only in 3.10, which is more recent than Debian/stable. (People complain about Ruby changing all the time, which it did in its early days, but that's rather settled down now; the rate of feature introduction in Python3 makes me think the authors should have worked a bit harder to get it stable before releasing it.) For the rest I wrote my own.

The fastest Hamming weight algorithms need one to specify the bit length of the input, and to pre-fill constants based on that length. I didn't want to do that, and at these sizes we don't need the very fastest; but rather than do the obvious and slow series of shifts and ands I adapted popcount64d from that link above.

PostScript (happily variable-free):

/hammingweight {
    0
    {
        1 index 0 gt {
            exch dup 1 sub and exch
            1 add
        } {
            exch pop
            exit
        } ifelse
    } loop
} bind def

Then it's just a matter of scaffolding code to get the weight of each integer and test it for primality.

/pernicious {
    2 dict begin
    /n exch def
    /c 1 def
    [
        {
            c hammingweight isprime {
                c
                /n n 1 sub def
                n 0 le {
                    exit
                } if
            } if
            /c c 1 add def
        } loop
    ]
    end
} bind def

Task 2: Weird Number

You are given number, $n > 0.

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

The sequence is in the OEIS of course.

These are the abundant numbers (sum of the proper divisors (divisors including 1 but not itself) of the number is greater than the number), without the semiperfect numbers (for which at least one subset of those divisors sums to the number). Since both parts involve divisors, I calculate those first.

I added a test case n=13, because both of the examples given are abundant, so the non-abundant code path was not being properly exercised.

I've written factorising code for these before, so I just modified that a little. Raku:

sub divisors($n) {
    my @ff=[1];

Check for the special case n=1.

    if ($n==1) {
        return @ff;
    }

Get the square root, and add it if n is a perfect square.

    my $s=floor(sqrt($n));
    if ($s * $s == $n) {
        @ff.push($s);
        $s--;
    }

Then calculate and add divisors smaller than the square root, and their counterparts greater than it.

    for 2..$s -> $pf {
        if ($n % $pf == 0) {
            @ff.push($pf);
            @ff.push($n div $pf);
        }
    }
    return @ff;
}

The resultant list isn't sorted, but for our purposes that doesn't matter and we don't need to spend the time on it. On to the main task.

sub is_weird($n) {
    my @dd=divisors($n);

First test for abundance.

    if (@dd.sum() <= $n) {
        return False;
    }

Then use a binary mask to test each combination of divisors, adding to see if they're equal to n. (If the sum becomes greater than n, we can short-circuit any remaining additions. That might be an argument for sorting the divisors largest-first.)

    for 1..(1 +< @dd.elems)-1 -> $mask {
        my $ss=0;
        for @dd.kv -> $i,$d {
            if ($mask +& (1 +< $i) > 0) {
                $ss += $d;
                if ($ss > $n) {
                    last;
                }
            }
            if ($ss == $n) {
                return False;
            }
        }
    }
    return True;
}

Full code on github.