3
$\begingroup$

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.

$\endgroup$
8
  • $\begingroup$ 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. $\endgroup$
    – vapor
    Mar 22, 2015 at 14:16
  • $\begingroup$ 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. $\endgroup$
    – bbgodfrey
    Mar 22, 2015 at 14:19
  • $\begingroup$ See Functional Paradigm $\endgroup$
    – xyz
    Mar 22, 2015 at 14:31
  • $\begingroup$ 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? $\endgroup$
    – Jagra
    Mar 22, 2015 at 16:57
  • $\begingroup$ 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. $\endgroup$
    – Purboo
    Mar 23, 2015 at 1:48

1 Answer 1

10
$\begingroup$

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

enter image description here

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!

$\endgroup$
12
  • $\begingroup$ That's nice. +1 $\endgroup$
    – ciao
    Mar 22, 2015 at 18:41
  • $\begingroup$ 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. $\endgroup$ Mar 22, 2015 at 18:50
  • $\begingroup$ Thank you. I think I need to learn "Compile" first. $\endgroup$
    – Purboo
    Mar 23, 2015 at 1:41
  • $\begingroup$ 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? $\endgroup$
    – Purboo
    Mar 23, 2015 at 1:45
  • 1
    $\begingroup$ @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. $\endgroup$
    – rcollyer
    Mar 23, 2015 at 12:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.