```
(* Input: Range of even numbers --- Output: Primitive weird numbers *)
Block[{$RecursionLimit=Infinity},
subOfSum[ss_, kk_, rr_]:= Module[{s=ss, k=kk, r=rr},
If[ s+w[[k]] >=mm && s +w[[k]] <=m, t=False; Goto[ done](*Found*),
If[s +w[[k]]+w[[k +1]] <=m, subOfSum[s +w[[k]], k+1, r-w[[k]]]];
If[s+r -w[[k]] >= m && s+w[[k+1]] <= m, subOfSum[s,k+1, r-w[[k]]]]]; t](* end subOfSum *);
greedyQ[ab_]:= Module[{ abn=ab, v, sum, s, j, jj, k}, tt=False;
jj = Length[w]; (*start search*)
Do[s = r; sum = 0; Do[ v=w[[j]]; sum = sum + v;
If[sum > abn, sum = sum -v; Goto[nxt]];
If[sum == abn, tt = True; Goto[ doneG]]; s=s-v; Label[nxt], {j, jj, 1, -1}];
jj= jj-1, {k, 1, jj-1}] ; Label[doneG];
(* True means found, False not found *) tt] (*end greedyQ*);
cnt=0; Do[ If[Mod[n,3]==0, Goto[agn]]; r=DivisorSigma[1, n]; m=r- 2*n;
If[m > 0, fi = FactorInteger[n]; largestP = fi[[Length[fi]]][[1]];
nn = n/largestP; If[m > 2*nn || Length[fi] < 3, Goto[agn]];
If[DivisorSigma[1, nn] > 2*nn, Goto[agn]]; t = True; r = r-n;
ww = Divisors[n]; lenW = Length[ww];
Do[If[ww[[i]] <= m, w = Drop[ww, i- lenW]; Break[], r = r-ww[[i]]],{i, lenW -1, 1, -1}];
If[r >= m, If[greedyQ[ m], t = False, (*Powers of 2 dropped*)
exp2 = fi[[1]][[2]]; sig2= 2^(exp2+1) -1; mm = m - sig2;
lenW= Length[w]; ww={};
If[exp2 > 1, Do[Do[If[w[[i]] == 2^ii, ww = AppendTo[ww, w[[i]]]], {i, 1, lenW}],
{ ii, 0, exp2}]; w= Complement[w, ww]
(*end T if*),
w= Drop[w, 2]];
(*end Pwr2*)
t =subOfSum[0, 1, r]]]; Label[done];
If[t, Print[++cnt, " ", n, " ", t]]];
Label[agn], {n, 2, 1000000, 2}]]
```

The above is an algorithm I wrote for finding primitive even weird numbers. The code is long and I'm sure, the coding is not very well written, but it is fast. The range of numbers to check for is at the bottom where I have `{n, 2, 1000000, 2}`

. This is for finding all even weird numbers in range of `2`

to `10^6`

. Any range can be put in and is only limited by *Mathematica* to factor the numbers.

Brent

How the algorithm works. It calculates primitive weird numbers which are always primitive abundant numbers. These are weird numbers that are not multiples of other weird numbers.

The algorithm eliminates numbers which can't be primitive weird until a finial recursive search is done to check if a sum of divisors can make up the abundance of the number. The abundance of the number is m = Sigma[n]-2*n. After several simple checks, the number is checked to see if it's not a primitive abundant number. For all primitive abundant numbers, Sigma[n]/n <= 2*(1+1/p), where p is the largest prime of the number n. If m > (2*n)/p, it can't be primitive abundant. Also, n/p needs to be a deficient number to be primitive weird.

All the divisors of n are eliminated that are greater than m. Let r equal to the sum of all the remaining divisors. If r < m, then n is weird and done. If not, do a quick search using a greedy type algorithm trying to form a sum of the remaining divisors to equal the abundance m. If this fails, the number may be weird.

Since n is even, remove all the divisors of Sigma[2^x] and put the reminding divisors into a list w . Note, the divisors of a number 2^x can be summed to any number from 1 to Sigma[2^x]. Let mm equal to the abundance minus Sigma[2^x]. If a sum can be made of the list w that fall in the range between m to mm, then the number is not weird.

Let r equal to the sum of divisors in w before the powers of 2 are removed. Call the recursive algorithm subOfSum[ 0, 1, r] to try to find a subset of divisors w to be between mm and m. If none can be found, then n is primitive weird.

Sorry my code is so bad. I hope the description can be followed. If you have any questions on anything, let me know.

Brent

See also: https://groups.google.com/forum/#%21topic/comp.soft-sys.math.mathematica/qVPFykTWpKM

– Qianyi Guo – 2015-02-05T05:52:03.3933The problem is that

`Subsets[Most[Divisors[720]]]`

eats up your RAM. – Karsten 7. – 2015-02-05T06:46:50.0471Does "how to optimize the code without prior knowledge of properties of weird numbers" mean, that you'll accept solely a brute force solution? – Karsten 7. – 2015-02-05T07:00:08.310

1You can avoid

`Subsets`

if you set up the check as a subset sum problem.`FindInstance`

for example could be used for this. – Daniel Lichtblau – 2015-02-05T17:30:56.060