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.

Peter's blog make sure all the fun bits are shared. Thanks for sharing the knowledge with us every week.

#!/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];
}

28 lines of code

Output from script

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