10
$\begingroup$

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.

enter image description here

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.

|improve this question
$\endgroup$
  • $\begingroup$ thank you @Nasser, I defined n somewhere else in the kernel and didn't spot the problem. $\endgroup$ – Vincent Tjeng Mar 12 '13 at 7:20
  • $\begingroup$ BTW, instead of typing Transpose[position][[1]] you can get the same result with position[[All, 1]]. $\endgroup$ – VLC Mar 12 '13 at 7:37
  • $\begingroup$ As your problem is currently stated, n = Length[position] will always work. So why bother with n = Length[Transpose[position][[1]]]? $\endgroup$ – m_goldberg Mar 12 '13 at 8:40
  • $\begingroup$ @m_goldberg thank you for that, I must have been a bit sleepy when I typed that code. $\endgroup$ – Vincent Tjeng Mar 12 '13 at 8:46
  • $\begingroup$ Maybe it is worth pregenerating all the solutions of your ODE and use those in your Manipulate function. Take a look also at Mr.Wizard's solution to speed up rendering of ListPolarPlot. $\endgroup$ – VLC Mar 12 '13 at 9:07
10
$\begingroup$

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
]

Mathematica graphics

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]

Mathematica graphics

|improve this answer
$\endgroup$
  • $\begingroup$ just wondering - does writing functions as such Rescale @ Range @ Length @ position versus writing it as such Rescale[Range[Length[position]]] lead to any increase in performance, or is it just good coding practice to prevent one from being confused in a thicket of brackets? I'm asking this because I noticed that you almost exclusively use @, /@, @@ in your answers. $\endgroup$ – Vincent Tjeng Mar 22 '13 at 7:18
  • $\begingroup$ @Vincent It is purely notational. Mathematica interprets them the same way. If you put the code in HoldForm[FullForm[ (*code*) ]] and execute you will see how the expression is internally represented. I personally dislike nested brackets and find them hard to read, so yes, I use function @ argument, argument // function and arg1 ~function~ arg2 quite heavily, though not so heavily that I have to introduce additional ( ) for grouping (most of the time). $\endgroup$ – Mr.Wizard♦ Mar 22 '13 at 13:12
  • $\begingroup$ @Vincent The other notations /@ and @@ are a bit different; these are short for Map and Apply and I use them primarily because they are shorter. $\endgroup$ – Mr.Wizard♦ Mar 22 '13 at 13:12
  • $\begingroup$ Thank you! I'd just like to say that your use of notations like @ made your code very difficult to read when I was a new user, but once I began to understand the beauty of it then it really helped me to understand how to code better! $\endgroup$ – Vincent Tjeng Mar 22 '13 at 14:48
  • $\begingroup$ @Vincent Sorry for the steep learning curve, but I'm glad that in the end you find value in it. It will be very helpful to study the operator precedence table and memorize the order as best you can. $\endgroup$ – Mr.Wizard♦ Mar 22 '13 at 14:51
10
$\begingroup$

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.

enter image description here

|improve this answer
$\endgroup$
  • $\begingroup$ Thank you, @VLC! Is there any way to optimize the way your code works? As the pendulums move over time, the plot has to be recalculated every time I change the value of time t in my Manipulate function, and it seems a bit slow for now. $\endgroup$ – Vincent Tjeng Mar 12 '13 at 7:37
  • 1
    $\begingroup$ One disadvantage to this method relative to using Graphics directly is that it generates a Point expression for every point rather than the optimized form of one Point for all and VertexColors to style them. This significantly reduces rendering performance. $\endgroup$ – Mr.Wizard♦ Mar 12 '13 at 7:58
  • $\begingroup$ @VLC Ok. The motion of the pendulums are generated by the solution to a numerically-solved differential equation, am trying to figure out how to post my code without using up too much space. $\endgroup$ – Vincent Tjeng Mar 12 '13 at 8:37
  • $\begingroup$ @Mr.Wizard I fully agree with your comment and I support solutions based on Graphics primitives. Since the question was based on a ListPolarPlot I gave a solution that holds for this function. $\endgroup$ – VLC Mar 12 '13 at 8:52
  • $\begingroup$ Understood. I think the second method in my second answer addresses this well. $\endgroup$ – Mr.Wizard♦ Mar 12 '13 at 8:53
5
$\begingroup$

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}

Mathematica graphics

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

|improve this answer
$\endgroup$
3
$\begingroup$

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]]

enter image description here

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}]
|improve this answer
$\endgroup$
  • $\begingroup$ This doesn't work in version 7. In later versions does this produce the slow one-Point-per-point output or the fast VertexColors output? $\endgroup$ – Mr.Wizard♦ Mar 12 '13 at 10:29
  • $\begingroup$ Sorry @Mr.Wizard - I'll note that this is a version 8+ solution. The FullForm seems to involve Points but it feels pretty fast on my four-year-old machine. $\endgroup$ – Verbeia Mar 12 '13 at 10:34
  • $\begingroup$ How well does it do in a Manipulate with hundreds of points? On my system the multi-Point form has significant lag, whereas VertexColors is very quick. $\endgroup$ – Mr.Wizard♦ Mar 12 '13 at 10:47
  • $\begingroup$ @Verbeia thank you for your answer, I'll have to look through this and run it when I get back to my computer with Mathematica installed. $\endgroup$ – Vincent Tjeng Mar 12 '13 at 15:37
  • $\begingroup$ @Verbeia thank you! What's very interesting for me is that the output for styledata2 appears coloured. Is it the MapThread function that is doing this? $\endgroup$ – Vincent Tjeng Mar 13 '13 at 7:37

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.