A100373 Lexicographically earliest increasing sequence of composite numbers such that the digits of a(n) do not appear in a(n-1).
4, 6, 8, 9, 10, 22, 30, 42, 50, 62, 70, 81, 90, 111, 200, 314, 500, 611, 700, 812, 900, 1111, 2000, 3111, 4000, 5111, 6000, 7111, 8000, 9111, 20000, 31111, 40000, 51111, 60000, 71111, 80000, 91111, 200000, 311113, 400000, 511112, 600000, 711111
Offset: 1
Links
- Robert Israel, Table of n, a(n) for n = 1..7966
Programs
-
Maple
f:= proc(x) local L,S,carry,m,nL,b,d0,Lz,z,i,d; L:= convert(x,base,10); nL:= nops(L); S:= sort(convert({$0..9} minus convert(L,set),list)); b:= nops(S); d0:= min(select(`>`,S,L[-1])); if d0 = infinity then if S[1] = 0 then Lz:= Vector([0$nL, S[2]]) else Lz:= Vector([S[1]$(nL+1)]) fi else Lz:= Vector([S[1]$(nL-1),d0]) fi; d:= LinearAlgebra:-Dimension(Lz); do z:= add(Lz[i]*10^(i-1),i=1..d); if not isprime(z) then return z fi; carry:= true; for i from 1 to d while carry do if Lz[i] = S[-1] then Lz[i]:= S[1] else carry:= false; if member(Lz[i],S,'m') then Lz[i]:= S[m+1] fi fi od; if carry then d:= d+1; if S[1] = 0 then Lz(d):= S[2] else Lz(d) := S[1] fi fi od; end proc: R:= 4: r:= 4: for i from 2 to 100 do r:= f(r); R:= R,r od: R; # Robert Israel, Feb 27 2025
-
Mathematica
ta={1};Do[s1=IntegerDigits[Part[ta, Length[ta]]]; s2=IntegerDigits[n];If[Equal[Intersection[s1, s2], {}] &&!PrimeQ[n], Print[{Last[ta], n}];ta=Append[ta, n]], {n, 1, 1000000}];ta=Delete[ta, 1]