A321146 Exponential weird numbers: numbers that are exponential abundant (A129575) but not exponential pseudoperfect (A318100).

4900, 14700, 53900, 63700, 83300, 93100, 112700, 142100, 151900, 161700, 181300, 191100, 200900, 210700, 230300, 249900, 259700, 279300, 289100, 298900, 328300, 338100, 347900, 357700, 387100, 406700, 426300, 436100, 455700, 475300, 494900, 504700, 524300

Offset: 1

Author

Amiram Eldar, Oct 28 2018

Keywords

• nonn

Examples

			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.
		

Links

• Amiram Eldar, Table of n, a(n) for n = 1..10000 (terms 1..1000 from Robert Israel)
• Eric Weisstein's World of Mathematics, e-Divisor.
• Eric Weisstein's World of Mathematics, e-Perfect Number.

Crossrefs

The exponential version of A006037.

Cf. A129575, A318100.

Programs

Maple

filter:= proc(n)
  local L,m,P,i,j,T,S,t,v;
  L:= ifactors(n)[2];
  m:= nops(L);
  P:= map(t -> numtheory:-divisors(t[2]),L);
  if mul(add(L[i][1]^j, j=P[i]),i=1..m) <= 2*n then return false fi;
  T:= combinat:-cartprod(P);
  S:= {0}:
  while not T[finished] do
    t:= T:-nextvalue();
    v:= mul(L[i][1]^t[i],i=1..m);
    if v = n then next fi;
    if member(n-v,S) then return false fi;
    S:= S union select(`<=`,map(`+`,S,v),n);
  od;
  true
end proc:
select(filter, [$1..10^6]); # Robert Israel, Feb 19 2019

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]; 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