The logic in this one is really tight, but I'm not too happy with the argument passing into the w() function. As always, in deciphering an obfuscation, our first step is to re-format into something more legible.

{
  $s=eval join'+', @d = grep !($n%$_), 1..++$n-1;
  eval { w(@d, $n) if $s > $n};
  print $n,$/ if $@ =~ /!/;
  redo
}

sub w{
  my $s = pop || die;
  my $t = pop || die '!';
      eval { w( @_, $s-$t) },
      $@ =~ /!/ || die
          if $t <= $s;
  w( @_, $s)
}
[download]

And now we'll attack in parts. First, the while loop. This is extremely easy and just about self-evident.

{
  $s=eval join'+', @d = grep !($n%$_), 1..++$n-1;
  eval { w(@d, $n) if $s > $n};
  print $n,$/ if $@ =~ /!/;
  redo
}
[download]

The number we're checking for weird-ness is $n. So just start off an infinite loop counting up. Note that we actually increment $n inside of the foreach loop.Start off by setting up two variables for this $n, $s (contains the sum of all of its divisors) and @d (which contains the list of all divisors). We build @d by grepping out all the divisors, then link 'em together with pluses and eval it to get the sum.

Now, we iterate in a for loop all digits between 1 and $n - 1. If that number evenly divides $n, then we add it onto the sum, and push it onto our list of divisors. The grep statement there ensures that we're only looking at proper divisors. Also note that I just arbitrarily chose to demontrate that the number is abundant by summing all proper divisors of the number and seeing if it's equal to the number itself, instead of determining that it's 2-perfect by summing all divisors including the number itself and seeing if it's equal to 2 * $n. They're equivalent definitions.

The next eval statement checks a number for semi-perfectness. We'll come back to this. But note that we only perform the check if $s > $n, that is if the sum of all divisors is greater than the number itself, which means that the number is abundant. It can't be weird if it isn't also abundant, and its critical to only perform the check for semi-perfectness if the number is abundant. If you end up checking all numbers, execution speed plummets. For comparison, on my machine, I could spit out the first 32 weird numbers in a minute by only checking the abundants for semi-perfectness. If I checked all numbers for semi-perfectness, I could only do the first 5 weird numbers in a minute.

And finally, just print out the number $n (followed by a newline, conveniently stored in the input record separator, $/) if w() did fail. w() fails if the number is not semi-perfect, and hence in this case it is weird.

Now, the tight logic is in the w() function itself. I think this thing is neat.

sub w{
  my $s = pop || die;
  my $t = pop || die '!';
      eval { w( @_, $s-$t) },
      $@ =~ /!/ || die
          if $t <= $s;
  w( @_, $s)
}
[download]

Call as eval { w( @divisors, $sum) }

As I said, I'm not happy with the argument passing, but it's there as an extreme optimization. Re-ordering the arguments and just copying off the array ( my ($s, $t, @e) = @_;) causes performance to fall through the floor. So I take the 4 character hit in exchange for the ability to complete in real time. Even twiddling the script to pass in $s and $t as the first arguments and shifting them off grants a noticable performance hit.

Okay, this function will determine if for a given set of natural numbers, is there a subset of those numbers that add up to the given sum. I had originally approached this method completely differently, by trying to come up with all of the possible subsets for the given set, and then checking each of those to see if any of them added up to the sum. This worked, but was very expensive, and potentially wasteful. A function to build subsets by using binary counting is cheap, but character heavy.

So we go this way. First thing we do is pop off the sum we've been passed in and the number we're testing. If there's no sum, then we already recursed down to it, so we succeed - there is a semi perfect subset, so die quietly to fly out of the recursion and be done. If there is no number to test, then die with a bang ('!') - we've run out of numbers, so this sequence does not yield a semi-perfect result. If we have a number to test, we continue.

Next steps. If we're here, then we have a number to test, and we haven't reached the sum yet. If the number we're testing is less than our sum ($t < $s), then it's possible that the number is part of a semi-perfect subset. So in that case, we're going to recurse into our function, subtracting the test number from our sum. And we repeat.

Now, when we're done with that eval, if we died with a bang, then we want to keep checking - all we know is that that subset failed. However, if we died without a bang, then we found a successful subset, so we bubble up another die to jump out of our recursion with our "success" message. That is, if we died with a bang, we've got to keep checking, so we discard that test digit from out set and re-enter the function with the rest of the numbers in the set + our original sum. At this point, we've determined that that test digit cannot be in any subset that adds up to our sum. However, if we did NOT die with a bang, then we succeeded, so just bubble up the bangless die to jump out.

If we fall down to the last statement ( w(@_, $s) ), that means that our test number ($t) was greater than the sum we were checking, so we just throw it away (it was already popped off) and recurse back in w/o it. Once inside, we'll either end up succeeding or dying anyway.

12 is abundant (but not weird), so here's a sample runthrough of the function.

w(1,2,3,4,6, 12);
    w(1,2,3,4, 6);
        w(1,2,3, 2);
            w(1,2, 2);
                die (2 == 2), therefore 12 is semiperfect
[download]

Here's a runthrough of Limbic~Region's example set + sum below (1, 7, 11, 14, 18,   21), to give a more complex example:

w(1,7,11,14,18, 21)
    w(1,7,11,14, 3)    #21 - 18 becomes new product, toss onto the end
    # 14 > 3, ignore it, continue
    w(1,7,11, 3)
    # 11 > 3, ignore it, continue
    w(1,7, 3)
    # 7 > 3, ignore it, continue
    w(1, 3)
    # 1 <= 3, subtract from 3, continue
    w(2)    #pop off our sum (2), and our test digit. Oops!
            #No test digit, die with a bang, we failed.
#hops all the way back up to here, throws away 18, and continues.
#it has determined there is no subset that contains 18 and adds to 21.
w(1,7,11,14, 21)
    w(1,7,11, 7)    #21 - 14 becomes new product, toss onto the end
    # 11 > 7, ignore it, continue
    w(1,7, 7)
    # 7 <= 7, subtract it from 7, continue
        w(1, 0) #pops off the sum, which is 0 in this case, so we've s
+ucceeded. "die" with no bang -> success!
[download]