Year-end appeal: Please make a donation to the OEIS Foundation to support ongoing development and maintenance of the OEIS. We are now in our 61st year, we have over 378,000 sequences, and we’ve reached 11,000 citations (which often say “discovered thanks to the OEIS”).
%I #12 Jan 24 2019 03:42:11
%S 126,846,1260,7920,8460,11760,10856,14595,17700,43632,45888,49308,
%T 83142,62700,71145,73962,96576,83904,107550,88730,178800,112672,
%U 131100,125856,168730,149952,196650,203432,206752,224928,306612,365700,399592,419256,460640,548550
%N Larger member of an infinitary amicable pair.
%C A divisor of n is called infinitary if it is a product of divisors of the form p^{y_a 2^a}, where p^y is a prime power dividing n and sum_a y_a 2^a is the binary representation of y.
%H Amiram Eldar, <a href="/A126170/b126170.txt">Table of n, a(n) for n = 1..7916</a>
%H Jan Munch Pedersen, <a href="http://62.198.248.44/aliquot/tables.htm">Tables of Aliquot Cycles</a>.
%F The values of n for which isigma(m)=isigma(n)=m+n and n>m.
%e a(5)=8460 because the fifth infinitary amicable pair is (5940,8460) and 8460 is its largest member.
%t ExponentList[n_Integer, factors_List] := {#, IntegerExponent[n, # ]} & /@ factors; InfinitaryDivisors[1] := {1}; InfinitaryDivisors[n_Integer?Positive] := Module[ { factors = First /@ FactorInteger[n], d = Divisors[n] }, d[[Flatten[Position[ Transpose[ Thread[Function[{f, g}, BitOr[f, g] == g][ #, Last[ # ]]] & /@ Transpose[Last /@ ExponentList[ #, factors] & /@ d]], _?( And @@ # &), {1}]] ]] ] Null; properinfinitarydivisorsum[k_] := Plus @@ InfinitaryDivisors[k] - k; InfinitaryAmicableNumberQ[k_] := If[Nest[properinfinitarydivisorsum, k, 2] == k && ! properinfinitarydivisorsum[k] == k, True, False]; data1 = Select[ Range[10^6], InfinitaryAmicableNumberQ[ # ] &]; data2 = properinfinitarydivisorsum[ # ] & /@ data1; data3 = Table[{data1[[k]], data2[[k]]}, {k, 1, Length[data1]}]; data4 = Select[data3, First[ # ] < Last[ # ] &]; Table[Last[data4[[k]]], {k, 1, Length[data4]}]
%t fun[p_, e_] := Module[{b = IntegerDigits[e, 2]}, m = Length[b]; Product[If[b[[j]] > 0, 1 + p^(2^(m - j)), 1], {j, 1, m}]]; infs[n_] := Times @@ (fun @@@ FactorInteger[n]) - n; s = {}; Do[k = infs[n]; If[k > n && infs[k] == n, AppendTo[s, k]], {n, 2, 10^5}]; s (* _Amiram Eldar_, Jan 22 2019 *)
%Y Cf. A126169, A049417, A126168, A037445.
%K nonn
%O 1,1
%A _Ant King_, Dec 21 2006
%E a(33)-a(36) from _Amiram Eldar_, Jan 22 2019