# Fixing Spline curves so as to not overlap with themselves - (Diagrams)

Statement of the problem:

Conceptually, what I'm trying to achieve is pretty simple. I have some code that generates a set of diagrams from a list of sets of points using BSplineCurve. Certain conditions cause some of these diagrams to come out differently from what I need. With SplineDegree -> 1 the images look like: and with SplineDegree -> 3 the images become: The problematic cases are images a7, a8 and a9, which I need to look like: The general rule is that I need closed smooth curves through the specified points, but the curve must not lie on top of itself when the points all lie on a straight line (I also need the curves to pass directly through the points, but this is another issue that is probably fairly easily solved - I've tried clamping without much success so far).

I have tried to solve this problem by implementing clunky IF statements that add additional guide points, but in addition to the fact that I struggle to make it work, it's very undesirable, because I need this to generalize to more complicated diagrams. For example, here is a preview of the higher dimensional case (the full list is very long): The last five images are problematic and should look like I have also considered using Graph to try and do this, but I'm not really sure where to start.

Code:

I can't provide the full code, because the process of generating the list of points is exceptionally long. Here is the section that is relevant:

Clear[\[Delta]ToBirdTrack1];
Options[\[Delta]ToBirdTrack1] = {Background -> White, Trace -> Tr,
Scale -> 1};
\[Delta]ToBirdTrack1[expr_, A_: a, B_: b,
options___Rule] := \[Delta]ToBirdTrack1[expr, A, B, options] =
Module[{l, s, aa, bb, h, res, res1, hsep, vsep, samesep, bgcolor,
trace, scale, split},

(* options *)
bgcolor = Background /. {options} /. Options[\[Delta]ToBirdTrack1];
trace = Trace /. {options} /. Options[\[Delta]ToBirdTrack1];
scale = Scale /. {options} /. Options[\[Delta]ToBirdTrack1];

hsep = 5;
vsep = 2;
samesep = hsep/6;
l = (expr //
Cases[#, Subscript[A,  i], Infinity, Heads -> True] & //
Union // Length);
h = l*vsep;

(*line 1*)
res = (expr /.
Tr[aa__] :> m[Line[(*Append[*)aa(*,First[aa]]*)]] //.
m[aa__] m[bb__] -> m[aa, bb]) /. UP -> Sequence /.
Subscript[t, i_] -> i;

(*line 2*)
res = res // (# /. m[aa__] :> (m[aa] /. a_Line :> pos /@ a)) &;

(*line 3*)
res // (# /.
Line[aa__] :>
BSplineCurve[{aa}, SplineClosed -> True]) & // (# /.
m[aa__] :> Graphics[{aa}]) &
];

ExplicitList[NgI] //
Sum[Subscript[\[Alpha], i] #[[i]], {i,
Length[#]}] & // \[Delta]ToBirdTrack1[#] &


I can't provide the data being put into this code, again because of length, but I can however show what it looks like. At "line 1" res is being shaped into this list: At "line 2" it is shaped into this list: And at "line 3" the "aa's" that are being considered by the Spline Curve plotting look like this: Any and all help would be greatly appreciated, with the most general solution being the goal.

## 1 Answer

Here's a way with Interpolation. It passes through the points as the OP desires. It specifies the velocity (derivative) through the points by bisecting the exterior angle of the polygon; if the path turns back on itself, it specifies a velocity at a right angle (to the "left" of the direction of approach to the vertex) to the edge. The weights multiply the velocities; it can be a single scalar or a list of scalars, one for each vertex. There are probably shortcomings with more complicated diagrams but it works pretty well on the ones I tested.

Clear[diag, intPts];
intPts[list_, weights_: 1] :=
With[{dl =
weights (Through[{Cos, Sin}[
If[Total[#] == {0, 0}, ArcTan @@ Cross@First@#,
ArcTan @@ Total[#]]]] & /@ (Normalize /@ # &) /@
Differences /@ Partition[list, 3, 1, 2])},
Transpose@{
List /@ Rescale[Range[1 + Length@list]],
Append[#, First@#] &@list,
Append[#, First@#] &@dl}
];
diag[pts_] := Interpolation /@ intPts /@ pts;
diag[pts_, wts_List] := Interpolation /@ MapThread[intPts, {pts, wts}];
diag[pts_, wts_] := Interpolation /@ (intPts[#, wts] &) /@ pts;


Examples

Since copyable coordinates weren't provided, I made up my own. These are like the last three of the first set of the OP's examples.

a7 = {{{0, 0}, {2, 1}}, {{2, 0}, {0, 1}}};
a8 = {{{0, 0}, {2, 0}}, {{0, 1}, {2, 1}}};
a9 = {{{0, 0}, {0, 1}}, {{2, 0}, {2, 1}}};
GraphicsRow[
ParametricPlot[Evaluate@Through[diag[#][t]], {t, 0, 1},
Axes -> False, PlotStyle -> Thick,
Prolog -> {EdgeForm @ Directive[Dashed, Thickness[Small], Red],
Opacity, Polygon /@ #},
Epilog -> {Red, PointSize[Medium], Point /@ #}] & /@ {a7, a8, a9}
] The last three figures of the second set of examples:

d3 = {{{0, 0}, {2, 1}, {2, 0}, {2, 2}, {0, 1}, {0, 2}}};
d4 = {{{0, 0}, {2, 1}, {1, 1}, {0, 1}, {0, 2}, {1, 1}, {2, 0}, {2, 2}, {1, 1}}};
d5 = {{{0, 0}, {2, 0}, {2, 2}, {0, 2}, {0, 1}, {2, 1}}};
GraphicsRow[
ParametricPlot[Evaluate @ Through[diag[#, 5][t]], {t, 0, 1},
Axes -> False, PlotStyle -> Thick,
Prolog -> {EdgeForm @ Directive[Dashed, Thickness[Small], Red],
Opacity, Polygon /@ #},
Epilog -> {Red, PointSize[Medium], Point /@ #}] & /@ {d4, d5, d6}
] 