Draw an alternating colors ring with B-splines

Question

I want to draw a ring with alternating colors and an external radius r, width w and n sectors each with angle θ = 2π/n. n should be even ≥ 4 (The B-spline definition I used below to simulate the circular arc, with 3 nodes only, is good for θ < π, so n > 2).

First I used n sectors of alternating colors from a disk with radius r and added a white disk of radius r-w on top of them. I got the ring (exhibit1) BUT nothing that was behind it could be seen thru the ring’s “hole”. Of no use is to control opacity – I want everything in full color.

exhibit1 = Module[{r = 2, w = 1.3, n = 4, θ, limits},
  θ = 2 π/n;
  limits = 1.1 r;
  Graphics[{
    Thick, Arrow[r {{-1, -1}, {1, 1}}],
    Map[Rotate[
        Graphics[{If[EvenQ[n #/(2 π)], Blue, Orange], Thickness[w],
          Disk[{0, 0}, r, {0, θ}]
          }], # , {0, 0}] &, Range[0, 2 π - θ, θ]] /. 
     Graphics -> Identity,
    White, Disk[{0, 0}, r - w]},
   Axes -> True, PlotRange -> limits {{-1, 1}, {-1, 1}}]
  ]

Then I tried n circle arcs of radius r-w/2 and width w as I wanted everything to be visible thru the “hole” of the ring. BUT when thickness is added to an arc (or line) it “bleeds” past the ends of the entity and it is not even square (?!)… Not good (exhibit2).

exhibit2 = Module[{r = 2, w = 1.3, n = 4, θ, limits},
  θ = 2 π/n;
  limits = 1.1 r;
  Graphics[{
    Thick, Arrow[r {{-1, -1}, {1, 1}}],
    Map[Rotate[
        Graphics[{If[EvenQ[n #/(2 π)], Blue, Orange], 
          Thickness[w/(2 (limits))],
          Circle[{0, 0}, r - w/2, {0, θ}]
          }], # , {0, 0}] &, Range[0, 2 π - θ, θ]] /. 
     Graphics -> Identity},
   Axes -> True, PlotRange -> limits {{-1, 1}, {-1, 1}}]
  ]

As B-splines simulate perfectly a circular arc (and Beziers do not) I used them in place of the circle function (exhibit3). As expected, no progress.

exhibit3=Module[{r=2,w=1.3,n=4,θ,limits},
  θ=2π/n;
  limits=1.1 r;
  Graphics[{
    Thick,Arrow[r {{-1,-1},{1,1}}],
    Map[Rotate[
        Graphics[{If[EvenQ[n #/(2π)],Blue,Orange],Thickness[w/(2(limits))],
          BSplineCurve[(r-w/r){{1,0},{1 ,Tan[θ/2]},{Cos[θ],Sin[θ]}},SplineWeights->{1,Cos[θ/2],1}]
          }],# ,{0,0}]&,Range[0,2π-θ,θ]]/. Graphics->Identity},
   Axes->True, PlotRange-> limits{{-1,1},{-1,1}}]
  ]

Next I decided to use two B-splines, one external, counterclockwise, and another internal, clockwise, using the function FilledCurve to “paint” between them. As it can be seen, before the use of FilledCurve they fit perfectly (exhibit4).

exhibit4=Module[{r=2,w=1.3,n=4,θ,limits},
  θ=2π/n;
  limits=1.1 r;
  Graphics[{
    Thick,Arrow[r {{-1,-1},{1,1}}],
    Map[Rotate[
        Graphics[{If[EvenQ[n #/(2π)],Blue,Orange],
          BSplineCurve[r{{1,0},{1 ,Tan[θ/2]},{Cos[θ],Sin[θ]}},SplineWeights->{1,Cos[θ/2],1}],
          BSplineCurve[(r-w){{Cos[θ],Sin[θ]},{1 ,Tan[θ/2]},{1,0}},SplineWeights->{1,Cos[θ/2],1}]
          }],# ,{0,0}]&,Range[0,2π-θ,θ]]/. Graphics->Identity},
   Axes->True, PlotRange-> limits{{-1,1},{-1,1}}]
  ]

BUT when FilledCurve is used it “shrinks” the internal arc showing a gap (?!). Very strange, indeed (exhibit5).

exhibit5=Module[{r=2,w=1.3,n=4,θ,limits},
  θ=2π/n;
  limits=1.1 r;
  Graphics[{
    Thick,Arrow[r {{-1,-1},{1,1}}],
    Map[Rotate[
        Graphics[{If[EvenQ[n #/(2π)],Blue,Orange],
          FilledCurve[{
            BSplineCurve[r{{1,0},{1 ,Tan[θ/2]},{Cos[θ],Sin[θ]}},SplineWeights->{1,Cos[θ/2],1}],
            BSplineCurve[(r-w){{Cos[θ],Sin[θ]},{1 ,Tan[θ/2]},{1,0}},SplineWeights->{1,Cos[θ/2],1}]
            }]
          }],# ,{0,0}]&,Range[0,2π-θ,θ]]/. Graphics->Identity},
   Axes->True, PlotRange-> limits{{-1,1},{-1,1}}]
  ]

Following I closed the two B-splines with one line at the end that showed the gap, before using FilledCurve. It looks good BUT it isn’t. The gap is gone BUT the ring “hole” is not formed by perfect circular arcs (exhibit6). I closed the other end with another line but it didn’t do any good.

exhibit6=Module[{r=2,w=1.3,n=4,θ,limits},
  θ=2π/n;
  limits=1.1 r;
  Graphics[{
    Thick,Arrow[r {{-1,-1},{1,1}}],
    Map[Rotate[
        Graphics[{If[EvenQ[n #/(2π)],Blue,Orange],
          FilledCurve[{
            BSplineCurve[r{{1,0},{1 ,Tan[θ/2]},{Cos[θ],Sin[θ]}},SplineWeights->{1,Cos[θ/2],1}],
            Line[{r{Cos[θ],Sin[θ]},(r-w){Cos[θ],Sin[θ]}}],
            BSplineCurve[(r-w){{Cos[θ],Sin[θ]},{1 ,Tan[θ/2]},{1,0}},SplineWeights->{1,Cos[θ/2],1}]
            }]
          }],# ,{0,0}]&,Range[0,2π-θ,θ]]/. Graphics->Identity},
   Axes->True, PlotRange-> limits{{-1,1},{-1,1}}]
  ]

As it can be seen in the enlarged view of just one sector, where two red arcs of circle were plotted outside and inside of the sector of the ring with an offset of r/200, the outside of the sector is a perfect arc of circle BUT the inside is not (exhibit7).

exhibit7=Module[{r=2,w=1.3,n=3,θ},
  θ=2π/n;
  Graphics[{
    Blue,FilledCurve[{
      BSplineCurve[r{{1,0},{1 ,Tan[θ/2]},{Cos[θ],Sin[θ]}},SplineWeights->{1,Cos[θ/2],1}],
      Line[{r{Cos[θ],Sin[θ]},(r-w){Cos[θ],Sin[θ]}}],
      BSplineCurve[(r-w){{Cos[θ],Sin[θ]},{1 ,Tan[θ/2]},{1,0}},SplineWeights->{1,Cos[θ/2],1}](*,
      Line[{{r-w,0},{r,0}}]*)
      }],
    Red,Circle[{0,0},r-w-.01 r,{0,θ}],Circle[{0,0},r+.01r,{0,θ}]
    },
   Axes->True,PlotRange-> {{If[θ>=π/2,1.02r ,.98(r-w)]Cos[θ],1.02r},{-.02,1.02 If[θ>=π/2,r,r Sin[θ]]}}]
  ]

It was found by trial and error that a small positive correction ε in the value of the 2nd SplineWeight (The Cos[θ/2] term) of the internal B-spline transforms it in a circular arc, at least for practical purposes (exhibit8). The values found are in the Which clause. The distortions become very big for n < 3 and as it gets closer and closer to n = 2 it demands very small and precise values for ε. These values are independent of the radius r and width w. They only depend on the number of sectors n.

 exhibit8=Module[{r=2,w=1.3,n=3,θ,ϵ},
  θ=2π/n;
  ϵ=Which[ 
    n<2.9,0,(* Closer to n=2 the distortions are big for very small changes in ϵ. For n=2.01 -> ϵ=.00116, n=2.1 -> ϵ=.0116 *)
    n<=3,.08,
    n<=4,.10,
    n<=5,.11,
    n<=6,.12,
    n>6,.13];
  Graphics[{
    Blue,FilledCurve[{
      BSplineCurve[r{{1,0},{1 ,Tan[θ/2]},{Cos[θ],Sin[θ]}},SplineWeights->{1,Cos[θ/2],1}],
      Line[{r{Cos[θ],Sin[θ]},(r-w){Cos[θ],Sin[θ]}}],
      BSplineCurve[(r-w){{Cos[θ],Sin[θ]},{1 ,Tan[θ/2]},{1,0}},SplineWeights->{1,ϵ+Cos[θ/2],1}](*,
      Line[{{r-w,0},{r,0}}]*)
      }],
    Red,Circle[{0,0},r-w-r/200,{0,θ}],Circle[{0,0},r+r/200,{0,θ}]
    },ImageSize->Large,
   Axes->True,PlotRange-> {{If[θ>=π/2,1.02r ,.95(r-w)]Cos[θ],1.02r},{-.02,1.02 If[θ>=π/2,r,r Sin[θ]]}}]
  ]

I found a solution for this situation. It works well, but I think it is ugly. If this is a problem with FilledCurve and it gets corrected sometime (better sooner than later) this solution will work no more and will require repairs everywhere it is applied. Quite a job...

Now the questions:

• Am I forgetting something in my analysis? Did I make any mistake, conceptual or in writing the routines? Did I miss something?
• Is there a problem with the implementation of the Mathematica
  FilledCurve? Or am I using it carelessly or stressing it too much?
• I think it should not be necessary to connect the two splines with the line. It was used because it was at hand and helped me solve the problem. Is there a more elegant solution?
• Is there an easier way to solve this problem?

Answer 1

UPDATE 2:

Here is a version that removes the bells and whistles put in place by SectorChart, i.e. the tooltips, on-click actions, status area notes, etc. It does so by letting SectorChart do the generation of the sectors, then extracting those sectors as PolygonBox objects, and restyling them appropriately:

Clear[altRing]
altRing[n_?EvenQ, extRadius_, width_] :=
 Graphics[
   Riffle[
     Cases[
       SectorChart[
         ConstantArray[{1, width}, n],
         SectorOrigin -> {{0, 1}, extRadius - width}
       ],
       _PolygonBox, Infinity
     ],
     {Blue, Orange}, {1, -1, 2}
  ]
 ]

altrings[6, 10, 5]

UPDATE 1:

Here is a more handy function to control the number of sectors, the external radius, and the width.

Clear[altRing]
altRing[n_?EvenQ, extRadius_, width_] :=
 SectorChart[
   ConstantArray[{1, width}, n],
   SectorOrigin -> {{0, 1}, extRadius - width},
   ChartStyle -> Flatten@ConstantArray[{Orange, Blue}, n/2]
 ]

We can use this like so:

altRing[24, 10, 3]

You can check the sizing by adding axes:

Show[altRing[24, 10, 3], Axes -> True]

---

This is an answer to whether there is an easier way to achieve the same effect. I think there is, using PieChart:

PieChart[
  {1, 1, 1, 1},
  SectorOrigin -> {Automatic, 1},
  ChartStyle -> {Orange, Blue, Orange, Blue}
]

Answer 2

On UPDATE 2:

I liked so much the solution @MarcoB gave in his UPDATE 2 that I decided to build some "inefficiency" in it.

First I added the option to rotate it by an angle β and to translate the set to new coordinates x and y.

Then I decided to let then have odd number of sectors. This raised the problem of how to color them. I decided to use the minimum number of colors possible so chose the lowest factor of the number of sectors. But numbers that are prime and bigger had a tendency to have many colors indistinguishable one from the other. So there is an option to randomize the colors rnd. If rnd=0 we get sequential colors; else randomized colors. The name was changed to altRingRT.

Clear[altRingRT]
altRingRT[n_, extRadius_, width_, β_, x_, y_, rnd_] := 
 Module[{k1, k2, colors},
  k1 = FactorInteger[n][[1, 1]];
  k2 = Range[1/k1, 1, 1/k1];
  colors = If[rnd == 0, Hue /@ k2, Hue /@ Sort[{RandomReal[], #} & /@ k2][[All, 2]]];
  Graphics[
   Translate[
    Rotate[
     Riffle[
      Cases[
       SectorChart[
        ConstantArray[{1, width}, n],
        SectorOrigin -> {{0, 1}, extRadius - width}
        ],
       _PolygonBox, Infinity
       ],
      colors, {1, -1, 2}
      ],
     β],
    {x, y}]
   ]
  ]

.

 {Show[altRingRT[6, 10, 4, π/2, 2, -5, 0], Axes -> True],
  Show[altRingRT[9, 10, 4, π/2, 2, -5, 0], Axes -> True],
  Show[altRingRT[43, 10, 4, π/2, 2, -5, 0], Axes -> True],
  Show[altRingRT[43, 10, 4, π/2, 2, -5, 1], Axes -> True]}

Houston, we've had a problem here

Unfortunately when used with Manipulate neither the new altRing or altRingRT plays.

Manipulate[
 Show[
  altRingRT[10, 10, 4, t1, 0, 0, 0],
  altRingRT[5, 5, 3, t2, 0, 0, 0],
  PlotRange -> {{-10, 10}, {-10, 10}}, ImageSize -> {200}
 ],
 {{t1, 0}, 0, 2 π, N[π/180], Appearance -> "Open", AnimationRate -> 10},
 {{t2, 0}, 0, 2 π, N[π/180], Appearance -> "Open", AnimationRate -> 10}
]

.

The old altRing from UPDATE 1 --now altRingOld -- plays:

Clear[altRingOld]
altRingOld[n_?EvenQ, extRadius_, width_] :=
 SectorChart[
  ConstantArray[{1, width}, n],
  SectorOrigin -> {{0, 1}, extRadius - width},
  ChartStyle -> Flatten@ConstantArray[{Blue, Orange}, n/2]
 ]

.

Manipulate[
 Show[{
    Rotate[altRingOld[4, 3, 1], t1],
    Rotate[altRingOld[32, 7, 3.5], t2]
  }  /. Rotate[Graphics[x_, y___], r__] :> Graphics[Rotate[x, r], y], PlotRange -> All, ImageSize -> {200}
 ],
 {{t1, 0}, 0, 2 π, N[π/180], Appearance -> "Open", AnimationRate -> 10},
 {{t2, 0}, 0, 2 π, N[π/180], Appearance -> "Open", AnimationRate -> 10}
]

Answer 3

Borrowing the sector[] function from this answer (which is based on FilledCurve[]):

With[{n = 20, r = 10, h = 4}, 
     Graphics[{FilledCurveBoxOptions -> {Method -> {"SplinePoints" -> 20}},
              {Riffle[Table[sector[{r/2 - h/2, r/2}, 2 π {k - 1, k}/n], {k, n}],
                      {Blue, Orange}, {1, -2, 2}], 
               Riffle[Table[sector[{r - h, r}, π {k - 1, k}/n], {k, 2 n}],
                      {Blue, Orange}, {1, -2, 2}]}}, Frame -> True]]