Message Boards Message Boards

Packing Non-Convex Curves, Part 1

This example minimizes the distance between the center of 2 astroid curves.

In[5]:= (* rule to rotate and translate a curve given as a function \
of x and y *)
rottransrl[{xc_, yc_, \[Theta]_}, {x_, y_}] = 
  Thread[{x, y} -> RotationMatrix[-\[Theta]].{x - xc, y - yc}];

In[6]:=  (* rule to rotate and translate a curve in which x and y are \
functions of a polar angle parameter p*)
rottransp[{xc_, yc_, \[Theta]_}][{cx_, 
    cy_}] = (RotationMatrix[\[Theta]].{cx, cy}) + {xc, yc};

In[7]:= (* function of x and y which, when \[Equal] 0, gives an \
astroid curve of size a, centered at {xc,yc} with orientation \
\[Theta] *)
astroid[a_][xc_, yc_, \[Theta]_][x_, 
   y_] = (x^2 + y^2 - a^2)^3 + 27 a^2 x^2 y^2 /. 
   rottransrl[{xc, yc, \[Theta]}, {x, y}];

In[8]:= (* x and y coordinates of points on astroid curve of size a, \
centered at {xc,yc} with orientation \[Theta], as a function of polar \
pareameter p *)
astroid[a_][xc_, yc_, \[Theta]_][p_] = 
  rottransp[{xc, yc, \[Theta]}][a {Cos[p]^3, Sin[p]^3}];

In[9]:= (* evaluate function describing curve 1 at point \
parameterized by p on curve 2 *)
fcc[curve1_, curve2_] :=  curve1[x, y] /. Thread[{x, y} -> curve2[p]]

In[10]:= (* constraints that function describing first astroid is \
\[GreaterEqual]0 on 50 points on second astroid *)
c1 = Table[
   fcc[astroid[1][xc1, yc1, \[Theta]1], 
     astroid[1][xc2, yc2, \[Theta]2]] >= 0, {p, 2 \[Pi]/50, 2 \[Pi], 
    2 \[Pi]/50}];

In[11]:= (* constraints that function describing second astroid is \
\[GreaterEqual]0 on 50 points on first astroid *)
c2 = Table[
   fcc[astroid[1][xc2, yc2, \[Theta]2], 
     astroid[1][xc1, yc1, \[Theta]1]] >= 0, {p, 2 \[Pi]/50, 2 \[Pi], 
    2 \[Pi]/50}];

In[12]:= (* Constraint that the center of the second astroid curve is \
outside the first astroid curve *)
c3 = { astroid[1][xc1, yc1, \[Theta]1][xc2, yc2] >= 0.001};

In[13]:= (* Minimize the square of the distance between the centers \
of the two curves, subject to the above constraints, using \
ParametricIPOTMinimize (see attached notebook), using 10 random \
initial values of variables (randomn seed = 0 *)
AbsoluteTiming[
 sln = iMin[(xc1 - xc2)^2 + (yc1 - yc2)^2, 
   Join[c1, c2, 
    c3], {{xc1, -5, 5}, {yc1, -5, 5}, {\[Theta]1, 0, 
     2 \[Pi]}, {xc2, -5, 5}, {yc2, -5, 5}, {\[Theta]2, 0, 2 \[Pi]}}, 
   10, 0]]

During evaluation of In[13]:= {{Solve_Succeeded,7},{Infeasible_Problem_Detected,1},{Maximum_Iterations_Exceeded,1},{Restoration_Failed,1}}

Out[13]= {10.6588, {1.6875, {xc1 -> -0.129359, 
   yc1 -> 0.636507, \[Theta]1 -> 2.2949, xc2 -> 0.129359, 
   yc2 -> -0.636507, \[Theta]2 -> 2.2949}, "Solve_Succeeded"}}

In[14]:= (* Plot the result *)
Show[RegionPlot[(astroid[1][xc1, yc1, \[Theta]1][x, y] /. sln[[2]]) <=
    0, {x, -2, 2}, {y, -2, 2}, MaxRecursion -> 5],
 RegionPlot[(astroid[1][xc2, yc2, \[Theta]2][x, y] /. sln[[2]]) <= 
   0, {x, -2, 2}, {y, -2, 2}, MaxRecursion -> 5],
 Graphics @ Point[{{xc1, yc1}, {xc2, yc2}} /. sln[[2]]]]

enter image description here

POSTED BY: Frank Kampas
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract