cp's OEIS Frontend

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.

%I A307859 #16 Feb 16 2025 08:33:55
%S A307859 24,112,189,578,1984,2125,3993,5043,9583,19197,32512,126445,149565,
%T A307859 175689,225578,236883,1589949,1862935,1928125,3171174,5860526,6149405,
%U A307859 11442047,16731741,60634549,75062535,134201344,177816209,1162143369,4474779517,10369035821
%N 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.
%H A307859 Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/UnitaryDivisor.html">Unitary Divisor</a>
%H A307859 Wikipedia, <a href="http://en.wikipedia.org/wiki/Unitary_divisor">Unitary divisor</a>
%e A307859 Divisors of 578 are 1, 2, 17, 34, 289, 578. Non-unitary aliquot parts are 17 and 34.
%e A307859 We have:
%e A307859    17 +  34 =  51;
%e A307859    34 +  51 =  85;
%e A307859    51 +  85 = 136;
%e A307859    85 + 136 = 221;
%e A307859   136 + 221 = 357;
%e A307859   221 + 357 = 578.
%p A307859 with(numtheory):P:=proc(q,h) local a,b,c,k,n,t,v; v:=array(1..h);
%p A307859 for n from 1 to q do if not isprime(n) then b:=sort([op(divisors(n))]);
%p A307859 a:=[]; for k from 2 to nops(b)-1 do if gcd(b[k],n/b[k])>1 then
%p A307859 a:=[op(a),b[k]]; fi; od; b:=nops(a); if b>1 then c:=0;
%p A307859 for k from 1 to b do v[k]:=a[k]; c:=c+a[k]: od;
%p A307859 t:=b+1; v[t]:=c; while v[t]<n do t:=t+1; v[t]:=add(v[k], k=t-b..t-1);
%p A307859 od; if v[t]=n then print(n); fi; fi; fi; od; end: P(10^9,1000);
%t A307859 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 *)
%Y A307859 Cf. A002827, A034444, A246544, A247012, A247013, A248134, A258142.
%K A307859 nonn
%O A307859 1,1
%A A307859 _Paolo P. Lava_, May 02 2019
%E A307859 a(20)-a(31) from _Amiram Eldar_, May 07 2019