Better performance for shortest path in an Image

Question

I would like to find the shortest path in an image from one pixel to another. If the image is grayscale, the distance between two pixels could be Abs[p1 - p2], otherwise for multichannel images it could be EuclideanDistance / ManhattanDistance or whatever. For example, here's the shortest path from {1,1} to {32,32} in an RGB image using the ManhattanDistance between pixel colours:

$\rightarrow$

My first attempt is abysmally slow. It uses a temporary GridGraph to construct a 4-connected grid (8-connected is also desired in future!) and extracts the edge pairs. It then builds a second GridGraph of identical size from these edges but fills in the edge weights. I had to do this because I couldn't find how to update graph weights on an existing graph in Mathematica. Finally it calls FindShortestPath on this graph and the rest is just turning the path vertices back into row-column coordinates so I can highlight the pixels in the image. It's a lot of work to do something that could be simpler.

vtx2rc[id_, rows_] := Module[{r = 1 + Mod[(id - 1), rows]}, {r, (id - r)/rows + 1}]
weightfn[dat_, v1_, v2_] := ManhattanDistance[
 Extract[dat, vtx2rc[v1, Length@dat]],
 Extract[dat, vtx2rc[v2, Length@dat]]
]
makegr[dat_, dims_] := Module[{rows = dims[[1]], gr = GridGraph[dims]},
  Return[GridGraph[dims, 
    EdgeWeight -> ((# -> weightfn[dat, #[[1]], #[[2]]]) & /@ 
       EdgeList[gr])]]
  ]
rc2node[rc_, rows_] := (rc[[2]] - 1)*rows + rc[[1]]
genpath[gr_, rows_, p1_, p2_] := 
 vtx2rc[#, rows] & /@ 
  FindShortestPath[gr, rc2node[p1, rows], rc2node[p2, rows]]
makemask[path_, dims_] := Module[{c = ConstantArray[0, dims]},
  For[i = 1, i <= Length[path], ++i,
   c[[path[[i, 1]], path[[i, 2]]]] = 1;
   ];
  Return[Image[c] // ImageAdjust]
]

Usage looks like this:

img = img = ImageResize[<<<your image here>>>,64]
dat = ImageData[img];
dims = Most@Dimensions@dat;
gr = makegr[dat, dims];
startpoint = {1, 1};
endpoint = Reverse@ImageDimensions@img;
Show[ImageAdd[img,
  makemask[genpath[gr, dims[[1]], startpoint, endpoint], dims]]]

For images size > 128 it's too slow and I really need it closer to realtime. Ideally I want something fast enough that I can have two Locator points in a manipulate and draw the path over the image on the fly.

I'm fine with suboptimal short paths if they're quick to find on large images in under 2s.

Answer 1

The problem appears to be that constructing a weighted graph using this syntax:

EdgeWeight -> ((# -> weightfn[dat, #[[1]], #[[2]]]) & /@ 
       EdgeList[gr])]]

is incredibly slow. If I replace it with the following:

EdgeWeight -> ((weightfn[dat, #[[1]], #[[2]]]) & /@ EdgeList[gr])

it brings the total computation time down from 21.7 seconds to 0.436 seconds, using a 128x128 image. The same graph will be constructed regardless of which syntax you choose.