4
$\begingroup$

I am trying to create a blue point (please see image below) within a small radius of a red point such that the blue point lies outside of the black circle.

enter image description here

The code thatIi have used to generate the figure is as follows:

With[{radius = 0.1},
  Table[
    initpoint = RandomPoint[Circle[]];
    ℛ = RegionDifference[Circle[initpoint, radius], Disk[]];
    p = RandomPoint[ℛ];
    Show[
      {Graphics[
         {Black, Circle[], 
          Purple, Circle[initpoint, radius], 
          Blue, Point @ (p = RandomPoint[ℛ]), 
          Red, Point @ initpoint}]], 
    {10}]]

However, I am not interested in generating images. I am only interested in finding the position of the blue point given a red point and the radius. The code I use is the same as before except that i do not show graphics.

With[{radius = 0.001},
Table[
   initpoint = RandomPoint[Circle[]];
   ℛ = RegionDifference[Circle[initpoint, radius], Disk[]];
   RandomPoint[ℛ], 
   {100}]] // AbsoluteTiming

(* {9.02254, {{-0.6495, -0.761656}, {-0.122595, -0.99263}, <<96>>,{-0.142981,
0.990732}, {0.86886, 0.49706}}} *)

The above shows that it is taking 9 seconds to generate 100 configurations of blue given red. The process is extremely slow. Is there a way to speed the code up or is there a better algorithm?

Would be grateful for help.

$\endgroup$
3
  • $\begingroup$ Why not discretize the region first? $\endgroup$ Dec 29, 2016 at 18:43
  • $\begingroup$ @J.M. if i discretize them first i get an error saying the first argument should be a parameter free region. I have no idea what it means. $\endgroup$
    – Ali Hashmi
    Dec 29, 2016 at 18:51
  • 2
    $\begingroup$ Region computations are often slow. Best to avoid them when possible, as it is for this problem. $\endgroup$
    – m_goldberg
    Dec 29, 2016 at 23:51

2 Answers 2

4
$\begingroup$

Here is a better algorithm.

First a faster function for finding the blue point given the red point and the radius of the circle on which the blue point lies.

selectPt[cntr_, r_] :=
  Module[{pt = {0, 0}},
    While[Norm[pt] < 1, pt = RandomPoint[Circle[cntr, r]]]; 
    pt]

This constrains the blue point be further from the origin than the radius of the black circe; i.e., outside of the black circle.

With[{r = 0.2},
  Module[{cntr},
    GraphicsGrid[
      Table[
        cntr = RandomPoint[Circle[]];
        Graphics[
          {AbsolutePointSize[5],
           Black, Circle[],
           Purple, Circle[cntr, r],
           Blue, Point @ selectPt[cntr, r],
           Red, Point @ cntr}], {2}, {2}]]]]

grid

Timing

Module[{cntr},
  Table[cntr = RandomPoint[Circle[]]; selectPt[cntr .0011], {100}]]; 
// AbsoluteTiming

{0.055384, Null}

$\endgroup$
5
  • 3
    $\begingroup$ But you still use RandomPoint which is way slower than just calculating {Cos[#], Sin[#]} &@RandomReal[2*Pi]. The RandomPoint solution is ~ 30 times slower for 10000 points. $\endgroup$
    – BlacKow
    Dec 29, 2016 at 23:54
  • 2
    $\begingroup$ @BlacKow. Because it makes my code easier to understand, and it may be fast enough for the OP's purposes. I believe simplicity is preferable to speed as long as it fast enough. $\endgroup$
    – m_goldberg
    Dec 30, 2016 at 0:06
  • 1
    $\begingroup$ Actually now I'm puzzled why the RandomPoint@Circle[] is so slow? Trace doesn't give anything useful ... $\endgroup$
    – BlacKow
    Dec 30, 2016 at 0:32
  • $\begingroup$ @m_goldberg thanks so much. I would only propose a small edit if you like. Maybe the GraphicsGrid can be implemented on the end result i.e. outside of With $\endgroup$
    – Ali Hashmi
    Dec 30, 2016 at 12:50
  • $\begingroup$ @BlacKow thanks, i upvoted your answer $\endgroup$
    – Ali Hashmi
    Dec 30, 2016 at 13:05
4
$\begingroup$

Why do you need regions at all?

rBlack = 1.0;
rPurple = 0.1;    
randPoint[rB_, rP_][x_] := Module[{},
   rB {Cos[#], Sin[#]} &@RandomReal[2*Pi] + rP {Cos[#], Sin[#]} &@RandomReal[2*Pi]
   ];
Table[NestWhile[randPoint[rBlack, rPurple], {0, 0}, 
  Norm[#] < rBlack &], {100}]

So it takes a random point on black circle and adds (as vector) a random point on the purple circle. Then NextWhile repeats it until the point is actually beyond the black circle. Here is code that does the drawing - I modified the randPoint because I need the center of purple circle in addition to blue point coordinates.

randPointDraw[rB_, rP_][x_] := Module[{initPoint},
   initPoint = rB {Cos[#], Sin[#]} &@RandomReal[2*Pi];
   {initPoint, initPoint + rP {Cos[#], Sin[#]} &@RandomReal[2*Pi]}
   ];

GraphicsGrid@Partition[#, 3] &@ Table[Show[
 Graphics[{Black, Circle[{0, 0}, rBlack], Purple, Circle[#[[1]], rPurple], Blue, 
 Point[#[[2]]]}]] &@ NestWhile[randPointDraw[rBlack, rPurple], {0, 0}, 
    Norm[#[[2]]] < rBlack &], {9}]

enter image description here

$\endgroup$
0

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.