This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.
is(n)={bittest(12,#f=factor(n)~) && f[1,#f]^2>n && setsearch([[2,1],[1,1,1]], f[2,])}
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. 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.
filter:= proc(n) local f,x; f:= ifactors(n)[2]; if mul(t[2]+1,t=f) <= 2*nops(f)+1 then return false fi; if f[1,2] > 1 then x:= f[1,1]^2 else x:= f[1,1]*f[2,1] fi; max(seq(t[1],t=f)) < x end proc: select(filter, [$1..1000]); # Robert Israel, Jan 01 2015
ntd[n_] := (dlist = Divisors[n]; dlist[[2 ;; Length[dlist] - 1]])
test[n_] := (tlist = ntd[n];
If[tlist == {}, False,
index = 1;
While[index <= Length[tlist] && PrimeQ[tlist[[index]]] == True,
index = index + 1];
If[index == 1 || index > Length[tlist], False,
While[index <= Length[tlist] && PrimeQ[tlist[[index]]] == False,
index = index + 1];
If[index <= Length[tlist], False, True]]])
Select[Table[n, {n, 2, 2500, 1}], test] (* Savoric *)
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 *)
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 *)
72 is in the sequence. The divisors of 72 are {1, 2, 3, 4, 6, 8, 9, 12, 18, 24, 36, 72} and their corresponding derivatives are {0, 1, 1, 4, 5, 12, 6, 16, 21, 44, 60, 156}. Since 8 < 9, and 8' = 12 > 6 = 9', 72 is a member.
ad[1] = 0; ad[n_] := n * Plus @@ ((Last[#]/First[#]) & /@ FactorInteger[n]); q[n_] := Module[{d = Divisors[n]}, AnyTrue[Range[Length[d] - 1], ad[d[[#]]] > ad[d[[# + 1]]] &]]; Select[Range[200], q] (* Amiram Eldar, Nov 25 2023 *)
Comments