How to accelerate my code?

Question

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.

Answer 1

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"}];
data = ImageData[GradientFilter[img, 1]];
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!