|
%I #39 Feb 07 2015 18:04:55
%S 8,12,16,18,24,27,30,32,36,45,48,50,54,63,64,70,72,75,81,90,96,98,105,
%T 108,125,128,135,144,147,150,154,162,165,175,182,189,192,195,216,225,
%U 231,242,243,245,250,256,270,273,275,286,288,315,324,325,338,343,350
%N Numbers with more composite divisors than prime divisors such that all the prime divisors are smaller than the composite divisors.
%C List of composite numbers with n >= 2 nontrivial divisors where the k smallest nontrivial divisors are all primes and the n - k largest nontrivial divisors are all nonprimes, 1 <= k < n.
%C Here the term "nontrivial divisors" only serves to exclude 1.
%C Except for semiprimes, all composite numbers have more composite divisors than prime divisors. - _Robert G. Wilson v_, Jan 12 2015
%e 36 is in the sequence because its nontrivial divisors are 2, 3, 4, 6, 9, 12, 18, and of these, the first two are prime and the rest are composite.
%e 40 is not in the sequence because its nontrivial divisors are 2, 4, 5, 8, 10, 20, and the composite divisor 4 falling between the prime divisors 2 and 5 disqualifies 40 from membership in the sequence.
%p filter:= proc(n)
%p local f,x;
%p f:= ifactors(n)[2];
%p if mul(t[2]+1,t=f) <= 2*nops(f)+1 then return false fi;
%p if f[1,2] > 1 then x:= f[1,1]^2 else x:= f[1,1]*f[2,1] fi;
%p max(seq(t[1],t=f)) < x
%p end proc:
%p select(filter, [$1..1000]); # _Robert Israel_, Jan 01 2015
%t ntd[n_] := (dlist = Divisors[n]; dlist[[2 ;; Length[dlist] - 1]])
%t test[n_] := (tlist = ntd[n];
%t If[tlist == {}, False,
%t index = 1;
%t While[index <= Length[tlist] && PrimeQ[tlist[[index]]] == True,
%t index = index + 1];
%t If[index == 1 || index > Length[tlist], False,
%t While[index <= Length[tlist] && PrimeQ[tlist[[index]]] == False,
%t index = index + 1];
%t If[index <= Length[tlist], False, True]]])
%t Select[Table[n, {n, 2, 2500, 1}], test] (* Savoric *)
%t primeDivs[n_Integer] := Select[Divisors[n], PrimeQ]; compDivs[n_Integer] := Drop[Complement[Divisors[n], primeDivs[n]], 1]; Select[Range[4, 500], Not[PrimeQ[#]] && primeDivs[#][[-1]] < compDivs[#][[1]] && Length[primeDivs[#]] < Length[compDivs[#]] &] (* _Alonso del Arte_, Dec 31 2014 *)
%t fQ[n_] := Block[{d = PrimeQ@ Most@ Rest@ Divisors@ n}, d[[1]] == True && d[[-1]] == False && Length@ Split@ d == 2]; Select[ Range@ 350, fQ] (* _Robert G. Wilson v_, Jan 12 2015 *)
%Y Cf. A137428.
%K nonn
%O 1,1
%A _Michael Savoric_, Dec 30 2014
|
