A131967 Farey fractal sequence.

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, 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, 20, 14, 12, 8, 6, 15, 4, 21, 9, 16, 3, 17, 10, 22, 5, 18, 7, 11, 13, 19, 23, 2

Offset

1,2

Comments

As a fractal sequence, A131967 properly contains itself as a subsequence (infinitely many times).

Step 1: List the Farey fractions by order, like this:

order 1: 0/1 1/1

order 2: 0/1 1/2 1/1

order 3: 0/1 1/3 1/2 2/3 1/1, etc.

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

1 2

1 3 2

1 4 3 5 2, etc.

Step 3: Concatenate the segments found in Step 2.

References

C. Kimberling, "Fractal sequences and interspersions," Ars Combinatoria 45 (1997) 157-168.

Links

Table of n, a(n) for n=1..83.

Example

The Farey fractions of order 4 are
0 1/4 1/3 1/2 2/3 3/4 1, having position numbers
1 6 4 3 5 7 2, which is the fourth segment in the formation of A131967.

Mathematica

Farey[n_] :=
  Select[Union@
    Flatten@Outer[Divide, Range[n + 1] - 1, Range[n]] , # <= 1 &];
newpos[n_] :=
  Module[{length = Total@Array[EulerPhi, n] + 1, f1 = Farey[n],
    f2 = Farey[n - 1], to},
   to = Complement[Range[length], Flatten[Position[f1, #] & /@ f2]];
   ReplacePart[Array[0 &, length],
    Inner[Rule, to, Range[length - Length[to] + 1, length], List]]];
a[n_] := Flatten@
   Table[Fold[
     ReplacePart[Array[newpos, i][[#2 + 1]],
       Inner[Rule,
        Flatten@Position[Array[newpos, i][[#2 + 1]], 0], #1, List]] &,
      Array[newpos, i][[1]], Range[i - 1]], {i, n}];
a[10] (* Birkas Gyorgy, Feb 21 2011 *)

Crossrefs

Cf. A131968.

Sequence in context: A133404 A134627 A064881 * A358120 A329501 A300670

Adjacent sequences: A131964 A131965 A131966 * A131968 A131969 A131970

Keyword

nonn

Author

Clark Kimberling, Aug 02 2007

Status

approved