High Weirdness on the Number Plane

Wherein we join the mile-high club in a most oblique and rarefied way…

THE WEEKLY CHALLENGE – PERL & RAKU #156 TAsk 2

---

“Where’s your will to be weird?”

— Jim Morrison

---

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.

ANALYSIS

If weird numbers were common, I suppose the reasoning is, then they wouldn’t be very weird, now would they? Well frankly my own life experience directly and daily contradicts this by inspection. Maybe other people’s lives are boring and uneventful, but I wouldn’t know about that — and furthermore don’t have any reason to believe the weird somehow stops at my door.

The world is not only weirder than you imagine,

but is weirder than you can imagine.

So how does this insight apply to numbers?

A number that is equal to the sum of its proper divisors is known as a perfect number. A number that can be formed from a specific subset of its proper divisors is close to but not-quite perfect, and is known as a semiperfect number.

A number whose proper divisors add to a sum greater than itself generally indicates that it has a large number of small divisors, so the sum of their larger complements can reach the necessary value. Because of their copious factors these are known as abundant numbers.

Putting these definitions together it follows that all semiperfect numbers are abundant, as there must be some extra factor left over from constructing the qualifying subset that makes a number semiperfect instead of perfect.

The weird numbers, on the other hand, are abundant, meaning there are more than enough factors to sum to the number, but also no combination of those factors can be assembled to do the job, and so are not semiperfect.

This combination is rather unusual, and some might say downright weird.

METHOD

PERL 5 SOLUTION

To create the weird numbers in Perl we’ll make three routines: one to compute a list of proper divisors, another to take that list and test for abundance, and a third to test for semiprimality. And yes, I’m pretty confident I just made that word up.

The only really difficult problem is the semi prime test, as it’s rooted in combinatorics: we need to check a potentially really large number of possible combinations of divisors to sum.

As the number of subsets of a list of values is 2ⁿ, I first tried using a binary mask, with the set bits determining which elements to in- and exclude. This worked quickly and efficiently, until I found my first value with over 64 factors and had to rethink things. The range was out of integer and if we had to go searching . After toying with the idea of letting the module function Algorithm::Combinatorics::subsets()handle it (too slow) I settled on a recursive solution.

Because I liked the idea of encapsulating the three functions, each in their own scope, I wanted to enclose the recursive portion of the semiprime() within its block with the rest of the routine. However naming a nested subroutine places the sub in the symbol table, leading to a warning about maintaining the state of shared variables. This could be circumvented using a proper global variable, but that goes against the spirit of having the function self-contained.

A nice way out of this bind, available since Perl 5.16, is the using the __SUB__ token, which is a reference to the current subroutine. Using this an anonymous subroutine can call itself to provide the recursion.

my $count = shift @ARGV // 10;
my $candidate = 0;
my @weird;

while ( @weird < $count and  ++$candidate ) {
    my @pd = proper_divisors( $candidate, 1 );

    push @weird, $candidate 
        if abundant($candidate, @pd) and not semiperfect($candidate, @pd);
}
say "@weird";

sub proper_divisors ($num, $sort = 1) {
    my @pd = 1;
    
    for (2..sqrt $num) {
        next if $num % $_;
        push @pd, ( $num/$_ , $_);    
    }
    return sort {$b<=>$a} @pd if $sort;
    return @pd;
}

sub abundant ( $num, @pdiv ) {
    my $sum = 0;
    $sum += $_ for @pdiv;
    $sum > $num 
        ? 1
        : 0
}

sub semiperfect ( $num, @pdiv ) {
    my $found = 0; 
    my $search_factors = sub ( $num, $total, @facs ) {
        $found = 1 if $total == $num;
        return if $found == 1;
        return if $total > $num;
        return if @facs == 0;
        
        my $factor = shift @facs;
    
        ## take option
        __SUB__->( $num, $total+$factor, 
                            grep { $total+$factor+$_ <= $num } @facs);
        ## pass option
        __SUB__->( $num, $total, @facs)
    } ;
    
    $search_factors->( $num, 0, @pdiv );
    return $found;
}

And the result:

Mar 19, 2022 at 2:53:22 PM
~/Code/PWC/156-2-high-weirdness.pl
--------------------------------------------------------------------
70 836 4030 5830 7192 7912 9272 10430 10570 10792

Raku Solution

In Raku, we follow the same basic pattern. I found the recursive solution for the semiprime combinations became very slow, so I reverted to a binary mask on summing the individual elements again. Raku uses arbitrary sized integers, so the upper range of the masks is not a problem, however looking at each options for a large number of divisors is still going to take a long time. The Z inline zip in its metaoperator form is a joy to use, though, so that’s a plus.

It’ll finish eventually I suppose.

say $_[*-1] for ((1..*) .map({proper_divisors($_)})
            .grep({abundant($_) and not semiperfect($_)}))[^$count] ;

sub proper_divisors ($num) {
    |((1..$num/2).grep($num %% *)) , $num
}

sub abundant ( @pdiv is copy ) {
    my $num = @pdiv.pop;
    @pdiv.sum > $num;
}

sub semiperfect ( @pdiv is copy) {
    my $num = @pdiv.pop;
    my $max = @pdiv.elems;

    for ( 1..2**$max - 1 ) {
        my $fmt = '%0' ~ $max ~ 'b' ;
        my @mask = $_.fmt("$fmt").comb;
        my $sum = (@mask Z* @pdiv).sum ;

        return True if $sum == $num;
    }
    return False;
}