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$
  • $\begingroup$ Why not discretize the region first? $\endgroup$ – J. M. is away Dec 29 '16 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 '16 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 '16 at 23:51
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$
  • 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 '16 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 '16 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 '16 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 '16 at 12:50
  • $\begingroup$ @BlacKow thanks, i upvoted your answer $\endgroup$ – Ali Hashmi Dec 30 '16 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$

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.