A246129 Decimal expansion of the number whose continued fraction is given by A246127 (limiting block extension of an infinite Fibonacci word).
2, 3, 6, 6, 3, 0, 4, 6, 9, 4, 6, 5, 3, 2, 7, 2, 6, 5, 6, 6, 8, 2, 4, 9, 7, 2, 0, 5, 8, 6, 1, 4, 5, 6, 9, 1, 0, 0, 8, 1, 9, 9, 4, 8, 1, 0, 4, 0, 9, 5, 8, 9, 1, 0, 9, 3, 0, 5, 4, 1, 0, 2, 7, 1, 3, 8, 5, 3, 7, 7, 9, 1, 0, 1, 9, 1, 3, 5, 3, 1, 1, 3, 4, 6, 2, 6
Offset: 1
Examples
[2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 1,...] = 2.3663046946532726566824972058...
Programs
-
Mathematica
seqPosition1[list_, seqtofind_] := If[Length[#] > Length[list], {}, Last[Last[ Position[Partition[list, Length[#], 1], Flatten[{_, #, _}], 1, 1]]]] &[seqtofind]; s = Differences[Table[Floor[n*GoldenRatio], {n, 10000}]]; t = {{2}}; 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]; t1 = Last[t] (*A246127*) q = -1 + Accumulate[Table[p[k], {k, 0, n - 1}]] (*A246128*) u = N[FromContinuedFraction[t1], 100] r = RealDigits[u][[1]] (* A246129 *)
Comments