A246144 Limiting block extension of A000002 (Kolakoski sequence) with first term as initial block.
1, 1, 2, 2, 1, 2, 1, 1, 2, 1, 2, 2, 1, 1, 2, 1, 1, 2, 1, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 2, 2, 1, 2, 1, 1, 2, 1, 1, 2, 2, 1, 2, 2, 1, 2, 1, 1, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 2, 1, 2, 2, 1, 2, 2, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 2, 1, 2, 2, 1, 2, 1, 1, 2, 1, 2
Offset: 1
Keywords
Examples
S = A000002, with B = (s(1)); that is, (m,k) = (1,0) S = (1,2,2,1,1,2,1,2,2,1,2,2,1,1,2,1,1,2,2,1,2,1,...) B'(0) = (1) B'(1) = (1,1) B'(2) = (1,1,2) B'(3) = (1,1,2,2) B'(4) = (1,1,2,2,1) B'(5) = (1,1,2,2,1,2) S^ = (1,1,2,2,1,2,1,1,2,1,2,2,1,1,2,1,1,...), with index sequence (1,4,13,16,51,78,97,124,178,247,322,...)
Programs
-
Mathematica
seqPosition1[list_, seqtofind_] := If[Length[#] > Length[list], {}, Last[Last[Position[Partition[list, Length[#], 1], Flatten[{_, #, _}], 1, 1]]]] &[seqtofind]; n = 30; s = Prepend[Nest[Flatten[Partition[#, 2] /. {{2, 2} -> {2, 2, 1, 1}, {2, 1} -> {2, 2, 1}, {1, 2} -> {2, 1, 1}, {1, 1} -> {2, 1}}] &, {2, 2}, n], 1]; (* A246144 *) Take[s, 30] t = {{1}}; p[0] = seqPosition1[s, Last[t]]; s = Drop[s, p[0]]; Off[Last::nolast]; n = 1; While[(p[n] = seqPosition1[s, Last[t]]) > 0, (AppendTo[t, Take[s, {#, # + Length[Last[t]]}]]; s = Drop[s, #]) &[p[n]]; n++]; On[Last::nolast]; Last[t] (* A246144*) Accumulate[Table[p[k], {k, 0, n - 1}]] (*A246145*)
Comments