cp's OEIS Frontend

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

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