|
%I #8 Nov 30 2016 23:48:33
%S 1,2,1,3,2,1,4,3,5,2,1,6,4,3,5,7,2,1,8,6,4,9,3,10,5,7,11,2,1,12,8,6,4,
%T 9,3,10,5,7,11,13,2,1,14,12,8,6,15,4,9,16,3,17,10,5,18,7,11,13,19,2,1,
%U 20,14,12,8,6,15,4,21,9,16,3,17,10,22,5,18,7,11,13,19,23,2
%N Farey fractal sequence.
%C As a fractal sequence, A131967 properly contains itself as a subsequence (infinitely many times).
%C Step 1: List the Farey fractions by order, like this:
%C order 1: 0/1 1/1
%C order 2: 0/1 1/2 1/1
%C order 3: 0/1 1/3 1/2 2/3 1/1, etc.
%C Step 2: Replace each a/b by its position when all the segments in Step 1 are concatenated and each distinct predecessor of a/b is counted just once, getting
%C 1 2
%C 1 3 2
%C 1 4 3 5 2, etc.
%C Step 3: Concatenate the segments found in Step 2.
%D C. Kimberling, "Fractal sequences and interspersions," Ars Combinatoria 45 (1997) 157-168.
%e The Farey fractions of order 4 are
%e 0 1/4 1/3 1/2 2/3 3/4 1, having position numbers
%e 1 6 4 3 5 7 2, which is the fourth segment in the formation of A131967.
%t Farey[n_] :=
%t Select[Union@
%t Flatten@Outer[Divide, Range[n + 1] - 1, Range[n]] , # <= 1 &];
%t newpos[n_] :=
%t Module[{length = Total@Array[EulerPhi, n] + 1, f1 = Farey[n],
%t f2 = Farey[n - 1], to},
%t to = Complement[Range[length], Flatten[Position[f1, #] & /@ f2]];
%t ReplacePart[Array[0 &, length],
%t Inner[Rule, to, Range[length - Length[to] + 1, length], List]]];
%t a[n_] := Flatten@
%t Table[Fold[
%t ReplacePart[Array[newpos, i][[#2 + 1]],
%t Inner[Rule,
%t Flatten@Position[Array[newpos, i][[#2 + 1]], 0], #1, List]] &,
%t Array[newpos, i][[1]], Range[i - 1]], {i, n}];
%t a[10] (* _Birkas Gyorgy_, Feb 21 2011 *)
%Y Cf. A131968.
%K nonn
%O 1,2
%A _Clark Kimberling_, Aug 02 2007
|
