A321145 Exponential pseudoperfect numbers (A318100) equal to the sum of a subset of their proper exponential divisors in a single way.
36, 180, 252, 396, 468, 612, 684, 828, 1044, 1116, 1260, 1332, 1476, 1548, 1692, 1800, 1908, 1980, 2124, 2196, 2340, 2412, 2556, 2628, 2700, 2772, 2844, 2988, 3060, 3204, 3276, 3420, 3492, 3636, 3708, 3852, 3924, 4068, 4140, 4284, 4500, 4572, 4716, 4788, 4932
Offset: 1
Keywords
Examples
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.
Links
- Eric Weisstein's World of Mathematics, e-Divisor
- Eric Weisstein's World of Mathematics, e-Perfect Number
Programs
-
Mathematica
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
Comments