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.

Given a list of circles of different areas, I need to arrange them tangentially in order of increasing area and spiraling outward. An example of the type of packing I'm attempting is shown by the orange circles in the figure below:

enter image description here

Is there a concise way to calculate the centers of the circles?

share|improve this question
3  
Vi Hart has a great little video on a related idea. No help with doing this problem, but it does put this kind of problem in and interesting light. youtube.com/watch?v=DK5Z709J2eo –  Jagra Jun 14 '12 at 20:45
1  
Could you post a minimal set of radii you want to have positioned (and perhaps how that should look like)? The image is somewhat more complicated than what your request implies and breaking down the problem may be helpful. –  Yves Klett Jun 15 '12 at 13:25

2 Answers 2

up vote 13 down vote accepted

Here's my version. I don't know how fast/slow it is compared to the other solutions, but at least is shortish.

spiral[rlist_ /; Length[rlist] >= 2] := Module[{findCentre},
  findCentre[zlist_] := Module[{coslst, theta, ind, k},
    k = Length[zlist] + 1;
    coslst = Table[
       With[{dist = N@Norm[zlist[[-1]] - zlist[[l]]]}, 
         ((rlist[[k - 1]] + rlist[[k]])^2 - (rlist[[k]] + rlist[[l]])^2 + dist^2)/dist], 
      {l, k - 2}]/2/(rlist[[k - 1]] + rlist[[k]]) ;
    ind = Flatten[Position[coslst, a_?NumericQ /; Abs[a] < 1]];
    theta = Min[Mod[#, 2 Pi, 
         ArcTan @@ (zlist[[-2]] - zlist[[-1]])] &@(-ArcCos[
           coslst[[ind]]] + (ArcTan @@ (# - zlist[[k - 1]]) & /@ 
           zlist[[ind]]))];
    zlist[[k - 1]] + (rlist[[k]] + rlist[[k - 1]]) {Cos[theta], Sin[theta]}];
  Nest[Append[#, findCentre[#]] &, {{0, 0}, {Total[rlist[[;; 2]]], 0}}, Length[rlist] - 2]]

testList = Union@RandomReal[{1, 10}, 50];
result = spiral[testList];
Graphics[MapThread[Circle, {result, testList}]]

Mathematica graphics

share|improve this answer
    
This works really well. +1 –  Mr.Wizard Jun 18 '12 at 21:12
(* Position of a circle tangential to other two circles *)
pos[{{x1_, y1_}, r1_}, {{x2_, y2_}, r2_}, r3_] :=
 (k = N@( ((x1 - x3)^2 + (y1 - y3)^2 == (r1 + r3)^2) &&
           (x2 - x3)^2 + (y2 - y3)^2 == (r2 + r3)^2);
  ({x3, y3} /. FindInstance[k, {x3, y3}, Reals, 2])
  )

(*Select the correct center*)
nextCircle[prevCirc_, currentCircRadius_] :=
  {Last@SortBy[Select[Flatten[Table[
       pos[p, Last@prevCirc, currentCircRadius], {p, Most@prevCirc}], 1], 
       Im[#] == {0., 0.} && prevCirc[[-1, 1, 1]] #[[2]] - prevCirc[[-1, 1, 2]] #[[1]] <=0 &], 
       Norm@# &], currentCircRadius};

spiral[radii_] := Module[{circs},
   (*use first and second circles as a seed*)
   circs = {{{0, 0}, radii[[1]]}, {{radii[[1]] + radii[[2]], 0}, radii[[2]]}};
   Fold[Append[#1, nextCircle[#1, #2]] &, circs, radii[[3 ;;]]]
   ];

Off[Part::partd]
radii = Sort@RandomReal[{1, 5}, 100];
Graphics[Circle[#[[1]], #[[2]]] & /@ spiral[radii], PlotRange -> 40 {{-1, 1}, {-1, 1}}]
On[Part::partd];

enter image description here

share|improve this answer

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.