3
$\begingroup$

Suppose I have the function f[c_, z_] := z^2 + c and the following collection of circles in the plane. This is a simple example with only three circles, disjoint and not nested, and lying on the real line. Take comp[{x_, y_}] := x + y*I.

Show[Table[Graphics[Line[ReIm[Nest[f[-1.755, #] &, Map[comp, CirclePoints[{0, 0}, 0.1, 1000]], i]]]], {i, 0, 2}]]

Given one circle, I would like to connect it to the closest circle (that isn't itself) by the shortest possible line. So in this example the lines would be the segments of the real line between the closest points of the circles. The following code does this manually.

Graphics[Line[
  ReIm[{Nest[f[-1.755, #] &, 
     Map[comp, CirclePoints[{0, 0}, 0.1, 1000]], 0], 
    Map[comp, 
     Table[BezierFunction[{Map[ReIm, 
           Nest[f[-1.755, #] &, 
            Map[comp, CirclePoints[{0, 0}, 0.1, 1000]], 0]][[750]], 
         Map[ReIm, 
           Nest[f[-1.755, #] &, 
            Map[comp, CirclePoints[{0, 0}, 0.1, 1000]], 1]][[750]]}][
       s], {s, 0, 1, 0.001}]], 
    Nest[f[-1.755, #] &, Map[comp, CirclePoints[{0, 0}, 0.1, 1000]], 
     1], Nest[f[-1.755, #] &, 
     Map[comp, CirclePoints[{0, 0}, 0.1, 1000]], 2], 
    Map[comp, 
     Table[BezierFunction[{Map[ReIm, 
           Nest[f[-1.755, #] &, 
            Map[comp, CirclePoints[{0, 0}, 0.1, 1000]], 0]][[250]], 
         Map[ReIm, 
           Nest[f[-1.755, #] &, 
            Map[comp, CirclePoints[{0, 0}, 0.1, 1000]], 2]][[750]]}][
       s], {s, 0, 1, 0.001}]]}]]]

This is messy but it works. However for more circles this will become very tedious to implement. Is there a quicker way to do this? I would still like to get the points along the connecting lines for future calculations. Also, perhaps more difficult, what if the parameter c for f[c,z] is complex so the lines are no longer in a straight line?

$\endgroup$
10
$\begingroup$

Building on @Cesareo's answer (especially his initial example configuration), but trying to take more advantage of built-in functionality...

(* generate initial example, like Cesareo's answer, but with explicit Circle data structure *)

SeedRandom[8]
circs = Circle @@@ Table[{RandomReal[{-20, 20}, 2], RandomReal[{1, 3}]}, 10];

(* define a center-to-center distance function *)
df[x_, y_] := EuclideanDistance[x[[1]], y[[1]]]

(*use it to determine neighbors*)
neighbors = NearestNeighborGraph[circs, DistanceFunction -> df,
   DirectedEdges -> False];

(*define a function to determine the minimal lines*)
minLine[edge_] := With[
  {p1 = RegionNearest[edge[[1]], edge[[2, 1]]],
   p2 = RegionNearest[edge[[2]], edge[[1, 1]]]},
  Line[{p1, p2}]]

(*generate a list of Lines, and then display the final result*)
lines = minLine /@ EdgeList[neighbors];
Graphics[{Red, lines, Black, circs}]

display of final results. black circles with red lines

$\endgroup$
10
$\begingroup$

If I understood the question, the solution can be addressed as follows:

SeedRandom[8]
circs = Table[{RandomReal[{-20, 20}, 2], RandomReal[{1, 3}]}, 10];
nc = Length[circs];
grcircs = Table[Graphics[Circle[circs[[k, 1]], circs[[k, 2]]]], {k, 1, nc}];
dists = {};
For[i = 1, i <= nc, i++, {ci, ri} = circs[[i]];
 distmax = 1000;
 For[j = 1, j <= nc, j++,
  If[i != j,
   {cj, rj} = circs[[j]];
   d = Norm[ci - cj];
   dij = d - ri - rj;
   If[dij > 0, 
    If[dij < distmax,
     distmax = dij;
     d0 = d;
     ci0 = ci;
     cj0 = cj;
     ri0 = ri;
     rj0 = rj;
     j0 = j]
    ]
   ]
  ];
 AppendTo[dists, {distmax, d0, i, j0, ci0, cj0, ri0, rj0}]
 ]
grsegs = {};
For[i = 1, i <= nc, i++,
 {distmax, d, i0, j0, ci0, cj0, ri0, rj0} = dists[[i]];
 vij = (cj0 - ci0)/d;
 pi = ci0 + ri0 vij;
 pj = cj0 - rj0 vij;
 AppendTo[grsegs, ParametricPlot[mu pi + (1 - mu) pj, {mu, 0, 1}]]]
Show[grcircs, grsegs, PlotRange -> All]

enter image description here

$\endgroup$
5
$\begingroup$
ClearAll[distF]

distF[Circle[c1_, r1_], Circle[c2_, r2_]] := Norm[c1 - c2 - Normalize[c1-c2] (r1 + r2)]

We can use distF in two ways:

1. NearestNeighborGraph

We get the desired picture using NearestNeighborGraph with the options PerformanceGoal -> "Quality" and VertexShapeFunction -> (#2&):

ClearAll[nnG]
nnG = NearestNeighborGraph[#, DistanceFunction -> distF, 
    PerformanceGoal -> "Quality", VertexShapeFunction -> (#2 &), 
    VertexLabels -> Placed["Index", Center], DirectedEdges -> False, 
    VertexStyle -> Black, EdgeStyle -> Red] &;

Examples:

Using the list of circles circs from Cesareo's answer as an example input:

SeedRandom[8]
circs = Circle @@@ Table[{RandomReal[{-20, 20}, 2], RandomReal[{1, 3}]}, 10];

nnG @ circs

enter image description here

A simpler example:

SeedRandom[8]
circs2 = Circle @@@ Transpose[{3 CirclePoints[3], RandomReal[{.1, 1}, 3]}];

nnG @ circs2

enter image description here

2. Nearest

We identify the nearest neighbor of each circle and construct a line between each circle and its nearest neighbor:

ClearAll[nF, shortestLine]

nF[cl : {__Circle}] := Last @ Nearest[cl, #, 2, DistanceFunction -> distF] &;

shortestLine[Circle[c1_, r1_], Circle[c2_, r2_]] := Module[{nrml = Normalize[c1 - c2]},
  Line[{c1 - r1 nrml, c2 + r2 nrml}]]

Examples:

Graphics[{circs, Red, shortestLine @@@ Transpose[{circs, nF[circs] /@ circs}]}]

enter image description here

Graphics[{circs2, Red, shortestLine @@@ Transpose[{circs2, nF[circs2] /@ circs2}]}]

enter image description here

Note: The distance function df in accepted answer ignores the radii when identifying neighbors. Although it happens to give correct answer for input circs, for input circs2 it gives

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.