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
-
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\$Peter Taylor– Peter Taylor2014年02月22日 20:29:07 +00:00Commented Feb 22, 2014 at 20:29
13 Answers 13
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)
-
1\$\begingroup\$ That's the second time someone in Haskell is better than me in Sage, damn :D \$\endgroup\$yo'– yo'2014年02月22日 23:16:49 +00:00Commented Feb 22, 2014 at 23:16
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.
-
\$\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\$Jonathan Van Matre– Jonathan Van Matre2014年02月25日 04:48:59 +00:00Commented Feb 25, 2014 at 4:48
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...
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.
-
\$\begingroup\$ It would be nice to post a readable version as well, especially since you make it as a one-liner ;) \$\endgroup\$yo'– yo'2014年02月22日 23:16:11 +00:00Commented Feb 22, 2014 at 23:16
-
\$\begingroup\$ @tohecz Sure, let me edit it. \$\endgroup\$user10766– user107662014年02月22日 23:20:16 +00:00Commented Feb 22, 2014 at 23:20
-
\$\begingroup\$ @tohecz I'm done. \$\endgroup\$user10766– user107662014年02月22日 23:31:44 +00:00Commented Feb 22, 2014 at 23:31
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
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).
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.
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
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
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)&&!/$b1円{2}$/){print"$i\n";$n--}$i++}
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.
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.
Jelly, 15 bytes
ÆḌŒP§e@=ÆḌS<Ɗμ#
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
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
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.