A126174 Smaller member of an augmented infinitary amicable pair.

1252216, 1754536, 2166136, 2362360, 6224890, 7626136, 7851256, 9581320, 12480160, 12494856, 13324311, 15218560, 15422536, 19028296, 29180466, 36716680, 37542190, 40682824, 45131416, 45495352, 56523810, 67195305, 71570296, 80524665, 89740456, 93182440, 101304490

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

Amiram Eldar, Table of n, a(n) for n = 1..276

Jan Munch Pedersen, Tables of Aliquot Cycles.

Formula

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

Example

a(3)=2166136 because 2166136 is the smaller element of the third augmented infinitary amicable pair, (2166136,2580105).

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; AugmentedInfinitaryAmicableNumberQ[n_] := If[properinfinitarydivisorsum[properinfinitarydivisorsum[ n] + 1] == n - 1 && ! properinfinitarydivisorsum[n] + 1 == n, True, False]; AugmentedInfinitaryAmicablePairList[k_] := (anlist = Select[Range[k], AugmentedInfinitaryAmicableNumberQ[ # ] &]; prlist = Table[ Sort[{anlist[[n]], properinfinitarydivisorsum[anlist[[n]]] + 1}], {n, 1, Length[anlist]}]; amprlist = Union[prlist, prlist]); data = AugmentedInfinitaryAmicablePairList[10^7]; Table[First[data[[k]]], {k, 1, Length[data]}]
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, n]], {n, 2, 10^9}]; s (* Amiram Eldar, Jan 20 2019 *)

Crossrefs

Cf. A126169, A049417, A126168, A037445, A126170, A126171, A126173, A126175, A126176.

Sequence in context: A251156 A210132 A251118 * A186089 A208489 A257268

Adjacent sequences: A126171 A126172 A126173 * A126175 A126176 A126177

Keyword

hard,nonn

Author

Ant King, Dec 23 2006

Extensions

a(9)-a(27) from Amiram Eldar, Jan 20 2019

Status

approved