# Homotopy Visualization

I noticed that both the lower cased 'i' and the Apple logo  are topologically equivalent to the disjoint union of two closed discs. I'd like to animate a homotopy from the left to the right, can this be done in Mathematica 10 with built in functions?

• I guess you mean a homotopy, actually. – Mark McClure Sep 11 '14 at 22:28
• Yeah, they are homeomorphic, but you are right, it's the homotopy that I want. – tlehman Sep 11 '14 at 22:29
• I did something like here to illustrate graph isomorphism. That's much simpler, though, really. Shouldn't be to hard to grab a set of points describing the boundaries of the objects but it might be tricky to maintain the topological integrity throughout the animation. – Mark McClure Sep 11 '14 at 22:33

Here's a way to morph the boundaries. After finding the boundaries by Thinning of the result of EdgeDetect, FindCurvePath finds a sequence of points that traces a path around each segment. MorphologicalComponents numbers the component left to right, top to bottom, so that 1 is the apple leaf, 2 is the i-dot, 3 is the apple body, and 4 is the i-stem (5, 6 are the equal sign). We can then interpolate a path around each boundary (cIFNs). Finally we interpolate between the corresponding paths (1-p)... + p....

img = Import["http://i.stack.imgur.com/B7Fka.png"];
boundaries = Thinning @ EdgeDetect[img, 1];
comp = MorphologicalComponents @ boundaries;

pdata = Position[comp, #].{{0, -1}, {1, 0}} & /@ {1, 2, 3, 4};

curves = FindCurvePath /@ pdata;

Interpolation[
Transpose@{Rescale@Range@Length@First@#2, #1[[First@#2]]},
PeriodicInterpolation -> True] &, {pdata, curves}
];

(* offset between middle of apple and middle of "i" *)
offset = First @ Differences[Mean @ Through[{Min, Max}[#]] & /@ pdata[[{3, 4}, All, 1]]];

Manipulate[
ParametricPlot[{
(1 - p) cIFNs[][t] + p (cIFNs[][t] + {-offset, 0}),
(1 - p) cIFNs[][t] + p (cIFNs[][t] + {-offset, 0})},
{t, 0, 1},
Axes -> False, Frame -> True,
PlotRange -> {{0,
Total[Through[{Min, Max}[pdata[[3, All, 1]]]]]}, {-Last@
ImageDimensions[img], 0}}],
{p, 0, 1}
] To morph the areas, post-process the plot by replacing Line with Polygon:

ParametricPlot[...] /. Line -> Polygon


One can omit the frame, of course.

• This is by far the greatest solution I've seen, excellent work! – tlehman Sep 12 '14 at 18:40
• WOW, wicked answer! +1 – Ellie Oct 5 '14 at 21:13
• Here's a neat way to see the evolution: ParametricPlot3D[{Append[(1 - p) cIFNs[][t] + p (cIFNs[][t] + {-offset, 0}), 200 p], Append[(1 - p) cIFNs[][t] + p (cIFNs[][t] + {-offset, 0}), 200 p]}, {p, 0, 1}, {t, 0, 1}, Axes -> False, Boxed -> False] – Chip Hurst Nov 24 '15 at 17:04
• Or use -200p instead of 200p to see the evolution in reverse order. – Chip Hurst Nov 24 '15 at 17:08
• Seeing the homotopy between the apple logo and the equals sign is pretty neat too. pdata = Position[comp, #].{{0, -1}, {1, 0}} & /@ {1, 5, 3, 6} – Chip Hurst Nov 24 '15 at 17:15

One way to do it would be to use glyphs. We can extract the curves that make up the two characters as follows:

a = First@First@Last@First@First@
ImportString[ExportString[
Style[FromCharacterCode, 24, FontFamily -> "Baskerville Old Face"],
"PDF"], "PDF", "TextMode" -> "Outlines"];

b = First@First@Last@First@First@
ImportString[ExportString[
Style["i", 24, Bold, FontFamily -> "Courier New"],
"PDF"], "PDF", "TextMode" -> "Outlines"];


These each give a FilledCurve, which I presume defines a spline. The documentation doesn't seem to explain the format given here. But it appears to be a bunch of control information (degree? knots?), then a bunch of points. But we shall not let ignorance stop us.

The main challenge now is morphing one curve into another. Since the apple logo has more points than the 'i', we shall simply force a bunch of repeated points in the 'i' curve to aid in the transition. First grab the data:

control = First@a;
pa = Last@a;
pb = Last@b;
magic = {{2, 8, 3, 8, 2}, {2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 1,
2, 2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 2, 2}};


Then repeat some points in the 'i':

newb = Map[Sequence @@ ConstantArray[First@#, Last@#] &, Thread /@ Thread[{pb, magic}], {2}];


Now we can just do a simple linear transition between the two:

Table[Graphics@FilledCurve[control, pa + t (newb - pa)], {t, 0, 1, 0.1}]


Using a sinusoidal t, and some well chosen Export options (exercise left to the reader), we get: Let us do it purely by image-processing. The main idea is to use DistanceTransform here.

{img1, img2} = ImageResize[#, Scaled] & /@
Import /@ {"http://i.stack.imgur.com/RKHo5.png",
"http://i.stack.imgur.com/MFGR4.png"}


The signed distances to the boundaries of all morphological components are

dist = ImageData@ImageSubtract[DistanceTransform@Image@#,
DistanceTransform@ColorNegate@Image@#] & /@
MorphologicalComponents@ColorNegate@Binarize@# & /@ {img1, img2};

Map[ImageAdjust@Image@# &, dist, {2}] // Grid It is remain is to take a linear composition of these distances

top[t_] := ColorNegate@Image@Total[UnitStep[# (1 - t) + #2 t] & @@@ Transpose@dist];

Export["anim.gif", Join[#, Reverse@#] &@
Table[ImageResize[top[t], Scaled[1/3]], {t, 0, 1, 0.01}]]; • I'm afraid this technique doesn't always produce a homotopy. For example, try interpolating a small disk in the lower left corner to a small disk in the upper right; it will disappear along the way. – user484 Sep 12 '14 at 17:15
• @RahulNarain, yes, if there is no intersection then there is such an artifact. One can avoid it by introducing a moving center and applying the algorithm above relative to the moving center. Like in physics: motion of the center of mass and the relative motion. If you are interesting, I can add corresponding lines to the code. – ybeltukov Sep 12 '14 at 19:11
• I think translating the center of mass will not help with these images: i.stack.imgur.com/2ob00.png, i.stack.imgur.com/RIL4B.png. But perhaps I'm being too critical. – user484 Sep 12 '14 at 19:39
• @RahulNarain Yes :) It's a very difficult task to deal with such images. Spirals will be even more difficult. Thank you for the deep insight in my answer! – ybeltukov Sep 12 '14 at 20:20
• The big benefit of this approach is that can create a smooth mapping between shapes where a homotopy doesn't exist at all, e.g. mapping a "P" to an "F", or an "O" to an "i". I only discovered your answer until I hacked it down myself. Nevertheless +1 for this nice answer. – halirutan Mar 19 '17 at 10:41