Task — Weird number

You are given a number, $n > 0. Write a script to find out if the given number is a Weird Number. According to Wikipedia, a number is weird if the sum of its proper divisors (divisors including 1 but not itself) is greater than the number, but no subset of those divisors sums to the number.

Examples

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

This breaks down to three steps:

1. Find the proper divisors of $n
2. Check that their sum is greater than $n
3. Check that no combination of the divisors sums to n

For any modest value of $n, step 1 is easy (just try every integer up to $n / 2) and step 2 is pretty trivial. And fortunately step 2 eliminates the majority of values of $n.

Step 3, though, is trickier, because if $n has $d divisors, there are 2 ^ $d - 1 subsets of these divisors, which can amount to quite a large number. For example, if $n = 720, it has 29 proper divisors, so 2^29 - about a billion - subsets of those divisors to check.

I optimised somewhat by ordering the subsets of divisors large to small, so that when I was adding them up I could stop once the sum exceeded $n. However, my algorithm was still defeated (ie took a very long time) by 720, though it could quickly confirm that 836 was a weird number, and in fact it is the second one.

Probably someone will have come up with a weird algorithm to eliminate 720 more quickly, but my solution does at least meet the requirements of the challenge. I'm not providing a 'Try it' for this task because it takes too long to calculate for most numbers.

Script

#!/usr/bin/perl

# Peter Campbell Smith - 2022-03-17
# PWC 156 task 2

use v5.28;

my (@tests, $test, $sum, @divisors, $divisor, $num_subsets, $bit, $j, $bad, $num_divisors);

@tests = (12, 28, 70, 836);

for $test (@tests) {
    
    $sum = 0;
    @divisors = ();
    $bad = '1 - good';
    
    # find the proper divisors and their sum
    $j = 0;
    for $divisor (1 .. $test / 2) {
        next unless $test / $divisor == int($test / $divisor);
        $divisors[$j ++] = $divisor;
        $sum += $divisor;
    }
    
    # first test - does sum of divisors exceed given number?
    if ($sum <= $test) {
        $bad = qq[0 - divisor sum ($sum) is too small];
    
    # second test - does any subset of divisors sum to the given number?
    } else {
            
        # loop over subsets of divisors: there are 2 ** (number of divisors) subsets
        # and we can loop over them by treating 1 .. (number of subsets - 1) as a binary 
        # mask to determine which divisors we sum
        
        $num_divisors = scalar @divisors;
        $num_subsets = 2 ** $num_divisors;
        for ($j = $num_subsets - 1; $j >= 0; $j --) {
                    
            # make a sum of one subset of divisors
            $sum = 0;
            $bit = $num_divisors - 1;
            for $b (0 .. $bit) {
                $sum += $divisors[$bit] if $j & (2 ** $bit);
                last if $sum > $test;
                $bit --;
            }
            
            # no good
            if ($sum == $test) {
                $bad = '0 - divisor sum equals number';
                last;
            }
        }
    }   
    say qq[\nInput:  $test\nOutput: $bad];
}

Output

Input:  12
Output: 0 - divisor sum equals number

Input:  28
Output: 0 - divisor sum (28) is too small

Input:  70
Output: 1 - good

Input:  836
Output: 1 - good