Revisions to Maximal circle packing inside a given square

added 131 characters in body

Source Link

edited Apr 19, 2021 at 14:31

84.1k
6
97
179

Edit

It seems that RegionWithin is better than the original method.

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 1 >= r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[SignedRegionDistance[RegionBoundary@reg]@{{x[i], y[i]}} >= 
     r, {i, n}], Table[{x[i], y[i]} \[Element] reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

Edit

It seems that RegionWithin is better than the original method.

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 1 >= r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

Edit

It seems that RegionWithin is better than the original method.

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[SignedRegionDistance[RegionBoundary@reg]@{{x[i], y[i]}} >= 
     r, {i, n}], Table[{x[i], y[i]} \[Element] reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

deleted 34 characters in body

Source Link

edited Apr 19, 2021 at 14:20

cvgmt

84.1k
6
97
179

Edit

It seems that RegionWithin is better than the original method.

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 1 >= r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten,Method -> "DifferentialEvolution"]Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

Edit

It seems that RegionWithin is better than the original method.

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 1 >= r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten,Method -> "DifferentialEvolution"]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

Edit

It seems that RegionWithin is better than the original method.

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 1 >= r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

deleted 33 characters in body

Source Link

edited Apr 19, 2021 at 14:14

cvgmt

84.1k
6
97
179

Edit

It seems that RegionWithin is better than the original method.(Here we use the suggestion by @Chip Hurst).

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 1 >= r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[(Table[EuclideanDistance[{x[i] - x[j])^2 +, (y[i]}, -{x[j], y[j])^2}] >= 42 r^2r, {i, 
     n}, {j, 
     i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten]Flatten,Method -> "DifferentialEvolution"]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

Edit

It seems that RegionWithin is better than the original method.(Here we use the suggestion by @Chip Hurst).

reg = Rectangle[];
n = 5;
sol = NMaximize[{r,1 >= r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[(x[i] - x[j])^2 + (y[i] - y[j])^2 >= 4 r^2, {i, n}, {j, 
     i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

Edit

It seems that RegionWithin is better than the original method.

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 1 >= r > 0, 
   Table[RegionWithin[reg, Disk[{x[i], y[i]}, r]], {i, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[{x[i], y[i]}, {i, n}]} // Flatten,Method -> "DifferentialEvolution"]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], Table[Disk[{x[i], y[i]}, r], {i, n}]} /. 
   sol[[2]]}]

{0.207107, {r -> 0.207107, x[1] -> 0.207107, y[1] -> 0.792893, x[2] -> 0.207107, y[2] -> 0.207107, x[3] -> 0.792893, y[3] -> 0.792893, x[4] -> 0.792893, y[4] -> 0.207107, x[5] -> 0.5, y[5] -> 0.5}}

Original

For the $n$ points $p_i,i=1\cdots n$, we set $$d(p_i,p_j)\geq 2r,i\not=j$$ and all the distance to the boundary of region $d(p_i,Boundary)\geq r$

reg = Rectangle[];
n = 5;
sol = NMaximize[{r, 
   SignedRegionDistance[RegionBoundary@reg] /@ 
     Table[{x[i], y[i]}, {i, n}] >= r, 
   Table[{x[i], y[i]} ∈ reg, {i, 1, n}], 
   Table[EuclideanDistance[{x[i], y[i]}, {x[j], y[j]}] >= 2 r, {i, 
     n}, {j, i - 1}]}, {r, Table[x[i], {i, n}], Table[y[i], {i, n}]} //
    Flatten]
Graphics[{EdgeForm[Cyan], FaceForm[], 
  Rectangle[], {FaceForm[Red], 
    Table[Disk[{x[i], y[i]}, r], {i, n}]} /. sol[[2]]}]

[Edit removed during grace period]; added 10 characters in body

Source Link

edited Apr 19, 2021 at 14:07

cvgmt

84.1k
6
97
179

Loading

deleted 40 characters in body

Source Link

edited Apr 19, 2021 at 14:01

cvgmt

84.1k
6
97
179

Loading

added 441 characters in body

Source Link

edited Apr 19, 2021 at 13:55

cvgmt

84.1k
6
97
179

Loading

added 87 characters in body

Source Link

edited Apr 19, 2021 at 11:57

cvgmt

84.1k
6
97
179

Loading

added 120 characters in body

Source Link

edited Apr 19, 2021 at 11:43

cvgmt

84.1k
6
97
179

Loading

Source Link

created Apr 19, 2021 at 11:33

cvgmt

84.1k
6
97
179

Loading

Stack Exchange Network

Return to Answer