|
%I #11 Aug 23 2014 00:04:46
%S 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,
%T 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,
%U 7,7,9,1,0,1,9,1,3,5,3,1,1,3,4,6,2,6
%N Decimal expansion of the number whose continued fraction is given by A246127 (limiting block extension of an infinite Fibonacci word).
%C The (2,1)-version of the infinite Fibonacci word, A014675, as a sequence, is (2, 1, 2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 1, 2, 1, 2, 2,...). Its limiting block extension, A246128, is the sequence (2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 1, 2, 1, 2, 2,...), which is the continued fraction for 2.366304...
%e [2, 2, 1, 2, 1, 2, 2, 1, 2, 2, 1,...] = 2.3663046946532726566824972058...
%t 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*)
%t q = -1 + Accumulate[Table[p[k], {k, 0, n - 1}]] (*A246128*)
%t u = N[FromContinuedFraction[t1], 100]
%t r = RealDigits[u][[1]] (* A246129 *)
%Y Cf. A246127, A246128, A014675, A245975.
%K nonn,cons
%O 1,1
%A _Clark Kimberling_ and _Peter J. C. Moses_, Aug 15 2014
|
