Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Related to some packing problems, following problem arose:

Distribute 10 points within a square of sides 1, so that minimal distance between them is maximized.

With the help of random simulation, or any other method, please provide example of such distribution, with graphical representation of square and points, and value of minimal distance between points for such distribution.

The answer with distribution with largest minimal distance wins the "answer badge"! :)

(This problem so far to my knowledge couldn't be solved by pure mathematics, so I am coming here for valuable and desperately needed help regarding simulations etc.)

share|improve this question
3  
You could use NMaximize. –  b.gatessucks May 11 at 9:37
1  
Possibly related: (2594) –  Mr.Wizard May 11 at 12:26

2 Answers 2

up vote 11 down vote accepted

Since this does seem to be a kind of packing problem I searched for prior explorations, and found a list of packings for equal-circles within a square at:

The best known packing for N = 10 is shown as:

enter image description here

The coordinates for the points are:

   1  -0.055497063038156969690135505676  -0.351795677434771201331992637257
   2   0.240911582092300627645879219810  -0.351795677434771201331992637257
   3  -0.351795677434771201331992637257  -0.343720034134076580133895794673
   4   0.055387032304313603995977911771  -0.076908787408790806346486820340
   5   0.351795677434771201331992637257  -0.076908787408790806346486820339
   6  -0.351795677434771201331992637257  -0.047311389003618982797881069187
   7  -0.132623434010086730621834242216   0.152242144215576109267055784036
   8   0.351795677434771201331992637257   0.219499857721666790989527905147
   9  -0.351795677434771201331992637257   0.351795677434771201331992637257
  10   0.086548809414597740088324152827   0.351795677434771201331992637257

Plotted:

pts = {{-0.0554971`, -0.351796`}, {0.240912`, -0.351796`}, {-0.351796`, -0.34372`},
 {0.055387`, -0.0769088`}, {0.351796`, -0.0769088`}, {-0.351796`, -0.0473114`},
 {-0.132623`, 0.152242`}, {0.351796`, 0.2195`}, {-0.351796`, 0.351796`},
 {0.0865488`, 0.351796`}};

m = Min @ pts;

Graphics[{
  {LightBlue, Rectangle[{m, m}, -{m, m}]},
  {Red, AbsolutePointSize[15], Point @ pts}
}]

enter image description here

The minimal distance between points (full precision, and scaled to a unit square) is: 0.42127954398...

I suspect a better solution will not be forthcoming.


Old comments

Blatantly copying Simon's code, but messing with optimization parameters I get this:

pts = Array[{x[#], y[#]} &, 10];
mindist2 = Min[#.# & /@ Subtract @@@ Subsets[pts, {2}]];
vars = Flatten[pts];
constraints = Thread[0 <= vars <= 1];
{md2, rules} = 
  NMaximize[{mindist2, constraints}, vars, 
   Method -> {"DifferentialEvolution",
              "CrossProbability" -> 0.6,
              "ScalingFactor" -> 0.68,
              "RandomSeed" -> 42}];

minimaldistance = Sqrt[md2]

Graphics[{Yellow, Rectangle[], Red, PointSize[Large], Point[pts /. rules]}]
0.417788

enter image description here

This is a better result, but I have zero confidence that it is optimal. I wonder how else one might approach this.

share|improve this answer

A simple numerical maximization using NMaximize as suggested by b.gatessucks:

pts = Array[{x[#], y[#]} &, 10];
mindist2 = Min[#.# & /@ Subtract @@@ Subsets[pts, {2}]];
vars = Flatten[pts];
constraints = Thread[0 <= vars <= 1];
{md2, rules} = NMaximize[{mindist2, constraints}, vars];

minimaldistance = Sqrt[md2]
(* 0.381759 *)

Graphics[{Yellow, Rectangle[], Red, PointSize[Large], Point[pts /. rules]}]

enter image description here

Update

Rahul Narain's comment informs us that to maximize $\min(f_1,...,f_n)$ it is typically more efficient to introduce a new variable $t$ and maximize that with the constraints $t\le f_1,...,t\le f_n$. Modifying the code to work that way, and blatantly copying Mr. Wizard's method optimizations gives an improved result:

pts = Array[{x[#], y[#]} &, 10];
dist2 = #.# & /@ Subtract @@@ Subsets[pts, {2}];
vars = Flatten[pts];
constraints = Thread[0 <= vars <= 1] ~Join~ Thread[mindist < dist2];
{md2, rules} = NMaximize[{mindist, constraints}, Append[vars, mindist], 
  Method -> {"DifferentialEvolution", "CrossProbability" -> 0.6, 
    "ScalingFactor" -> 0.68, "RandomSeed" -> 42}];

minimaldistance = Sqrt[md2]
(* 0.421268 *)

enter image description here

share|improve this answer
2  
Typically in optimization, if you want to maximize $\min(f_1,\ldots,f_n)$ it is more efficient to maximize a new variable $t$ subject to the constraints $t\le f_1, \ldots, t\le f_n$. –  Rahul May 11 at 17:19
    
So, it looks NMaximize returned some kind of local maximum 0.38 (the other answer has 0.42)! –  VividD May 11 at 17:38
1  
I guess we did it simultaneously. :) It's gratifying that your new solution seems to be the same as the best known packing posted by Mr.Wizard under a reflection across the NE/SW diagonal. –  Rahul May 11 at 18:33
3  
Also FYI: using the numbers referenced in my answer I believe the optimal (known) spacing is: 0.4212795 -- I wonder if that can be coaxed out of Mathematica? –  Mr.Wizard May 11 at 18:58
3  
@Mr.Wizard, Simon: Try setting MaxIterations -> 200 and no other parameters. I get a minimum distance of 0.4212794349471961. –  Rahul May 11 at 21:10

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.