RosettaCodeData/Task/Weird-numbers/Mathematica/weird-numbers.math

31 lines
574 B
Plaintext

ClearAll[WeirdNumberQ, HasSumQ]
HasSumQ[n_Integer, xs_List] := HasSumHelperQ[n, ReverseSort[xs]]
HasSumHelperQ[n_Integer, xs_List] := Module[{h, t},
If[Length[xs] > 0,
h = First[xs];
t = Drop[xs, 1];
If[n < h,
HasSumHelperQ[n, t]
,
n == h \[Or] HasSumHelperQ[n - h, t] \[Or] HasSumHelperQ[n, t]
]
,
False
]
]
WeirdNumberQ[n_Integer] := Module[{divs},
divs = Most[Divisors[n]];
If[Total[divs] > n,
! HasSumQ[n, divs]
,
False
]
]
r = {};
n = 0;
While[
Length[r] < 25,
If[WeirdNumberQ[++n], AppendTo[r, n]]
]
Print[r]