Extending
With some little extra code we can also extend an image:
$HistoryLength = 1;
ClearAll[MinFilter1, MinPosition, Neighbours, FindSeam, EnergyFunction, ComputeEnergyField, Carve, InjectPixel, SeamInject, FillNthPosition, CreateSeamcarveImageData, SeamCarve]
MinFilter1[x_List] := Min /@ Partition[x, 3, 1, {2, 2}, 1.0 10^6] (* same as MinFilter[x,1] but 10x faster *)
MinPosition[x_List] := First[Ordering[x, 1]] (* position of min element *)
Neighbours[n_Integer?Positive, len_Integer?Positive] := Which[n == 1, If[len > 1, {1, 2}, {1}],
n == len, If[len > 1, {len, len - 1}, {1}],
True, {n - 1, n, n + 1}
]
FindSeam[mat_List?MatrixQ] := Module[{dimx, dimy, seam, neighbours, values, newpos, ii},
{dimy, dimx} = Dimensions[mat];
seam = ConstantArray[-1, dimy];
seam[[-1]] = MinPosition[mat[[-1]]];
Do[
neighbours = Neighbours[seam[[ii + 1]], dimx];
values = mat[[ii, neighbours]];
newpos = neighbours[[MinPosition[values]]];
seam[[ii]] = newpos
,
{ii, dimy - 1, 1, -1}
];
seam
]
EnergyFunction[img_Image] := GradientFilter[img, 1, Method -> "ShenCastan"]
ComputeEnergyField[img_Image] := FoldList[#2 + MinFilter1[#1] &, ImageData[EnergyFunction[img]]]
ComputeEnergyField[mat_List] := ComputeEnergyField[Image[mat]]
Carve[mat_List?ArrayQ, seam_List] := MapThread[Delete, {mat, seam}, 1]
FillNthPosition[x_List, n_Integer?Positive, fill_, empty_: 0] := Block[{pos, out},
out = x;
pos = Position[out, empty, {1}, n, Heads -> False];
out[[pos[[n]]]] = fill;
out
]
CreateSeamcarveImageData[img_Image] := Block[{imagedata, dims, dimx, dimy, carveinfo, seam, energyinfo},
imagedata = ImageData[img];
dims = {dimy, dimx} = Dimensions[imagedata, 2];
carveinfo = ConstantArray[0, dims];
PrintTemporary[Dynamic[Row[{"Calculating: ", i, "/", dimx}]]];
Do[
energyinfo = ComputeEnergyField[imagedata];
seam = FindSeam[energyinfo];
carveinfo =
MapThread[FillNthPosition[#1, #2, i, 0] &, {carveinfo, seam}];
imagedata = Carve[imagedata, seam];
,
{i, dimx}
];
{img, carveinfo}
]
SeamCarve[{img_Image, carveinfo_List}, n_Integer?NonNegative] := Block[{imgdata, pick, sel, m},
imgdata = ImageData[img];
If[Dimensions[imgdata, 2] == Dimensions[carveinfo],
m = Clip[n, {0, Length[carveinfo[[1]]] - 1}];
sel = UnitStep[m - carveinfo];
Image[Pick[ImageData[img], sel, 0]]
,
Abort[];
]
]
InjectPixel[lst_List?ArrayQ, index_Integer?Positive] := Module[{len},
len = Length[lst];
If[index == 1,
Prepend[lst, First[lst]]
,
Insert[lst, Mean[lst[[index - 1 ;; index]]], index]
]
]
SeamInject[mat_List?ArrayQ, seam_List] := MapThread[InjectPixel, {mat, seam}]
SeamCarve[{img_Image, carveinfo_List}, n_Integer?NonPositive] := Block[{imgdata, m, ci, seam},
imgdata = ImageData[img];
If[Dimensions[imgdata, 2] == Dimensions[carveinfo],
m = Clip[-n, {0, Length[carveinfo[[1]]] - 1}];
ci = carveinfo;
Do[
seam = Position[ci, i, {2}][[All, 2]];
imgdata = SeamInject[imgdata, seam];
ci = MapThread[Insert[#1, i, #2] &, {ci, seam}];
,
{i, m}
];
Image[imgdata]
,
Abort[];
]
]
Now we can calculate the seams:
img = Import["tower.png"];
AbsoluteTiming[out = CreateSeamcarveImageData[img];]
Manipulate[SeamCarve[out, n], {{n, 0}, -100, 100, 1}]
Note that negative values are much slower to calculate; new data has to be created seam-by-seam. While for removal one can just delete values at once (I used Pick which is very fast). Basically we insert seam where we previously would have deleted them. This works reasonably well for small extensions, but not for large insertions, moreover, it is limited by the original width of the image. So one can extend the image at most the width of the original resulting in an image that has twice the width.
Here is a static comparison:
where the number in front is the number of removed seams (negative meaning injected seams).
Attachments:
