Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

I want to compute the Voronoi diagram on the unit disk, using the hyperbolic metric. So, I want to input a list of points and obtain a plot of the cells associated with each of the points.

I defined the metric:

 HyperbolicDistance[{a1_, b1_}, {a2_, b2_}] := 
 Module[{d, dist}, 
  d = 2*((EuclideanDistance[{a1, b1}, {a2, 
         b2}]^2)/((1 - EuclideanDistance[{a1, b1}, {0, 0}]^2)*(1 - 
          EuclideanDistance[{a2, b2}, {0, 0}]^2)));
  dist = ArcCosh[1 + d]; Return[dist]]

Now, I define the regions, with the list of centers defined by pts

cells = And @@@ 
   Table[HyperbolicDistance[pts[[i]], {x, y}] <= 
     HyperbolicDistance[pts[[j]], {x, y}], {i, n}, {j, 
     Complement[Range[n], {i}]}];

Then, I plot using RegionPlot:

RegionPlot[{cells, x^2 + y^2 < 1}, {x, -1, 1}, {y, -1, 1}, 
 Frame -> False, PlotPoints -> Automatic]

I get some warning messages

LessEqual::nord: Invalid comparison with 0.844796 +3.14159 I attempted. >>

which is due to the fact that the metric is defined only on the unit disk and RegionPlot is evaluating it on points in the unit square with $-1<x<1,\; -1<y<1$

Is there a way I can evaluate RegionPlot in the unit disk, so as to avoid getting this message?

This method is quite inefficient and inaccurate. I can increase the accuracy of the picture by increasing PlotPoints and MaxRecursion, but both are increasing the evaluation time immensely. I am not sure, but I guessed that using the Nearest function to evaluate which of the points in the list of Voronoi is closest to a given point $(x,y)$ might improve the code. So I used the DistanceFunction to transform the metric used in Nearest, but because RegionPlot is evaluating it at points where the metric is not valid, so I get the errors like

Nearest::nearuf: The user-supplied distance function HyperbolicDistance does not give a real numeric distance when applied to the point pair {1,1} and {-0.304667,0.852203}. >>

Is there a way to improve my code to reduce run time?

I am quite new to Mathematica, so any suggestions or insights would be helpful. Thanks!

share|improve this question
    
Did you have something like this in mind? I use Nearest[] for making fake Voronoi diagrams myself. I can post the code for that if you want it. – J. M. May 18 at 4:10
    
@J.M. Those are the kind of pictures I am trying to make. I tried for a while to change the metric in VoronoiDiagram, but I didn't see a way of doing that, and that's why I am trying this low-tech method. – user1974 May 18 at 4:35
    
Nah, VoronoiDiagram[] does not currently support other metrics at the moment. So you wouldn't mind my posting a fake? – J. M. May 18 at 6:40
    
@J.M. Yes, please! – user1974 May 18 at 12:47
up vote 6 down vote accepted

EDIT

(incorporating comments by @J.M.: DistanceFunction->dis and pre-computation of nearest function):

This is not efficient. Just rewriting metric (apologies for errors). In the following I used ContourPlot but DensityPlot could be used.

dis[a_, b_] := 
 Abs[ArcCosh[1 + 2 ( a - b).(a - b)/((1 - a.a) (1 - b.b))]]
vh[n_] := Module[{p = RandomPoint[Disk[], n], nf},
nf = Nearest[p, DistanceFunction -> dis];
ContourPlot[First[nf[{x, y}]], {x, -1, 1}, {y, -1, 1}, 
RegionFunction -> Function[{u, v}, u^2 + v^2 <= 1], 
Epilog -> {Red, PointSize[0.02], Point[p]}, PlotPoints -> 50]]

vh visualizes using Nearest with dis as distance function.

Some examples: Range[5,45,5] (takes quite some time):

enter image description here

Apologies for errors (typographical and conceptual). I look forward to much better answers.

share|improve this answer
3  
DistanceFunction -> dis suffices, of course. :) As for "takes quite some time", you can store Nearest[p, DistanceFunction -> dis] so that ContourPlot[] does not have to recompute so many times. – J. M. May 18 at 11:43
    
Thanks! This looks nice! But, why are some boundaries not computing? When I run your code, and in some pictures above, there are some regions with two or more points. Do I insert Nearest[p,DistanceFunction->dis] into Module? – user1974 May 18 at 12:36
    
@user1974 thanks. DensityPlot and changing numeric a aspects (plot points, max recursion etc) may improve quality. ColorFunction may help discrimination of regions. I am sure others will have better ways or you can play around. It is late in my Timezone, I have had 2 drinks and am off to sleep. Best wishes and good luck:) – ubpdqn May 18 at 12:41
    
@J.M. Thank you, as always... You are absolutely right...I had written a DynamicModule with LocatorPane that required calculation of a new NearestFunction but it was too slow...I just copied and pasted old code (in dim witted way). Will correct when time permits. Thanks again.:) – ubpdqn May 18 at 23:56

Here is some code I have for making fake Voronoi diagrams, adapted to the Poincaré disk model. The result has the look and feel of having been drawn with a charcoal pencil, which may or may not be desired for your application. The strategy is adapted from suggestions by Worley and Schlick.

(* some points *)
BlockRandom[SeedRandom[42, Method -> "MersenneTwister"]; 
            pts = RandomPoint[Disk[], 35]];

poincareMetric[u_?VectorQ, v_?VectorQ] := 
               Abs[ArcCosh[1 + 2 SquaredEuclideanDistance[u, v]/((1 - u.u) (1 - v.v))]]

(* Schlick's "bias" function, following Perlin and Hoffert *)
bias[a_, t_] := t/((1/a - 2) (1 - t) + 1)

With[{nodeFun = Nearest[pts, DistanceFunction -> poincareMetric]},
     Quiet @ DensityPlot[bias[0.99, HarmonicMean[#] - First[#]] & @
                         Map[poincareMetric[{x, y}, #] &, Take[nodeFun[{x, y}, 2], 2]],
                         {x, y} ∈ Disk[], AspectRatio -> Automatic, 
                         ColorFunction -> GrayLevel, Epilog -> {Thick, Circle[]}, 
                         PlotPoints -> 150, PlotRange -> All]]

fake Voronoi diagram for the Poincaré metric

The first argument of the bias[] function can be adjusted as seen fit. The following image is the result of setting the first parameter to 0.9:

slightly darkened

where the dots corresponding to the original point positions become more pronounced, at the expense of darkening the shading within the cells.


For completeness, here is the result of using the Beltrami metric instead:

beltramiMetric[u_?VectorQ, v_?VectorQ] := 
               poincareMetric[u/(1 + Sqrt[1 - u.u]), v/(1 + Sqrt[1 - v.v])]

With[{nodeFun = Nearest[pts, DistanceFunction -> beltramiMetric]},
     Quiet @ DensityPlot[bias[0.99, HarmonicMean[#] - First[#]] & @
                         Map[beltramiMetric[{x, y}, #] &, Take[nodeFun[{x, y}, 2], 2]],
                         {x, y} ∈ Disk[], AspectRatio -> Automatic, 
                         ColorFunction -> GrayLevel, Epilog -> {Thick, Circle[]}, 
                         PlotPoints -> 150, PlotRange -> All]]

fake Voronoi diagram for the Beltrami metric

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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