|
%I #12 Nov 20 2018 05:19:40
%S 36,180,252,396,468,612,684,828,1044,1116,1260,1332,1476,1548,1692,
%T 1800,1908,1980,2124,2196,2340,2412,2556,2628,2700,2772,2844,2988,
%U 3060,3204,3276,3420,3492,3636,3708,3852,3924,4068,4140,4284,4500,4572,4716,4788,4932
%N Exponential pseudoperfect numbers (A318100) equal to the sum of a subset of their proper exponential divisors in a single way.
%C The exponential version of A064771.
%H Eric Weisstein's World of Mathematics, <a href="http://mathworld.wolfram.com/e-Divisor.html">e-Divisor</a>
%H Eric Weisstein's World of Mathematics, <a href="http://mathworld.wolfram.com/e-PerfectNumber.html">e-Perfect Number</a>
%e 4500 is in the sequence since its proper exponential divisors are 30, 60, 90, 180, 750, 1500, 2250 and {750, 1500, 2250} is the only subset that sums to 4500.
%t dQ[n_, m_] := (n>0&&m>0 &&Divisible[n, m]); expDivQ[n_, d_] := Module[ {ft=FactorInteger[n]}, And@@MapThread[dQ, {ft[[;; , 2]], IntegerExponent[ d, ft[[;; , 1]]]} ]]; eDivs[n_] := Module[ {d=Rest[Divisors[n]]}, Select[ d, expDivQ[n, #]&] ]; esigma[1]=1; esigma[n_] := Total@eDivs[n]; eDeficientQ[n_] := esigma[n] < 2n; a = {}; n = 0; While[Length[a] < 30, n++; If[eDeficientQ[n], Continue[]]; d = Most[eDivs[n]]; c = SeriesCoefficient[Series[Product[1 + x^d[[i]], {i, Length[d]}], {x, 0, n}], n]; If[c == 1, AppendTo[a, n]]]; a
%Y Cf. A064771, A295829, A295830, A318100.
%K nonn
%O 1,1
%A _Amiram Eldar_, Oct 28 2018
|
