A228668 - OEIS

%I #6 Dec 04 2016 19:46:32

%S 2,1,1,3,2,2,5,1,1,6,2,2,7,2,4,8,2,2,10,1,1,11,2,2,12,2,2,13,3,5,14,2,

%T 4,15,2,2,17,1,1,18,2,2,19,4,6,20,2,2,21,4,6,22,4,6,23,2,4,24,2,2,26,

%U 1,1,27,2,2,28,4,4,29,8,5,30,2,2,31,6,8,32

%N Array: row n consists of n-th nonsquare f(n) followed by L(CF(sqrt(f(n)))) followed by L(ACF(sqrt(f(n)))), where L indicates the length of the repeating string; CF indicates continued fraction, and ACF indicates accelerated continued fraction.

%C See A228667 for the definition of accelerated continued fraction.

%e The initial 2,1,1 means that both the ACF and CF of sqrt(2) have repeating strings of length 1; the next 3,2,2 means that the ACF and CF of sqrt(3) have repeating strings of length 2 and 2.  In the table below, Mathematica notation is used for repeating continued fractions; x(n) approximates sqrt(n)-ACF(sqrt(n)) and y(n) approximates sqrt(n)-CF(sqrt(n)).

%e n . ACF(sqrt(n)) . x(n) ........... CF(sqrt(n)) ... y(n)

%e 2 . {1,{2}} ..... -0.32 ........... {1,{2}} ....... -0.32

%e 3 . {2,{-4,4}} .. -1.3 x 10^(-11) . {1,{1,2}} ..... -7 x 10^(-6)

%e 7 . {3,{-3,6}} .. -5.0 x 10^(-12) . {2,{1,1,1,4}} . -5 x 10^(-6)

%t $MaxExtraPrecision = Infinity; period[seq_] := (If[Last[#1] == {} || Length[#1] == Length[seq] - 1, 0, Length[#1]] &)[NestWhileList[Rest, Rest[seq], #1 != Take[seq, Length[#1]] &, 1]]; periodicityReport[seq_] := ({Take[seq, Length[seq] - Length[#1]], period[#1], Take[#1, period[#1]]} &)[Take[seq, -Length[NestWhile[Rest[#1] &, seq, period[#1] == 0 &, 1, Length[seq]]]]]

%t (*output format {initial seqment,period length,period}*)

%t (*error messages occur if the sequence not found to be periodic.*)

%t aCF[rational_] := Module[{steps = {}, stop = False, i = 0, x = Numerator[rational], y = Denominator[rational], w, u, v, f, c},(*Step 1*)w = Mod[x, y]; Which[w == 0, c[i] = x/y; stop = True; AppendTo[steps, "A"], 0 < w <= y/2, c[i] = Floor[x/y]; {u, v, f} = {y, w, 1}; AppendTo[steps, "B"], w > y/2, c[i] = 1 + Floor[x/y]; {u, v, f} = {y, y - w, -1};    AppendTo[steps, "C"]];  i++; (*Step 2*)While[stop =!= True, w = Mod[u, v]; Which[f == 1 && w == 0, c[i] = u/v; stop = True; AppendTo[steps, "0.1"], f == -1 && w == 0, c[i] = -u/v; stop = True; AppendTo[steps, "0.2"], f == 1 && w <= v/2, c[i] = Floor[u/v]; {u, v, f} = {v, w, 1}; AppendTo[steps, "1"], f == 1 && w > v/2, c[i] = 1 + Floor[u/v]; {u, v, f} = {v, v - w, -1}; AppendTo[steps, "2"], f == -1 && w <= v/2, c[i] = -Floor[u/v]; {u, v, f} = {v, w, -1}; AppendTo[steps, "3"], f == -1 && w > v/2, c[i] = -1 - Floor[u/v]; {u, v, f} = {v, v - w, -f}; AppendTo[steps, "4"]]; i++]; (*Display results*) {FromContinuedFraction[#], {"Steps", steps}, {"ACF", #}, {"CF", ContinuedFraction[x/y]}} &[Map[c, Range[i] - 1]]]

%t m = Map[{#, Map[periodicityReport[#][[2]] &, {Drop[#[[1]][[2]], -3],    Drop[#[[2]][[2]], -3]} &[aCF[Rationalize[Sqrt[#], 10^-80]][[{3, 4}]]]]} &, Select[Range[200], ! IntegerQ[Sqrt[#]] &]]

%t Flatten[m] (* _Peter J. C. Moses_, Aug 28 2013 *)

%Y Cf. A228668, A228488.

%K nonn,tabf,easy

%O 1,1

%A _Clark Kimberling_, Aug 29 2013