login
A365625
a(0) = 0, a(1) = 1. let i = a(n-2) and j = a(n-1), then if i,j have a digit in common a(n) is the least novel number having no digit in common with either i or j. If i,j have no common digit, a(n) is the least novel number having a digit in common with at least one of i or j. All digits are decimal.
1
0, 1, 10, 2, 11, 12, 3, 13, 4, 14, 5, 15, 6, 16, 7, 17, 8, 18, 9, 19, 20, 21, 33, 22, 23, 40, 24, 31, 25, 26, 30, 27, 28, 34, 29, 32, 41, 35, 36, 42, 37, 38, 44, 39, 43, 50, 45, 61, 46, 52, 47, 48, 51, 49, 53, 54, 60, 55, 56, 70, 57, 62, 58, 59, 63, 64, 71, 65
OFFSET
0,3
COMMENTS
The sequence is conjectured to be finite. It will end if for some m, a(m) is a pandigital number, or if the set {i,j} of distinct digits of i and j contains all nonzero digits, whichever happens first. In the latter case the definition would require the next term to consist entirely of 0's, but since 0 is already a term this is impossible. A sequence like this can be made using any base.
LINKS
EXAMPLE
a(2) must be 10 since a(0) = 0 and a(1) = 1 have no digit in common and 10 is the least novel number having a digit in common with at least one of them (in this case with both).
a(3) must be 2 since this is the least novel number having no digit in common with a(1) = 1 and a(2) = 10.
a(24040) = 23674, a(24041) = 18592. a(24042) would need to be some number new to the sequence consisting of repeated zeros. Therefore the sequence is finite.
MATHEMATICA
b = 10; kk = 2; nn = 120; u = kk;
f[x_] := IntegerDigits[x, b]; c[_] := False;
Array[Set[{a[#], c[#]}, {#, True}] &, 2, 0];
Set[{i, j, di, dj},
{#1, #2, f[#1], f[#2]} & @@ {a[kk - 2], a[kk - 1]}];
Do[ Set[{d, k}, {Union[di, dj], u}];
If[IntersectingQ[di, dj],
Which[Length[d] == b, Break[],
Length[d] == b - 1,
If[FreeQ[d, 0], Break[],
d = First@ Complement[Range[0, b - 1], d]; k = {d};
While[c[FromDigits[k, b]], AppendTo[k, d]];
k = FromDigits[k, b]],
True,
While[Or[IntersectingQ[d, f[k]], c[k] ], k++]],
While[Or[! IntersectingQ[d, f[k]], c[k] ], k++] ];
Set[{a[n], c[k], i, j, di, dj}, {k, True, j, k, dj, f[k]}];
If[k == u, While[c[u], u++]], {n, kk, nn}];
TakeWhile[Array[a, nn + 1, 0], IntegerQ] (* Michael De Vlieger, Sep 13 2023 *)
CROSSREFS
Cf. A001477.
Sequence in context: A339206 A274606 A293869 * A323821 A351840 A257277
KEYWORD
nonn,base,fini
AUTHOR
EXTENSIONS
More terms from Michael De Vlieger, Sep 13 2023
STATUS
approved