|
%I #8 Jan 22 2019 09:01:55
%S 2295,75495,817479,1902215,1341495,1348935,2226014,2421704,3123735,
%T 3010215,5644415,4282215,7509159,10106504,12900734,24519159,31356314,
%U 41950359,43321095,80870615,42125144,85141719,87689415,87802407,86477895,105993657,168669879,129081735
%N Larger element of a reduced 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="/A126173/b126173.txt">Table of n, a(n) for n = 1..278</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+1, where n>m and isigma(n) is given by A049417(n).
%e a(3)=817479 because 817479 is the largest member of the third reduced infinitary amicable pair, (573560,817479)
%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; 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]}]
%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] - 1; If[k > n && infs[k] == n + 1, AppendTo[s, k]], {n, 2, 10^5}]; s (* _Amiram Eldar_, Jan 22 2019 *)
%Y Cf. A126169, A049417, A126168, A037445, A126170, A126171, A126172, A126174, A126175, A126176.
%K nonn
%O 1,1
%A _Ant King_, Dec 23 2006
%E a(15)-a(28) from _Amiram Eldar_, Jan 22 2019
|
