Re: Shortest Path Problem

*To*: mathgroup at smc.vnet.net*Subject*: [mg96609] Re: Shortest Path Problem*From*: DeLouis Dana <dana.del at gmail.com>*Date*: Tue, 17 Feb 2009 06:25:36 -0500 (EST)

Hi. Here's another variation that is similar to the op's solution that uses the "Nearest" function to find other points that are within Sqrt[2] away. (Rounded to 1.5 to make it a real number) {* All one entry *) Needs["Combinatorica`"] n = 10; Rng = Range[n*n]; grid = RandomInteger[{1, 6}, {n*n}]; pairs = Tuples[Range@n, 2]; Near = Map[Rest[Nearest[pairs -> Automatic, #, {\[Infinity], 1.5}]] &, pairs]; m = Table[ p = Complement[Rng, Near[[j]]]; p = List /@ p; ReplacePart[grid, p -> \[Infinity]], {j, 1, n*n}]; sp = ShortestPath[g = FromAdjacencyMatrix[m, EdgeWeight], 1, n*n]; Print["Distance: ", CostOfPath[g, sp]]; MyGrid = Partition[grid, n]; MatrixPlot[MyGrid, Epilog -> {Thick, Line[{n - Mod[sp, n, 1] + 0.5, Quotient[sp - Mod[sp, n, 1], n] + 0.5}\[Transpose]]}, ColorRules -> {1 -> Red, 2 -> Orange, 3 -> Green, 4 -> Blue, 5 -> Magenta, 6 -> Purple}] (* End of Entry *) (* I like the Grid Graph *) gg = GridGraph[n, n]; pth = Partition[sp, 2, 1]; gg = AddEdges[gg, pth]; ShowGraph[Highlight[gg, {pth}, HighlightedEdgeColors -> Red], VertexNumber -> True, VertexNumberColor -> Blue, EdgeStyle -> Thin, ImageSize -> 800] (* Some other ideas: I moved the axes around a little to match...*) ToLines[n_, b_] := {Mod[n, b, 1] - .5, Quotient[n, b, 1] + .5} MyLine = Line[Map[ToLines[#, n] &, sp]]; MatrixPlot[MyGrid, DataReversed -> {True, False}, Epilog -> { Circle[MyLine[[1, 1]], .3], Thick, MyLine, Disk[MyLine[[1, -1]], .1]}, ImageSize -> 800, ColorFunction -> ColorData["LightTemperatureMap"]] = = = = HTH Dana DeLouis Using Ver 7 for Mac Antonio wrote: > Dear Mathematica Users, > > I am not familiar with Graph theory and hope that some Mathematica > users might help me. I am having a Shortest path problem that I hope > to solve using Mathematica. > > My input is a Grid defind as, > > MyGrid = Table[RandomInteger[{1, 5}], {i, 1, 10}, {j, 1, 10}] > > in this 10x10 grid i'd like the shortest path from point A, let's say > MyGrid[[10, 10]] to point B MyGrid[[1, 1]]. For every point inside > this square grid I have 8 possible directions or lines > (up,down,left,right and the 4 diagonals). The weight of each step is > given inside the MyGrid cell, i.e. let MyGrid[[2, 3]]=1 and MyGrid[[2, > 4]]=3 > So in going from coordinate (2,3) to (2,4) it takes 3 times as long as > if going from (2,4) to (2,3). So all directions are possible but they > are asymetrical in the sense that they have diferent weights if going > foward or backward. > > I tried reading Mathematica help but it is very poor with no examples. > All I know is that I have to use the Combinatorica package and the > ShortestPath[] command, but as a start I have no idea in how to create > a Graph needed as input to this command from MyGrid. > > Thanks in advanced. >