n=10^5; Ludic={1}; seq=Range[2,n]; ClearAll[DoStep] DoStep[seq:{f_,___}]:=Module[{out=seq}, AppendTo[Ludic,f]; out[[;;;;f]]=Sequence[]; out ] Nest[DoStep,seq,2500]; Ludic[[;; 25]] LengthWhile[Ludic, # < 1000 &] Ludic[[2000 ;; 2005]] Select[Subsets[Select[Ludic, # < 250 &], {3}], Differences[#] == {2, 4} &]