A228668 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.

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, 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, 1, 1, 27, 2, 2, 28, 4, 4, 29, 8, 5, 30, 2, 2, 31, 6, 8, 32

Offset: 1

Author

Clark Kimberling, Aug 29 2013

Keywords

• nonn
• tabf
• easy

Comments

See A228667 for the definition of accelerated continued fraction.

Examples

			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)).
n . ACF(sqrt(n)) . x(n) ........... CF(sqrt(n)) ... y(n)
2 . {1,{2}} ..... -0.32 ........... {1,{2}} ....... -0.32
3 . {2,{-4,4}} .. -1.3 x 10^(-11) . {1,{1,2}} ..... -7 x 10^(-6)
7 . {3,{-3,6}} .. -5.0 x 10^(-12) . {2,{1,1,1,4}} . -5 x 10^(-6)
		

Crossrefs

Cf. A228668, A228488.

Programs

Mathematica

$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]]]]]
(*output format {initial seqment,period length,period}*)
(*error messages occur if the sequence not found to be periodic.*)
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]]]
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[#]] &]]
Flatten[m] (* Peter J. C. Moses, Aug 28 2013 *)