login
A307859
Consider the non-unitary aliquot parts, in ascending order, of a composite number. Take their sum and repeat the process deleting the minimum number and adding the previous sum. The sequence lists the numbers that after some iterations reach a sum equal to themselves.
0
24, 112, 189, 578, 1984, 2125, 3993, 5043, 9583, 19197, 32512, 126445, 149565, 175689, 225578, 236883, 1589949, 1862935, 1928125, 3171174, 5860526, 6149405, 11442047, 16731741, 60634549, 75062535, 134201344, 177816209, 1162143369, 4474779517, 10369035821
OFFSET
1,1
LINKS
Eric Weisstein's World of Mathematics, Unitary Divisor
Wikipedia, Unitary divisor
EXAMPLE
Divisors of 578 are 1, 2, 17, 34, 289, 578. Non-unitary aliquot parts are 17 and 34.
We have:
17 + 34 = 51;
34 + 51 = 85;
51 + 85 = 136;
85 + 136 = 221;
136 + 221 = 357;
221 + 357 = 578.
MAPLE
with(numtheory):P:=proc(q, h) local a, b, c, k, n, t, v; v:=array(1..h);
for n from 1 to q do if not isprime(n) then b:=sort([op(divisors(n))]);
a:=[]; for k from 2 to nops(b)-1 do if gcd(b[k], n/b[k])>1 then
a:=[op(a), b[k]]; fi; od; b:=nops(a); if b>1 then c:=0;
for k from 1 to b do v[k]:=a[k]; c:=c+a[k]: od;
t:=b+1; v[t]:=c; while v[t]<n do t:=t+1; v[t]:=add(v[k], k=t-b..t-1);
od; if v[t]=n then print(n); fi; fi; fi; od; end: P(10^9, 1000);
MATHEMATICA
aQ[n_] := CompositeQ[n] && Module[{s = Select[Divisors[n], GCD[#, n/#] != 1 &]}, If[Length[s] < 2, False, While[Total[s] < n, AppendTo[s, Total[s]]; s = Rest[s]]; Total[s] == n]]; Select[Range[10^4], aQ] (* Amiram Eldar, May 07 2019 *)
KEYWORD
nonn
AUTHOR
Paolo P. Lava, May 02 2019
EXTENSIONS
a(20)-a(31) from Amiram Eldar, May 07 2019
STATUS
approved