A131968 -id:A131968 - cp's OEIS frontend

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

Clark Kimberling, Aug 02 2007

nonn

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.

			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.

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

Cf. A131968.

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 *)

cp's OEIS Frontend

A131967 Farey fractal sequence.

Views

Author

Keywords

Comments

Examples

References

Crossrefs

Programs

Mathematica