# How to accelerate my code?

Given a 2D $M \times N$ matrix with non-negative values, I would like to find a path going from top to bottom such that the sum of the path is minimum. My function is defined as follow:

findSeam[e_List] := Module[{f, t, p, i, j, k, nrows, ncols},

{nrows, ncols} = Dimensions[e];
f = Table[0, {i, nrows}, {j, ncols}];
t = Table[0, {i, nrows}, {j, ncols}];

For [j = 1, j <= ncols, j++,
f[[1, j]] = e[[1, j]];
t[[1, j]] = 0;
];

For [i = 2, i <= nrows, i++,
For [j = 1, j <= ncols, j++,
If [j == 1, k = j, k = j - 1];

If [f[[i-1, j]] < f[[i-1, k]], k = j];
If [j < ncols && f[[i-1, j+1]] < f[[i-1, k]], k = j + 1];

f[[i, j]] = e[[i, j]] + f[[i-1, k]];
t[[i, j]] = k - j;
];
];

p = Table[1, {i, nrows}];
For [j = 2, j <= ncols, j++,
i = p[[-1]];
If [f[[nrows, i]] > f[[nrows, j]],
p[[-1]] = j;
];
];
For [i = nrows - 1, i >= 1, i--,
j = p[[i+1]];
p[[i]] = j + t[[i+1, j]];
];

p
];


The computation complexity is only $O(MN)$. However, when I apply this function to a $900 \times 600$ matrix, it takes about 6 seconds to finish the computation.

Is my coding style wrong? Can my code be optimized such that it runs more quickly? Thank you.

• This reminds me of Problem #81 of project euler. If you code in this style, why not use C/C++? Besides, try compiling your program. I think both the ways can boost its speed. Mar 22, 2015 at 14:16
• Welcome to Mathematica.SE! I suggest that: 1) You take the introductory Tour now! 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. Mar 22, 2015 at 14:19
• – xyz
Mar 22, 2015 at 14:31
• Can you supply us with either your list for e or a function to generate the list so we can replicate your results and use them as a baseline? Mar 22, 2015 at 16:57
• My function to generate e is e = Norm[#]& /@ #& /@ ImageData@ImageConvolve[img, {{1,1,1},{1,-8,1},{1,1,1}}], where img is a 900x600 image. Mar 23, 2015 at 1:48

Here's my functional variant of your code:

findSeam2[e_List] :=
Module[{f = FoldList[MinFilter[#1, 1] + #2 &, First[e], Rest[e]]},
Reverse@
FoldList[#1 +
First@Ordering[#2[[Max[1, #1 - 1] ;;
Min[Length[#2], #1 + 1]]]] - 1 - If[#1 == 1, 0, 1] &,
First@Ordering[Last[f], 1], Reverse@Most[f]]];


And my test case (inspired by seam carving).

img = ExampleData[{"TestImage", "Lena"}];
AbsoluteTiming[seam = findSeam[data];]
Show[img, Graphics[{Red, Line[Flatten /@ MapIndexed[List, seam]]}]]
AbsoluteTiming[TimeConstrained[seam2 = findSeam2[data];, 5]]
Show[img, Graphics[{Blue, Line[Flatten /@ MapIndexed[List, seam2]]}]]
seam == seam2


On my computer the timings are 2.4 and 0.07 seconds, respectively.

Note that by Compileing your function, the timing is even better:

findSeam3 =
Compile[{{e, _Real, 2}},
Module[ ...
f = Table[0., {i, nrows}, {j, ncols}];
...
], CompilationTarget -> "C", RuntimeOptions -> "Speed"]


I only changed the initializer for f to use 0., so that the compiler is expecting floating-point values. The timing for this test case is only 0.01 seconds!

• That's nice. +1
– ciao
Mar 22, 2015 at 18:41
• If anyone knows of a better way to write #2[[Max[1, #1 - 1] ;; Min[Length[#2], #1 + 1]]], let me know... I sometimes wish there was a function like Take or Part that automatically truncated out-of-range numbers. Mar 22, 2015 at 18:50
• Thank you. I think I need to learn "Compile" first. Mar 23, 2015 at 1:41
• Sometimes it is not easy to write code using functions like Apply, Map and Thread. In this case, is "Compile" the only way to accelerate the speed? Mar 23, 2015 at 1:45
• @2012rcampion it isn't shorter, but there's Clip, e.g. Span @@ Clip[{#1 - 1, #1 + 1}, {1, Length@#2}], which reads a bit cleaner. Mar 23, 2015 at 12:42