A to Z
I've mentioned before that there's a construction which gives a correspondence between points on the Grassmann manifold
$G_2(\mathbb{R}^n)$ of 2-dimensional linear subspaces of
$\mathbb{R}^n$ and planar
$n$-gons; details at 1, 2, 3, 4, 5, 6.
In particular, this gives a way of morphing between any two (discrete) shapes you like; this animation shows the shortest path from A to Z.
Here's the code; notice that I use the smootheststep
function:
ProjectionBasis[{A_, B_}, {C_, D_}] :=
Normalize[#] & /@
Eigenvectors[
Transpose[Transpose[{A, B}].{A, B}.Transpose[{C, D}].{C, D}], 2];
PlaneGeo[{A_, B_}, {C_, D_}, t_] :=
Module[{a, b, c, d, cPerp, dPerp, dist1, dist2},
{a, b} = ProjectionBasis[{C, D}, {A, B}];
{c, d} = ProjectionBasis[{A, B}, {C, D}];
{cPerp, dPerp} = {Normalize[c - (c.a)*a], Normalize[d - (d.b)*b]};
dist1 = ArcCos[a.c];
dist2 = ArcCos[b.d];
{Cos[t*dist1]*a + Sin[t*dist1]*cPerp,
Cos[t*dist2]*b + Sin[t*dist2]*dPerp}
];
MakePoly[data_] :=
Normalize[#] & /@
Transpose[{Re[#], Im[#]} & /@
Sqrt[Table[#[[n]][[1]] + I*#[[n]][[2]], {n, 1, Length[#]}] &[
RotateLeft[#] - # &[data]]]];
RawAData = {{-3., .9}, {1.07, 8.18}, {1.85, 8.2}, {5.96, 0.86}, {4.89,
0.86}, {1.77, 6.6}, {1.18, 6.6}, {.12, 4.58}, {2.87, 4.6}, {3.35,
3.76}, {-.18, 3.76}, {-1.72, .94}};
RawZData = {{0.82, 7.26}, {7.61, 7.32}, {7.65,
6.04}, {1.92, -.06}, {7.76, -.02}, {7.8, -1.16}, {.71, -1.12}, \
{.71, .02}, {6.36, 6.12}, {.85, 6.12}, {.82, 6.12}, {.82, 7.26}};
ToPol[frame_] :=
Accumulate[ReIm[(Complex @@ #)^2] & /@ Transpose[frame]];
smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;
DynamicModule[{cols = RGBColor /@ {"#f77e5e", "#3dbd5d", "#303030"},
centeredpoints, s},
Manipulate[
s = smootheststep[t];
centeredpoints = # - ConstantArray[Mean[#], Length[#]] &[
RotationTransform[(26 - 44 s) Degree][
Prepend[ToPol[
PlaneGeo[MakePoly[RawAData], MakePoly[RawZData], s]], {0, 0}]]];
Graphics[{Thickness[.008], JoinForm["Round"],
Blend[cols[[;; 2]], s], Line[centeredpoints]},
ImageSize -> {540, 540},
PlotRange -> {{-.26 + .02 s, .29 + .02 s}, {-.28 - .065 s, .32 - .065 s}}, Background -> cols[[-1]]], {t, 0, 1}]
]