login

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”).

A126173
Larger element of a reduced infinitary amicable pair.
8
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,1
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.
LINKS
Jan Munch Pedersen, Tables of Aliquot Cycles.
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).
EXAMPLE
a(3)=817479 because 817479 is the largest member of the third reduced infinitary amicable pair, (573560,817479)
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 *)
KEYWORD
nonn
AUTHOR
Ant King, Dec 23 2006
EXTENSIONS
a(15)-a(28) from Amiram Eldar, Jan 22 2019
STATUS
approved