RogerBW's Blog

The Weekly Challenge 156: Weirdly Pernicious or Perniciously Weird? 17 March 2022

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.

Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.

Search
Archive
Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action aeronautics aikakirja anecdote animation anime army astronomy audio audio tech aviation base commerce battletech beer boardgaming book of the week bookmonth chain of command children chris chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 cycling dead of winter doctor who documentary drama driving drone ecchi economics espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point flight simulation food garmin drive gazebo genesys geocaching geodata gin gkp gurps gurps 101 gus harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo-nebula reread in brief avoid instrumented life javascript julian simpson julie enfield kickstarter kotlin learn to play leaving earth linux liquor lovecraftiana lua mecha men with beards museum music mystery naval noir non-fiction one for the brow opera parody paul temple perl perl weekly challenge photography podcast politics postscript powers prediction privacy project woolsack pyracantha python quantum rail raku ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs ruby rust science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance the weekly challenge thirsty meeples thriller tin soldier torg toys trailers travel type 26 type 31 type 45 vietnam war war wargaming weather wives and sweethearts writing about writing x-wing young adult
Special All book reviews, All film reviews
Produced by aikakirja v0.1