I know nothing about ImageAlign but thought it'd be fun to imitate what StackReg did in the video in your link.
Here's strategy based on the fact that the central blob will remain approximately circular throughout. Note that I use a bizzarro way to get the initial blob form--this isn't really necessary but is instead a byproduct of thinking that was where a bug in the code was (it wasn't).
The idea here is that we'll replace the blob with a rectangle, compute the rectangle corner points, then recenter and rotate based on this.
So first the image prep code so that we can find the true blob:
rawimg =
Import["http://community.wolfram.com//c/portal/getImageAttachment?filename=ezgif.com-optimize.gif&userId=942204"];
gray = ColorConvert[#, "Grayscale"] & /@ rawimg;
boxImgPreprocess1[img_] :=
DeleteSmallComponents[
Binarize@
Dilation[ImageClip[GradientFilter[img, .05], {.5, .8}, {1, 1}], 2],
20
];
boxImgPreprocess2[img_] :=
DeleteSmallComponents@
Closing[
ColorNegate@img,
25
]
We can see here what that does:
Manipulate[
.5*boxImgPreprocess2@boxImgPreprocess1[gray[[i]]] + gray[[i]] //
ImageResize[#, 350] &,
{i, 1, Length@gray, 1}
]
Then I turn this into an array like so:
boxMeUp[img_] :=
ImageData@boxImgPreprocess2@boxImgPreprocess1[img]
Then we compute the corner points of the bounding box of this. I had two ideas for how to do it, either the loopy way or the Mathematica way:
boxCorners1[boxArray_?MatrixQ] :=
Module[
{
boxDim = Dimensions[boxArray],
xrange, xpos,
xmin = None, xmax = None,
ymin = None, ymax = None
},
xrange = Range[boxDim[[2]]];
xpos = {0, boxDim[[1]] + 1};
Do[
xpos = Pick[xrange, boxArray[[i]], 1];
If[Length@xpos > 0,
If[xmin =!= None,
{xmin, xmax} = MinMax[{{xmin, xmax}, MinMax[xpos]}],
{xmin, xmax} = MinMax[xpos]
];
If[ymin == None, ymin = i],
If[ymin =!= None, ymax = i - 1; Break[]]
],
{i, Length@boxArray}
];
{{xmin, boxDim[[2]] - ymin}, {xmax, boxDim[[2]] - ymax}}
]
boxCorners2[boxArray_?MatrixQ] :=
CoordinateBounds@Position[boxArray, 1]
The former is about an order of magnitude faster than the latter, but they're both pretty fast:
b1 = boxMeUp[gray[2]];
b2 = boxMeUp[gray[[11]]];
boxCorners1 /@ {b1, b2} // RepeatedTiming
{0.0041, {{{166, 339}, {295, 210}}, {{152, 324}, {282, 194}}}}
boxCorners2 /@ {b1, b2} // RepeatedTiming
{0.040, {{{173, 302}, {166, 295}}, {{188, 318}, {152, 282}}}}
Note that boxCorners2 would require some tweaking to work quite right
Now we'll check how this worked:
HighlightImage[gray[[125]],
Mean /@ Transpose@boxCorners1@boxMeUp@gray[[125]]] //
ImageResize[#, 350] &
HighlightImage[gray[[125]], boxCorners1@boxMeUp@gray[[125]]] //
ImageResize[#, 350] &
And it appears to have done fine
Now we turn these corner points into a rotation angle and translation vector suitable for ImageForwardTransformation:
boxAlign[c1_, c2_] :=
Module[
{
midPoints,
areas,
translation,
angle
},
midPoints = Map[Mean]@*Transpose /@ {c1, c2};
areas = Times @@ Subtract @@ Reverse@# & /@ {c2, c1};
translation = Subtract @@ midPoints;
angle = ArcSin[-1. + Max@{Divide @@ areas, 1}];
{angle, translation, midPoints[[1]]}
]
boxTransform[{angle_, translation_, center_}, dim_] :=
Evaluate[
Composition[
RotationTransform[angle, center/dim],
TranslationTransform[translation/dim]
]@{#1, #2}
] & /. {# :> #[[1]], #2 :> #[[2]]}
The trick here is that I assumed the blob would be of constant area, so that if it rotates by θ the ration of the areas will be transformed like 1 + Sin[2 θ] or so. This actually turns out not to matter all that much, but it's nice for matching the video you had. It also only holds like 50% of the time, as usually the blob changes area just via some kind of breathing motion. Would work better for a rigid body.
Finally we stitch this all together into a boxImageAlign function and compute some data for the main reference image:
b1 = boxMeUp[gray[[1]]];
imDim = ImageDimensions[gray[[1]]];
bc1 = boxCorners1@b1;
boxImageAlign[n_Integer?(0 <= # <= Length@gray &)] :=
ImageForwardTransformation[
gray[[n]],
boxTransform[boxAlign[bc1, boxCorners1@boxMeUp@gray[[n]]], imDim]
];
boxImageAlign[n_Integer?(0 <= # <= Length@gray &),
m_Integer?(0 <= # <= Length@gray &)] :=
ImageForwardTransformation[
gray[[n]],
boxTransform[
boxAlign[boxCorners1@boxMeUp@gray[[m]],
boxCorners1@boxMeUp@gray[[n]]], imDim]
];
boxImageCheckAlignment[n_] :=
With[{b1 = boxImageAlign[n], m = 1},
If[ImageQ@b1,
{
{
ImageResize[gray[[m]]*gray[[n]], Scaled[.5]],
ImageResize[gray[[m]] + .5*Image@boxMeUp@gray[[n]],
Scaled[.5]]
},
{
ImageResize[gray[[m]]*b1, Scaled[.5]],
ImageResize[gray[[m]] + .5*Image@boxMeUp@b1, Scaled[.5]]
}
} // ImageAssemble,
$Failed
]
];
boxImageCheckAlignment[n_, m_] :=
With[{b1 = boxImageAlign[n, m]},
If[ImageQ@b1,
{
{
ImageResize[gray[[m]]*gray[[n]], Scaled[.5]],
ImageResize[gray[[m]] + .5*gray[[n]], Scaled[.5]]
},
{
ImageResize[gray[[m]]*b1, Scaled[.5]],
ImageResize[gray[[m]] + .5*Image@boxMeUp@b1, Scaled[.5]]
}
} // ImageAssemble,
$Failed
]
]
Then we check one of the images with maximum misalignment:
boxImageCheckAlignment[75]
And the blobs match much better
If you turn off the rotation it honestly barely changes anything...
Finally here's an animation (not the smoothest, but turning off rotation might help):
