3
$\begingroup$

I have found the following random generator to generate points in an annulus in stackoverflow on stackoverflow

f[] := Block[{u, t, r}, u = Random[] + Random[];
r1 = 1; r2 = 0.3;
t = Random[] 2 Pi;
r = If[u > 1, 2 - u, u];
r = If[r < r2, r2 + r*((R1 - R2)/R2), r];
{r Cos[t], r Sin[t]}]

ListPlot[Table[f[], {10000}], AspectRatio -> Automatic]

Now I would like to for instance color red when xy positive or blue when xy is negative. I have tried tweaking around with ColorFun but that gives me very beautiful images, but nothing what I actually want. What is the best method to approach this problem?

$\endgroup$

3 Answers 3

4
$\begingroup$
R1 = 2;
R2 = 3;
t = Table[f[], {10000}];
vc = If[Times @@ # <= 0, Blue, Red] & /@ t;

Use Graphics with VertexColors:

Graphics[Point[t, VertexColors -> vc], Axes -> True, AspectRatio -> Automatic]

Split the data based on Sign [x y] and use PlotStyle:

t2 = Pick[t, Sign[Times @@@ t], #] & /@ {1, -1};
ListPlot[t2, AspectRatio -> Automatic, PlotStyle -> {Red, Blue}]

or

t3 = GatherBy[t, Sign[Times @@ #] &];
ListPlot[t3, AspectRatio -> Automatic, PlotStyle -> {Red, Blue}]

Post-process ListPlot output to re-color the points:

ListPlot[t, AspectRatio -> Automatic]  /. 
     Point[x : {__}] :> ({If[ Times @@ # <= 0, Red, Blue], Point@#} & /@ x)

or

ListPlot[t, AspectRatio -> Automatic]  /.  Point[x_] :> Point[x, VertexColors -> vc]

to get

enter image description here

Update: Following ybeltukov's lead ...

Using TransformedDistribution and RandomVariate to generate random points in an annulus

ClearAll[annulusDist];
annulusDist[r1_, r2_, t1_: 0, t2_: 2 Pi] := 
  TransformedDistribution[Sqrt@v {Cos[u], Sin[u]},
   {u \[Distributed] UniformDistribution[{t1, t2}], 
    v \[Distributed] UniformDistribution[{r1^2, r2^2}]}];

pts1 = RandomVariate[annulusDist[1, 2], 2000000];
Histogram3D[pts1, 50, ImageSize -> 500]

enter image description here

pts2 = RandomVariate[annulusDist[1, 2, Pi/4, 7 Pi/4], 5000];

ListPlot[Pick[pts2, Sign[Times @@@ pts2], #] & /@ {1, -1}, 
 AspectRatio -> 1,  PlotRange -> {{-Pi, Pi}, {-Pi, Pi}}, PlotStyle -> {Red, Blue}]

enter image description here

$\endgroup$
8
  • $\begingroup$ Is there any advantage (i.e., speed) in using any of those three? $\endgroup$
    – JT_NL
    Commented Oct 6, 2014 at 21:22
  • $\begingroup$ @Jonas, based on limited tests, the method based on Pick seems to be faster than the other two. $\endgroup$
    – kglr
    Commented Oct 6, 2014 at 21:31
  • $\begingroup$ @Jonas, using Graphics and VertexColors seems to be faster than all the others posted so far. $\endgroup$
    – kglr
    Commented Oct 6, 2014 at 22:50
  • 1
    $\begingroup$ @JonasTeuwen Replacing vc with the following will give great kernel speed: (vc = Compile[{{p, _Real, 2}}, If[# > 0, {1., 0., 0.}, {0., 0., 1.}] & /@ (#[[1]] #[[2]] &@ Transpose@p)] @ pts. But the time spent rendering in the front end is significant, and it pretty much washes out the advantage. If you have many different colors, then VertexColors is the way to go. But the ListPlot code above divides the points into two sets and just uses a color two times in the output; VertexColors uses a color 10000 times. $\endgroup$
    – Michael E2
    Commented Oct 6, 2014 at 23:24
  • $\begingroup$ It does work well, but if I replace the condition for the check with another one it fails if there are no such points (for instance when I shift the annulus in the first kwadrant. Is there an easy way to resolve this? $\endgroup$
    – JT_NL
    Commented Oct 8, 2014 at 20:40
8
$\begingroup$

You already receive great answers concerning the colors, but your random generator confuses me. It is not uniform in the annulus and it's not efficient. I propose the following short and fast generator

randomInAnnulus[R1_, R2_, n_] := 
  Transpose@{# Cos@#2, # Sin@#2} &[Sqrt@RandomReal[{R1, R2}^2, n], RandomReal[2 π, n]];

pts = randomInAnnulus[1, 2, 20000000];

Histogram3D[pts, 50]

enter image description here

$\endgroup$
2
$\begingroup$

Try this:

Graphics[{If[Times @@ # > 0, Red, Blue], Point[#]} & /@ A]

which produces this:

enter image description here

I used R1 = 1.0; R2 = 0.5; as the constants. A is the list of random points.

This plotting method is pretty slow; unfortunately ListPlot requires Joined -> True for ColorFunction to be applied, and for random points it just looks like a mess.

$\endgroup$
2
  • $\begingroup$ Yes, I have noticed it is quite slow. Do you have any ideas how to do it faster? $\endgroup$
    – JT_NL
    Commented Oct 6, 2014 at 21:21
  • $\begingroup$ @JonasTeuwen: One possible way to make it faster is to use kguler's answer based on Pick, which basically separates your list into two, and then colors the two separate lists a different color using PlotStyle. I'm not sure why it's slow, but it appears to be tied to the frontend: if you suppress visual output using ;, it executes immediately, so it's probably not the kernel's fault, but rather the frontend's fault. $\endgroup$ Commented Oct 6, 2014 at 22:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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