|
%I #12 Sep 17 2023 01:59:23
%S 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,
%T 24,31,25,26,30,27,28,34,29,32,41,35,36,42,37,38,44,39,43,50,45,61,46,
%U 52,47,48,51,49,53,54,60,55,56,70,57,62,58,59,63,64,71,65
%N 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.
%C 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.
%H Michael De Vlieger, <a href="/A365625/b365625.txt">Table of n, a(n) for n = 0..24041</a>
%e 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).
%e 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.
%e 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.
%t b = 10; kk = 2; nn = 120; u = kk;
%t f[x_] := IntegerDigits[x, b]; c[_] := False;
%t Array[Set[{a[#], c[#]}, {#, True}] &, 2, 0];
%t Set[{i, j, di, dj},
%t {#1, #2, f[#1], f[#2]} & @@ {a[kk - 2], a[kk - 1]}];
%t Do[ Set[{d, k}, {Union[di, dj], u}];
%t If[IntersectingQ[di, dj],
%t Which[Length[d] == b, Break[],
%t Length[d] == b - 1,
%t If[FreeQ[d, 0], Break[],
%t d = First@ Complement[Range[0, b - 1], d]; k = {d};
%t While[c[FromDigits[k, b]], AppendTo[k, d]];
%t k = FromDigits[k, b]],
%t True,
%t While[Or[IntersectingQ[d, f[k]], c[k] ], k++]],
%t While[Or[! IntersectingQ[d, f[k]], c[k] ], k++] ];
%t Set[{a[n], c[k], i, j, di, dj}, {k, True, j, k, dj, f[k]}];
%t If[k == u, While[c[u], u++]], {n, kk, nn}];
%t TakeWhile[Array[a, nn + 1, 0], IntegerQ] (* _Michael De Vlieger_, Sep 13 2023 *)
%Y Cf. A001477.
%K nonn,base,fini
%O 0,3
%A _David James Sycamore_, Sep 13 2023
%E More terms from _Michael De Vlieger_, Sep 13 2023
|
