A258142 Consider the 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.

6, 21, 60, 85, 90, 261, 976, 2009, 87360, 97273, 4948133, 68353213

Offset: 1

Author

Paolo P. Lava, May 22 2015

Keywords

• nonn
• more

Comments

A002827 is a subset of this sequence.

No more terms below 10^8. - Amiram Eldar, Jan 12 2019

Examples

			Divisors of 85 are 1, 5, 17, 85. Unitary aliquot parts are 1, 5, 17.
We have:
1 + 5 + 17 = 23;
5 + 17 + 23 = 45;
17 + 23 + 45 = 85.
Divisors of 2009 are 1, 7, 41, 49, 287, 2009.
Unitary aliquot parts are 1, 41, 49. We have:
1 + 41 + 49 = 91;
41 + 49 + 91 = 181;
49 + 91 + 181 = 321;
91 + 181 + 321 = 593;
181 + 321 + 593 = 1095;
321 + 593 + 1095 = 2009.
		

Links

• Eric Weisstein's World of Mathematics, Unitary Divisor
• Eric Weisstein's World of Mathematics, Unitary Divisor Function
• Eric Weisstein's World of Mathematics, Unitary Perfect Number
• Wikipedia, Unitary divisor

Crossrefs

Cf. A002827, A034444, A246544, A247012, A247013, A248134.

Programs

Maple

with(numtheory):P:=proc(q,h) local a,b,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 1 to nops(b)-1 do if gcd(b[k],n/b[k])=1 then a:=[op(a),b[k]]; fi; od;
a:=sort(a); b:=nops(a); if b>1 then for k from 1 to b do v[k]:=a[k]; od;
t:=b+1; v[t]:=add(v[k], k=1..b); while v[t]
				

Mathematica

aQ[n_] := Module[{s = Most[Select[Divisors[n], GCD[#, n/#] == 1 &]]}, If[Length[s] == 1, False, While[Total[s] < n, AppendTo[s, Total[s]]; s = Rest[s]]; Total[s] == n]]; Select[Range[2, 10^8], aQ] (* Amiram Eldar, Jan 12 2019 *)

Extensions

a(11)-a(12) from Amiram Eldar, Jan 12 2019