Take the 2-minute tour ×
Programming Puzzles & Code Golf Stack Exchange is a question and answer site for programming puzzle enthusiasts and code golfers. It's 100% free, no registration required.

A weird number is a number that the sum of proper divisors is greater than the number itself and no subset of proper divisors sum to that number.

Examples:

70 is a weird number because its proper divisors (1, 2, 5, 7, 10, 14, and 35) sum to 74, which is greater than 70, and no combination of these numbers sum to 70.

18 is not a weird number because its proper divisors (1, 2, 3, 4, 6, 9) sum to 25, which is greater than 18, but 3, 6, and 9 sum to 18.

Your task is to write the shortest program that inputs through std-in any number n and calculates and prints to a file or std-out the first n weird numbers with newline separation. No hard coding of the answers is allowed (sorry for not specifying this in the beginning).

For more examples, see this page: http://mathworld.wolfram.com/WeirdNumber.html

share|improve this question
1  
When this question was in the sandbox, I didn't comment that you should add a "no hard-coding" rule because it's there already in the word "calculate". I encourage people to downvote and flag as not-an-answer or low-quality any answers which don't attempt to calculate the result. (Relevant meta discussion). –  Peter Taylor Feb 22 at 20:29

11 Answers 11

up vote 2 down vote accepted

Mathematica 99 94 87

Spaces not needed. Slow!:

j = i = 0;
While[j<#, i++; If[Union@Sign[Tr /@ Subsets@Most@Divisors@i-i]=={-1, 1}, j++; Print@i]]&

At the expense of a few chars this is a faster version that checks only even numbers and skips multiples of 6 that are never weird:

j = i = 0;
While[j < #, 
      i += 2; If[Mod[i, 6] != 0 && Union@Sign[Tr /@ Subsets@Most@Divisors@i - i] == {-1, 1}, 
                 j++; Print@i]] &@3

it's still too slow for any useful purpose. Finds the first two in a few seconds but gets slower and slower as the number of divisors increase.

share|improve this answer
    
I was fiddling with a similar solution exploiting the fact that weird numbers are not pseudoperfect, but you got it much golfier than I had yet managed to. Very nice! –  Jonathan Van Matre Feb 25 at 4:48
    
@JonathanVanMatre Thank you :) –  belisarius Feb 25 at 4:59

Haskell - 129

I'm sure there's lots to golf here, but since the competition seems low for now I'll throw this in.

Don't try running this though, I managed to wait only the two first elements, third will start taking minutes.

(%)=filter
w n=take n$e%[1..]
e x=let d=((==0).mod x)%[1..x-1]in sum d>x&&all((/=x).sum)(i d)
i[]=[[]]
i(y:z)=map(y:)(i z)++(i z)
share|improve this answer
1  
That's the second time someone in Haskell is better than me in Sage, damn :D –  tohecz Feb 22 at 23:16
    
+1 for readability. –  devnull Feb 23 at 8:45

Python 2.7 (255 bytes)

import itertools as t
a=int(raw_input())
n=1
while a>0:
    d=[i for i in range(1,n/2+1) if not n%i]
    if all([n not in map(sum,t.combinations(d,i)) for i in range(len(d))]+[sum(d)>n]):
        print n
        a-=1
    n+=1
share|improve this answer

PHP, 267 bytes

$n=$x=0;while($n<$argv[1]){$x++;for($i=1,$s=0,$d=array();$i<$x;$i++){if($x%$i){continue;}$s+=$i;$d[]=$i;}if($s<$x){continue;}$t=pow(2,$m=count($d));for($i=0;$i<$t;$i++){for($j=0,$s=0;$j<$m;$j++){if(pow(2,$j)&$i){$s+=$d[$j];}}if($s==$x){continue 2;}}$n++;print"$x\n";}

And here's the original source code:

$n = 0;
$x = 0;

while ($n < $argv[1]) {
    $x++;

    for ($i = 1, $sum = 0, $divisors = array(); $i < $x; $i++) {
        if ($x % $i) {
            continue;
        }

        $sum += $i;
        $divisors[] = $i;
    }

    if ($sum < $x) {
        continue;
    }

    $num = count($divisors);
    $total = pow(2, $num);

    for ($i = 0; $i < $total; $i++) {  
        for ($j = 0, $sum = 0; $j < $num; $j++) { 
            if (pow(2, $j) & $i) {
                $sum += $divisors[$j];
            }
        }

        if ($sum == $x) {
            continue 2;
        }
    }

    print "$x\n";
}

You will note that it takes some time to output the numbers as it is performing a brute-force verification (you should get to 70 pretty fast, though).

share|improve this answer

R, 164

r=0;x=1;n=scan();while(r<n){i=which(!x%%(2:x-1));if(sum(i)-1&&!any(unlist(lapply(2:sum(i|T),function(o)colSums(combn(i,o))==x)))&sum(i)>x){r=r+1;cat(x,"\n")};x=x+1}

Un-golfed version:

r = 0
x = 1
n = scan()
while(r < n) {
  i = which(!x %% (2:x - 1))
  if( sum(i) - 1 &&
       !any(unlist(lapply(2:sum(i | T),
                          function(o) colSums(combn(i, o)) == x))) &
       sum(i) > x
     ){ r = r + 1
        cat(x, "\n")
  }
  x = x + 1
}

This takes some time due to brute-force.

share|improve this answer

Ruby - 152

x=2;gets.to_i.times{x+=1 while((a=(1..x/2).find_all{|y|x%y==0}).reduce(:+)<=x||(1..a.size).any?{|b|a.combination(b).any?{|c|c.reduce(:+)==x}});p x;x+=1}

Ruby With ActiveSupport - 138

x=2;gets.to_i.times{x+=1 while((a=(1..x/2).find_all{|y|x%y==0}).sum<=x||(1..a.size).any?{|b|a.combination(b).any?{|c|c.sum==x}});p x;x+=1}

Really slow and I'm almost sure there is still room for golfing...

share|improve this answer

Smalltalk, 143

((1to:(Integer readFrom:Stdin))reject:[:n||d|d:=(1to:n//2)select:[:d|(n\\d)=0].d sum<n or:[(PowerSet for:d)contains:[:s|s sum=n]]])map:#printCR

input:

1000

output:

70
836
share|improve this answer

SageMath: 143 131 bytes

x=1
def w():
 l=x.divisors()
 return 2*x>=sum(l)or max(2*x==sum(i)for i in subsets(l))
while n:
 while w():x+=1
 print x;n-=1;x+=1

It's moreorless not even golfed, there's not too much to golf anyways in the code. The biggest thing is that you should do the test 2*x>=sum(l) first, it would save a lot of computation time. One has to realize that max on booleans is or Second thing is that w(x) is False for weird numbers and True for non-weird numbers. Ungolfed version:

def w(x) :
 Divisors = x.divisors()
 return 2*x >= sum(Divisors) or max ( sum(SubS) == 2*x for SubS in subsets(Divisors) )

x=1

for k in xrange(n) :
 while w(x) : x += 1
 print x
 x += 1
share|improve this answer

C++ - 458

This is not all my solution as I had to ask on SO for help calculating the sum of the subsets, but everything else is mine:

#include<iostream>
#include<vector>
using namespace std;
#define v vector<int>
#define r return
#define c const_iterator
v x(int i){v d;for(int k=1;k<i;k++)if(i%k==0)d.push_back(k);r d;}bool u(v::c i,v::c e,int s){if(s==0)r 0;if(i==e)r 1;r u(i+1,e,s-*i)&u(i+1,e,s);}bool t(v&d,int i){bool b=u(d.begin(),d.end(),i);if(b)cout<<i<<endl;r b;}int main(){v d;int n;cin>>n;for(int i=2,j=0;j<n;i++){d=x(i);int l=0;for(int k=0;k<d.size();k++)l+=d[k];if(l>i)if(t(d,i))j++;}}

Long version:

#include<iostream>
#include<vector>
using namespace std;

vector<int> divisors(int i) {

    vector<int> divs;
    for(int k = 1; k < i; k++)
        if(i%k==0)
            divs.push_back(k);
    return divs;
}

bool u(vector<int>::const_iterator vi, vector<int>::const_iterator end, int s) {

    if(s == 0) return 0;
    if(vi == end) return 1;
    return u(vi + 1, end, s - *vi) & u(vi + 1, end, s);
}

bool t(vector<int>&d, int i) {

    bool b = u(d.begin(), d.end(), i);
    if(b) cout<< i << endl;
    return b;
}

int main() {

    vector<int> divs;
    int n;
    cin>>n;

    for(int i = 2, j = 0; j < n; i++) {
        divs = divisors(i);

        int sum_divs = 0;
        for(int k = 0; k < divs.size(); k++)
            sum_divs += divs[k];

        if(sum_divs > i)
            if(t(divs, i))
                j++;
    }
}

It has currently only calculated the first two (70 and 836). I killed it after that.

share|improve this answer
    
It would be nice to post a readable version as well, especially since you make it as a one-liner ;) –  tohecz Feb 22 at 23:16
    
@tohecz Sure, let me edit it. –  hosch250 Feb 22 at 23:20
    
@tohecz I'm done. –  hosch250 Feb 22 at 23:31

Perl, 173

Let me add another useless solution. This solution is so slow that it can't even output anything past the first weird number. I dare say it is the slowest of all the solution here.

$n=<>;$i=2;while($n){$b=qr/^(?=(.+)\1{2}$)((.+)(?=.*(?(2)(?=\2$)\3.+$|(?=\1$)\3.+$))(?=.*(?=\1$)\3+$))+/;$_='x'x3x$i;if(/$b/&&($+[0]>$i)&&!/$b\1{2}$/){print"$i\n";$n--}$i++}

Demo

The same code written in Java (which I am more comfortable with) can't even recognize the 2nd weird number (836), and I have already fed the number directly to the checking method (instead of looping and checking every number).

The core of this solution lies in the regex:

^(?=(.+)\1{2}$)((.+)(?=.*(?(2)(?=\2$)\3.+$|(?=\1$)\3.+$))(?=.*(?=\1$)\3+$))+

And how the string is set up to be 3 times the number that we are checking.

The length of the string is set up to be 3 times the number that we are checking i: the first 2 i is for matching summation of factors and the last 1 i is reserved for checking whether a number is a factor of i.

(?=(.+)\1{2}$) is used to capture the number that we are checking.

((.+)(?=.*(?(2)(?=\2$)\3.+$|(?=\1$)\3.+$))(?=.*(?=\1$)\3+$))+ matches the factors of the number. Later iteration will match a smaller factor than an earlier iteration.

  • We can see that these 2 parts (.+) and (?=.*(?=\1$)\3+$) together selects a factor of the number being checked.
  • (?=.*(?(2)(?=\2$)\3.+$|(?=\1$)\3.+$)) makes sure that the factor selected is smaller than the number being checked in the first iteration, and is smaller than previous factor in subsequent iterations.

The regex tries to match as many factors of the number as it can within the limit of 2 i. But we don't care about the actual value of sum of divisors, we only care whether the number is abundant.

Then the 2nd regex, which is the first regex with \1{2}$ added. As a result, the regex makes sure the sum of (some) factors of the number being checked is equal to the number itself:

^(?=(.+)\1{2}$)((.+)(?=.*(?(2)(?=\2$)\3.+$|(?=\1$)\3.+$))(?=.*(?=\1$)\3+$))+\1{2}$

The constraint added will cause the regex engine to perform a backtracking search on all possible subsets of factors, so it is going to be extremely slow.

share|improve this answer

Perl, 176 174 bytes

$n=<>;$i=9;X:while($n){@d=grep{!($i%$_)}1..$i-1;$l=0;map{$a=$_;$s=0;$s+=$d[$_]for grep{2**$_&$a}0..@d-1;$i++,next X if$s==$i;$l=1 if$s>$i}0..2**@d-1;$n--,print$i,$/if$l;$i++}

The number of weird numbers are expected in STDIN and the found numbers are printed to STDOUT.

Ungolfed version

#!/usr/bin/env perl
use strict;
$^W=1;

# read number from STDIN
my $n=<>;
# $i is the loop variable that is tested for weirdness
my $i=9; # better start point is 70, the smallest weird number
# $n is the count of numbers to find
X: while ($n) {
    # find divisors and put them in array @divisors
    my @divisors = grep{ !($i % $_) } 1 .. $i-1; # better: 1 .. int sqrt $i
    # $large remembers, if we have found a divisor sum greater than the number
    my $large = 0;
    # looping through all subsets. The subset of divisors is encoded as
    # bit mask for the divisors array.
    map {
        my $subset = $_;
        # calculate the sum for the current subset of divisors
        my $sum = 0;
        map { $sum += $divisors[$_] }
            grep { 2**$_ & $subset }
                0 .. @divisors-1;
        # try next number, if the current number is pseudoperfect
        $i++, next X if $sum == $i; # better: $i+=2 to skip even numbers
        $large = 1 if $sum > $i;
    } 0 .. 2**@divisors - 1;
    # print weird number, if we have found one
    $n--, print "$i\n" if $large;
    $i++; # better: $i+=2 to skip even numbers
}
__END__

Limitations

  • Slow, brute force.
  • The count of divisors for a number is limited to the "bitness" of integers in Perl.
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.