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.

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

Table of n, a(n) for n=1..31.

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 *)

Crossrefs

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

Sequence in context: A282211 A103473 A162451 * A263542 A281133 A064595

Adjacent sequences: A307856 A307857 A307858 * A307860 A307861 A307862

Keyword

nonn

Author

Paolo P. Lava, May 02 2019

Extensions

a(20)-a(31) from Amiram Eldar, May 07 2019

Status

approved