# 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. – vapor Mar 22 '15 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. – bbgodfrey Mar 22 '15 at 14:19
• – xyz Mar 22 '15 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? – Jagra Mar 22 '15 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. – Purboo Mar 23 '15 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 '15 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. – 2012rcampion Mar 22 '15 at 18:50
• Thank you. I think I need to learn "Compile" first. – Purboo Mar 23 '15 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? – Purboo Mar 23 '15 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. – rcollyer Mar 23 '15 at 12:42