%I #21 Feb 16 2025 08:33:57
%S 4900,14700,53900,63700,83300,93100,112700,142100,151900,161700,
%T 181300,191100,200900,210700,230300,249900,259700,279300,289100,
%U 298900,328300,338100,347900,357700,387100,406700,426300,436100,455700,475300,494900,504700,524300
%N Exponential weird numbers: numbers that are exponential abundant (A129575) but not exponential pseudoperfect (A318100).
%H Amiram Eldar, <a href="/A321146/b321146.txt">Table of n, a(n) for n = 1..10000</a> (terms 1..1000 from Robert Israel)
%H Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/e-Divisor.html">e-Divisor</a>.
%H Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/e-PerfectNumber.html">e-Perfect Number</a>.
%e 4900 is in the sequence since its proper exponential divisors, {70, 140, 350, 490, 700, 980, 2450} sum to 5180 > 4900, yet no subset of its divisors sums to 4900.
%p filter:= proc(n)
%p local L,m,P,i,j,T,S,t,v;
%p L:= ifactors(n)[2];
%p m:= nops(L);
%p P:= map(t -> numtheory:-divisors(t[2]),L);
%p if mul(add(L[i][1]^j, j=P[i]),i=1..m) <= 2*n then return false fi;
%p T:= combinat:-cartprod(P);
%p S:= {0}:
%p while not T[finished] do
%p t:= T:-nextvalue();
%p v:= mul(L[i][1]^t[i],i=1..m);
%p if v = n then next fi;
%p if member(n-v,S) then return false fi;
%p S:= S union select(`<=`,map(`+`,S,v),n);
%p od;
%p true
%p end proc:
%p select(filter, [$1..10^6]); # _Robert Israel_, Feb 19 2019
%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]; eAbundantQ[n_] := esigma[n] > 2 n; a = {}; n = 0; While[Length[a] < 30, n++; If[!eAbundantQ[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 The exponential version of A006037.
%Y Cf. A129575, A318100.
%K nonn,changed
%O 1,1
%A _Amiram Eldar_, Oct 28 2018