|
%I #21 Jun 18 2019 18:24:05
%S 1,3,10,18,20,42,84,90,108,168,300,336,504,540,600,630,660,1008,1200,
%T 1560,1620,1980,2100,2340,2400,3024,3120,3240,3780,3960,4200,4680,
%U 5880,6120,6240,7920,8400,8820
%N Highly abundant numbers that are not products of consecutive primes with nonincreasing exponents, i.e., that are not of the form n=2^{e_2} * 3^{e_3} * ...* p^{e_p}, with e_2>=e_3>=...>=e_p.
%C This is the subsequence of those highly abundant numbers (A002093) that have a different canonical structure to the superabundant numbers (A004394), the colossally abundant numbers (A004490), the highly composite numbers (A002182) and the superior highly composite numbers (A002201).
%H Amiram Eldar, <a href="/A128701/b128701.txt">Table of n, a(n) for n = 1..8404</a>
%H L. Alaoglu and P. Erdős, <a href="http://www.renyi.hu/~p_erdos/1944-03.pdf">On highly composite and similar numbers</a>, Trans. Amer. Math. Soc., 56 (1944), 448-469.
%H Jeffrey C. Lagarias, <a href="https://arxiv.org/abs/math/0008177">An Elementary Problem Equivalent to the Riemann Hypothesis</a>, arXiv:math/0008177 [math.NT], 2000-2001.
%H Jeffrey C. Lagarias, <a href="http://www.jstor.org/stable/2695443">An elementary problem equivalent to the Riemann hypothesis</a>, American Mathematical Monthly 109 (2002), pp. 534-543.
%H Wikipedia, <a href="http://en.wikipedia.org/wiki/Highly_abundant_number">Highly Abundant Numbers</a>.
%F The highly abundant numbers (A002093) are those values of n for which sigma(n)>sigma(m) for all m<n, where sigma(n)= A000203(n).
%e As 10 is the third highly abundant number that cannot be expressed as a product of consecutive primes with nonincreasing exponents, then a(3)=10.
%t hadata1=FoldList[Max,1,Table[DivisorSigma[1,n],{n,2,10000}]]; data1=Flatten[Position[hadata1,#,1,1]&/@Union[hadata1]];primefactorlist[1]={1};primefactorlist[k_]:=First[Transpose[FactorInteger[k]]];exponentlist[1]={1};exponentlist[k_]:=Last[Transpose[FactorInteger[k]]];g[k_List]:=If[MemberQ[Table[k[[i]]<= k[[i-1]],{i,1,Length[k]}],False],False,True];h[k_]:=If[primefactorlist[k]==(Prime[ # ]&/@Range[Length[primefactorlist[k]]]),True,False];Select[data1,Or[ ! h[ # ],!g[exponentlist[ # ]]]&]
%t seq = {1}; sm = 0; Do[f = FactorInteger[n]; p = f[[;; , 1]]; e = f[[;; , 2]]; s = Times @@ ((p^(e + 1) - 1)/(p - 1)); If[s > sm, sm = s; m = Length[p]; If[p[[-1]] != Prime[m] || (m > 1 && ! AllTrue[Differences[e], # <= 0 &]), AppendTo[seq, n]]], {n, 2, 10^4}]; seq (* _Amiram Eldar_, Jun 18 2019 *)
%Y Cf. A002093, A004394, A000203, A004490, A002182, A002201, A128699, A128700, A128702.
%K nonn
%O 1,2
%A _Ant King_, Mar 28 2007
|
