|
%I #15 Jan 27 2019 05:10:43
%S 288,450,2640,5778,379632,588042,1658640,3041514,2907680,3743440,
%T 4235160,7165314,4612080,10113066,24103980,40475214,25858020,33363990,
%U 51447792,80640522,76202040,130466754,76286064,100954890,79343220,106451334,110175060,143633574,155611632
%N Amicable pairs where only abundant aliquot parts are considered.
%e Abundant aliquot parts of 288 are 12, 18, 24, 36, 48, 72, 96, 144 and their sum is 450.
%e Abundant aliquot parts of 450 are 18, 30, 90, 150 and their sum is 288.
%p with(numtheory): P:=proc(q) local a,b,c,d,k,n; for n from 1 to q do
%p a:=sort([op(divisors(n))]); b:=0; for k from 1 to nops(a)-1 do if 2*a[k]<sigma(a[k]) then b:=b+a[k]; fi; od;
%p c:=sort([op(divisors(b))]); d:=0; for k from 1 to nops(c)-1 do if 2*c[k]<sigma(c[k]) then d:=d+c[k]; fi; od; if d=n and d<>b then print(n); fi; od; end: P(10^6);
%t abQ[n_] := DivisorSigma[1,n] > 2n; s[n_] := DivisorSum[n, #&, #<n && abQ[#]&]; seq={}; Do[m=s[n]; If[m>n && s[m]==n, AppendTo[seq, {n,m}]], {n, 1, 10^5}]; Flatten[seq] (* _Amiram Eldar_, Jan 26 2019 *)
%Y Cf. A063990, A259180, A280516.
%K nonn,tabf
%O 1,1
%A _Paolo P. Lava_, Jan 04 2017
%E Data corrected and extended by _Amiram Eldar_, Jan 26 2019
|
