Revisions to Distribution of 10 points within a unit square

you want to maximize, not minimize

Source Link

edited Jul 2, 2014 at 12:04

user484

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 minimizemaximize $\min(f_1,...,f_n)$ it is typically more efficient to introduce a new variable $t$ and minimizemaximize 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

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 minimize $\min(f_1,...,f_n)$ it is typically more efficient to introduce a new variable $t$ and minimize 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

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

added 867 characters in body

Source Link

edited May 11, 2014 at 18:26

Simon Woods

85.4k
8
180
326

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 minimize $\min(f_1,...,f_n)$ it is typically more efficient to introduce a new variable $t$ and minimize 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

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

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 minimize $\min(f_1,...,f_n)$ it is typically more efficient to introduce a new variable $t$ and minimize 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

Source Link

created May 11, 2014 at 12:10

Simon Woods

85.4k
8
180
326

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

Stack Exchange Network

Return to Answer