15
\$\begingroup\$

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

\$\endgroup\$
1
  • 1
    \$\begingroup\$ 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). \$\endgroup\$ Feb 22, 2014 at 20:29

13 Answers 13

4
\$\begingroup\$

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)
\$\endgroup\$
1
  • 1
    \$\begingroup\$ That's the second time someone in Haskell is better than me in Sage, damn :D \$\endgroup\$
    – yo'
    Feb 22, 2014 at 23:16
2
\$\begingroup\$

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.

\$\endgroup\$
1
  • \$\begingroup\$ 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! \$\endgroup\$ Feb 25, 2014 at 4:48
2
\$\begingroup\$

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...

\$\endgroup\$
2
\$\begingroup\$

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
\$\endgroup\$
1
\$\begingroup\$

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).

\$\endgroup\$
1
\$\begingroup\$

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.

\$\endgroup\$
1
\$\begingroup\$

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
\$\endgroup\$
1
\$\begingroup\$

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
\$\endgroup\$
1
\$\begingroup\$

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.

\$\endgroup\$
3
  • \$\begingroup\$ It would be nice to post a readable version as well, especially since you make it as a one-liner ;) \$\endgroup\$
    – yo'
    Feb 22, 2014 at 23:16
  • \$\begingroup\$ @tohecz Sure, let me edit it. \$\endgroup\$
    – user10766
    Feb 22, 2014 at 23:20
  • \$\begingroup\$ @tohecz I'm done. \$\endgroup\$
    – user10766
    Feb 22, 2014 at 23:31
1
\$\begingroup\$

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.

\$\endgroup\$
1
\$\begingroup\$

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.
\$\endgroup\$
1
\$\begingroup\$

Jelly, 15 bytes

ÆḌŒP§e@=ÆḌS<Ɗµ#

Try it online!

Takes input via STDIN.

Insanely inefficient, times out for \$n > 1\$ on TIO, as it checks each \$k = 1, 2, \dots\$ until it finds \$n\$ values that fit, and for each \$k\$ it generates \$2^{\sigma(k)-k}\$ sublists (where \$\sigma(k)\$ is the sum of divisors function)

How it works

ÆḌŒP§e@=ÆḌS<Ɗµ# - Main link, takes no arguments
             µ# - Take an integer from STDIN, n, and run the previous code over each integer, k, from 0 until n truthy values are found:
ÆḌŒP§e@         -   First check for weirdness:
ÆḌ              -     Take the proper divisors of k
  ŒP            -     Find the powerset of the proper divisors
    §           -     Get the sum of each
                -       This gives the sum of each subset of proper divisors
     e@         -     Is k equal to one of the sums?
                -     This gives 0 if no combination of these numbers sum to k and 1 otherwise
        ÆḌS<Ɗ   -   Second check for weirdness:
            Ɗ   -     Group the previous 3 commands together:
        ÆḌS     -       Is the proper divisor sum of k...
           <    -       Less than k?
                -     This gives 0 if the proper divisor sum of k is greater than k and 1 otherwise
      =         -   Are the two checks equal?
                -     There are three possible values that the two checks could output:
                -        0, 1: k cannot be expressed as a sum of a subset of its proper divisors and k is less than or equal to its proper divisor sum, therefore k is not weird
                -        1, 0: k can be expressed as a sum of a subset of its proper divisors and k is greater than its proper divisor sum, therefore k is not weird
                -        0, 0: k cannot be expressed as a sum of a subset of its proper divisors and k is greater than its proper divisor sum, therefore k is weird
                -     1, 1 cannot be a possibility as that would require that k can be expressed as a sum of a subset of its proper divisors and that k is greater than its proper divisor sum, which are contradictory
                -     Therefore, checking whether the two checks result in the same value suffices to check for weirdness
\$\endgroup\$
0
\$\begingroup\$

Python 2, 100 bytes

n=input()
i=0
while n:
 i+=1;s=1;d=1
 while d<i:s|=s<<d*(i%d<1);d+=1
 s>>=i
 if s>1>s&1:print i;n-=1

Attempt This Online!

I use the integer s as a bitset, telling me the sums of divisors of i. The k-th bit tells me whether k is a sum of the divisors found.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.