A126173 Larger element of a reduced infinitary amicable pair.

2295, 75495, 817479, 1902215, 1341495, 1348935, 2226014, 2421704, 3123735, 3010215, 5644415, 4282215, 7509159, 10106504, 12900734, 24519159, 31356314, 41950359, 43321095, 80870615, 42125144, 85141719, 87689415, 87802407, 86477895, 105993657, 168669879, 129081735

Offset: 1

Author

Ant King, Dec 23 2006

Keywords

• nonn

Comments

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.

Examples

			a(3)=817479 because 817479 is the largest member of the third reduced infinitary amicable pair, (573560,817479)
		

Links

• Amiram Eldar, Table of n, a(n) for n = 1..278
• Jan Munch Pedersen, Tables of Aliquot Cycles.

Crossrefs

Cf. A126169, A049417, A126168, A037445, A126170, A126171, A126172, A126174, A126175, A126176.

Programs

Mathematica

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; ReducedInfinitaryAmicableNumberQ[n_] := If[properinfinitarydivisorsum[properinfinitarydivisorsum[ n] - 1] == n + 1 && n > 1, True, False]; ReducedInfinitaryAmicablePairList[k_] := (anlist = Select[Range[k], ReducedInfinitaryAmicableNumberQ[ # ] &]; prlist = Table[Sort[{anlist[[n]], properinfinitarydivisorsum[anlist[[n]]] - 1}], {n, 1, Length[anlist]}]; amprlist = Union[prlist, prlist]); data1 = ReducedInfinitaryAmicablePairList[10^7]; Table[Last[data1[[k]]], {k, 1, Length[data1]}]
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] - 1; If[k > n && infs[k] == n + 1, AppendTo[s, k]], {n, 2, 10^5}]; s (* Amiram Eldar, Jan 22 2019 *)

Formula

The values of n for which isigma(m)=isigma(n)=m+n+1, where n>m and isigma(n) is given by A049417(n).

Extensions

a(15)-a(28) from Amiram Eldar, Jan 22 2019