0
$\begingroup$

I' m interesting in distributions of points on sphere, plane figures etc. Especially for small number of points: 1, 3, 7, ...

It seems that good criterion for uniformity of distribution is some generalization of mass center criterion.

Let's think about unit disk and N "seeds" on it. For every point of disk {x,y} let's find closest seed and the Euclidean length squared to it. Average this over all the points {x,y} and try to minimize it.
For N=1 we will get exactly mass center. For N>1 we will get some interesting
"the most even" configurations.

With Mathematica we have:

myDist[point_, seeds_] :=SquaredEuclideanDistance[point, Nearest[seeds, point][[1]]] 
/;VectorQ[point, NumericQ] && MatrixQ[seeds, NumericQ]; 

optValue[seeds_]:=(1/Pi) NIntegrate[
        myDist[{x, y}, seeds] Boole[Sqrt[x^2 + y^2] <= 1], 
      {x, -diam, diam}, {y, -diam, diam}]/; MatrixQ[seeds, NumericQ];

This integration have to be very fast since it should be optimized later with NMinimize[]. I've tried many methods; the best result for Length[seeds]=5 is 0.36 second with:

Method -> {"MultiDimensionalRule","Generators" -> 5}, MaxRecursion -> 3, PrecisionGoal -> 4

But using "brutal force" summation over net of points:

step = 0.07;
net = Reap[Do[
        Do[
          If[Sqrt[x^2 + y^2] <= 1, Sow[{x, y}]], 
        {x, -1, 1, step}],
       {y, -1, 1, step}]][[2, 1]];
optVal = Total[symbDist[#, seeds]& /@ net]/Length[net];

we can get the same PrecisionGoal = 4 within 0.016 second! (the same computer)
I understand that integrable function myDist is weird enough. By maybe someone help me to find good and fast integration method for it?

$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I suggest that: 1) You take the introductory Tour now! 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. $\endgroup$ – bbgodfrey Feb 19 '15 at 10:46
  • $\begingroup$ Id suggest you provide a real example. " plane figures etc. " suggests more complicated situations that might lead to different approaches than your circle. $\endgroup$ – george2079 Feb 19 '15 at 20:16
1
$\begingroup$

Pre-calculating the Nearest function, performing the integral in polar coordinates and relaxing the patterns will give you a nice speedup (60%/80% in my experiments):

SeedRandom[42];
seeds = RandomReal[{0, 1}, {100, 2}];
diam = 1;
memF = Nearest[seeds];
myDist[point_] := #.# &@(point - First@memF[point]) /; VectorQ[point, NumericQ]
optValue[seeds_] := (1/Pi) NIntegrate[myDist[r {Cos@phi, Sin@phi}] r, 
                                             {r, 0, diam}, {phi, 0, 2 Pi}, PrecisionGoal -> 4]
optValue[seeds] // Timing
$\endgroup$
  • $\begingroup$ Yes, that works, thank you! For optimization purposes I edit your code like this: myDist[point_, seeds_] := With[{memF = Nearest[seeds]}, #.# &@(point - First@memF[point])] /; VectorQ[point, NumericQ] && MatrixQ[seeds, NumericQ]; $\endgroup$ – lesobrod Feb 19 '15 at 15:44
  • $\begingroup$ Sorry, your advice is good, but not exact answer on my question. With NIntegrate[] and new myDist I get ~0.15 sec. It's really better. But with direct summation directOpt[pnts_, step_, diam_] := Module[{s = 0, j = 0}, Do[Do[ If[Sqrt[x^2 + y^2] <= 1, (j = j + 1; s = s + myDist[{x, y}, pnts])], {x, -diam, diam, step}], {y, -diam, diam, step}]; s/j] /; MatrixQ[pnts, NumericQ]; I get ~0.01 sec. NIntegrate[] fail anyway... $\endgroup$ – lesobrod Feb 19 '15 at 16:49
  • 1
    $\begingroup$ @lesobrod You're comparing pears with apples. $\endgroup$ – Dr. belisarius Feb 19 '15 at 17:02

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.