Coloring Points in a Plot, based on their position in the list

Question

Before I describe the question, I'd like to say that I've seen the excellent answers posted here but have not managed to get them to work for my own data.

I have a list of values that I would like to plot in polar coordinates. The values represent the position of a series of coupled pendulums, and as such while the angle changes the radius does not. Here is a sample of the data for the pendulums, at a certain time t.

position = {
  {-1.25084, 1}, {-1.42995, 1}, {-1.7497, 1}, {-1.83175, 1}, {-1.733,1}, {-1.86803, 1}, 
  {-1.79935, 1}, {-1.87909, 1}, {-1.78354, 1}, {-1.81614, 1}, {-1.58559, 1}, {-1.71751, 1}, 
  {-1.72079, 1}, {-1.60622, 1}, {-1.72122, 1}, {-1.46695, 1}, {-1.62577, 1}, {-1.75079, 1}, 
  {-0.89456, 1}, {-0.950143, 1}, {-1.5654, 1}
}

What I would like to do is to color each of the pendulum based on their position; that is, the first pendulum (with angle -1.25084) would be colored purple, the next (with angle -1.42995) slightly purplish-blue and all the way to the last pendulum (with angle -1.5654) being colored red.

The purpose of coloring the pendulums as such is that, as I vary time t using Manipulate, I would then be able to track the pendulums by their color.

My attempt at this is below, but somehow it doesn't work in the way I intend it to.

n = Length[Transpose[position][[1]]]
position = Transpose[{Transpose[position][[1]], (1 + 0.001*Range[n]/n)}];
(* adding a small modifier to the radius of each pendulum to allow me to 
   identify the specific pendulum and give it a color later *)
pendulumcolor = ColorData["Rainbow"][1000*(#2 - 1)] &;
(* defining a colour function that extracts the pendulum number and relates 
   it to a color *)
ListPolarPlot[position, 
  PlotRange -> {{-1, 1}, {-1, 1}}, 
  PlotStyle -> Thick, 
  Joined -> True, 
  ColorFunction -> pendulumcolor] /. 
    Line[a__] :> {AbsolutePointSize[8], Point[a]}

My output looks something like this, which is definitely not what I intended. The colors of each point should be different, rather than being all red.

Edit:In response to VLC's request, a sample of my code is provided below.

n = 100;
(* n is the number of pendulums in our system *)

pendulumplotstyle = 
  Table[Directive[PointSize[Large], ColorData["Rainbow"][Mod[i, 10]/10]], {i, 0, n}];
(* every ten pendula are coloured to span the color of the rainbow *)

Manipulate[
  ListPolarPlot[List /@ funcposition[tdummy], 
    PlotRange -> {{-1, 1}, {-1, 1}},
    PlotStyle -> pendulumplotstyle],
  {tdummy, 0, 10, 0.001}]

In the above code, we have a function funcposition[t] that gives the position of the pendulums as a function of time t. This function is a numerical solution to an ODE that I'd rather not put up because of the length. The code will not work as-is due to the presence of funcposition[t] but it should give a good idea of what I'm doing.

Answer 1

For your particular problem, and especially since performance is important I once again^(1)(2)(3)(4) recommend using Graphics primitives:

toPolar = {#2 Cos[#], #2 Sin[#]}\[Transpose] & @@ (#\[Transpose]) &;
colors = ColorData["Rainbow"] /@ Rescale @ Range @ Length @ position;

Graphics[
 {PointSize[Large], Point[toPolar @ position, VertexColors -> colors]},
 PlotRange -> {{-1, 1}, {-1, 1}},
 Axes -> True
]

---

If you prefer to use ListPolarPlot for some reason (e.g. specialized Options not accepted by Graphics) you can still get the faster rendering of having all points in a single Point expression by using this:

colors = ColorData["Rainbow"] /@ Rescale @ Range @ Length @ position;

ListPolarPlot[position, PlotStyle -> PointSize[Large]] /. 
  Point[x : {__Integer}] :> Point[x, VertexColors -> colors]

Answer 2

You can solve your problem in this way:

ListPolarPlot[List /@ position, 
  PlotStyle -> ({PointSize[Large], 
  Blend[{{1, Orange}, {Length[position]/2, Red},
  {Length[position], Purple}}, #1]} & /@ Range[Length[position]])]

The first values from the list are colored in orange, the last in purple and those in between are red. You can choose your preferred colors just by replacing those listed above.

Answer 3

While it's not the cleanest method you can use Tooltip or Annotation to pass arbitrary data through a plot function, then reprocess it on the other side.

A point passed as Annotation[{x, y}, data] will appear in the output Graphics as:

Annotation[{Opacity[0.], Point[n]}, data]

where n is an integer coordinate of GraphicsComplex. These objects appear after the regular Point objects and would therefore be rendered on top of them if not for Opacity[0.].

We can therefore do something like this:

ListPolarPlot[
  MapIndexed[Annotation[#, ColorData["Rainbow"] @@ (#2/20)] &, position],
  PlotRange -> {{-1, 1}, {-1, 1}},
  PlotStyle -> None
] /. Annotation[{__, p_Point}, s_] :> {s, PointSize[Large], p}

While not necessary in the case I used PlotStyle -> None to hide the original points.

Answer 4

If you have version 8 of Mathematica or above, you can style the perturbed points like this:

styleddata = 
 Style[{##}, ColorData["Rainbow"][1000*(#2 - 1)]] & @@@ position

Or alternatively, style the original, non-perturbed points like this:

origposition = {{-1.25084, 1}, {-1.42995, 1}, {-1.7497, 1}, {-1.83175,
    1}, {-1.733, 1}, {-1.86803, 1}, {-1.79935, 1}, {-1.87909, 
   1}, {-1.78354, 1}, {-1.81614, 1}, {-1.58559, 1}, {-1.71751, 
   1}, {-1.72079, 1}, {-1.60622, 1}, {-1.72122, 1}, {-1.46695, 
   1}, {-1.62577, 1}, {-1.75079, 1}, {-0.89456, 1}, {-0.950143, 
   1}, {-1.5654, 1}}

styledata2=MapThread[
 Style[#1, ColorData["Rainbow"][#2]] &, {origposition, Range[n]/n}]

You can then do this:

ListPolarPlot[styleddata (* or styleddata2 *), 
 PlotRange -> {{-1, 1}, {-1, 1}},  Joined -> False, 
 BaseStyle -> AbsolutePointSize[8]]

Performance is not lagged at all even with 200 points:

Manipulate[
 With[{data = {#, 1 - t} & /@ Range[-1.7, -0.7, 0.005]}, 
  With[{restyle = 
     MapThread[
      Style[#1, ColorData["Rainbow"][#2]] &, {data, 
       Range[Length@data]/Length@data}]}, 
   ListPolarPlot[restyle, BaseStyle -> AbsolutePointSize[5], 
    PlotRange -> {{-0.2, 1}, {-1.2, 0}}] ]], {t, 0.01, 0.5, 0.001}]