Re: Re: Shortest Path Problem

*To*: mathgroup at smc.vnet.net*Subject*: [mg96585] Re: [mg96554] Re: Shortest Path Problem*From*: DrMajorBob <btreat1 at austin.rr.com>*Date*: Mon, 16 Feb 2009 16:40:36 -0500 (EST)*References*: <gn622n$iet$1@smc.vnet.net> <200902161157.GAA03525@smc.vnet.net>*Reply-to*: drmajorbob at longhorns.com

Many things can be done to optimize speed and memory. For instance, compare Timing[PossiblePositions = Tuples[Range[n], 2]; NearestNeighbours = Table[Intersection[{{i - 1, j - 1}, {i - 1, j}, {i - 1, j + 1}, {i, j - 1}, {i, j + 1}, {i + 1, j - 1}, {i + 1, j}, {i + 1, j + 1}}, PossiblePositions], {i, n}, {j, n}];] {0.786135, Null} with Timing[nearest = DeleteCases[ Table[{{i - 1, j - 1}, {i - 1, j}, {i - 1, j + 1}, {i, j - 1}, {i, j + 1}, {i + 1, j - 1}, {i + 1, j}, {i + 1, j + 1}}, {i, n}, {j, n}], {0, _} | {_, 0} | {51, _} | {_, 51}, Infinity];] {0.033157, Null} nearest == NearestNeighbours True (Big difference in Timing, don't you think?) On the memory side of things, these matrices are probably unnecessary: NodesPosition, PossiblePositions, and WeightPositions. Too much of BuildWeightMatrix consists of infinite-weighted arcs: Count[BuildWeightMatrix, Infinity, {2}] 6230596 The major bottleneck you mentioned is in creating, then eliminating, those arcs... more than 6 million of them. If n=250, not 50, I suppose you'd have about THIS many: 50*50*% 15576490000 Using EdgeWeight in FromAdjacencyMatrix confirms my earlier suspicion that MyGrid lists arcs, NOT nodes. If you really want to reach n=250, explain the problem to me. I solved MUCH larger shortest-path problems for my dissertation, more than 20 years ago... when computers were SLOW. Bobby On Mon, 16 Feb 2009 05:57:53 -0600, Antonio <aneves at gmail.com> wrote: > Thank you all, I finally understood and got the problem done. Here is > the code I used, > > << Combinatorica` > n = 50; > (* Define my nxn Random Map *) > MyGrid = Table[RandomInteger[{1, 6}], {i, 1, n}, {j, 1, n}]; > (* Number of points on the map corrsponds to the number of nodes *) > Nodes = Flatten[MyGrid]; > NodesPosition = Range[Length[Nodes]]; > PossiblePossitions = Tuples[Range[n], 2]; > NearestNeighbours = > Table[Intersection[{{i - 1, j - 1}, {i - 1, j}, {i - 1, j + 1}, {i, > j - 1}, {i, j + 1}, {i + 1, j - 1}, {i + 1, j}, {i + 1, j + 1}}, > PossiblePossitions], {i, n}, {j, n}]; > WeightValues = > Flatten[Apply[MyGrid[[#1, #2]] &, NearestNeighbours, {3}], 1]; > WeightPositions = > Flatten[Apply[n*(#1 - 1) + #2 &, NearestNeighbours, {3}], 1]; > BuildWeightMatrix = > Table[If[MemberQ[WeightPositions[[i]], j], > WeightValues[[i, > Position[WeightPositions[[i]], j][[1, 1]]]], \[Infinity]], {i, > n^2}, {j, n^2}]; > sp = ShortestPath[FromAdjacencyMatrix[BuildWeightMatrix, EdgeWeight], > 1, n^2]; > MatrixForm[MyGrid] > (*MatrixForm[BuildWeightMatrix*) > sp > Print["Movement cost is ", Total[Flatten[MyGrid][[Drop[sp, 1]]]]] > 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, 2 -> Yellow, 3 -> Green, > 4 -> Blue, 5 -> Magenta, 6 -> Purple}] > > Some of the code proposed crashed the kernel and in this one the > bottle neck is in the IF conditional inside the table > (BuildWeightMatrix) and the ShortestPath command. This here is for > n=50, and actually I would like to solve something bigger like n=250. > So if you guys can make the code more efficient, please let me know. > > Regards, > Antonio > > > > > On 14 Feb, 10:15, DeLouis Dana <dana.... at gmail.com> wrote: >> > (up,down,left,right and the 4 diagonals) >> >> > So all directions are possible but they >> > are asymetrical in the sense that they have diferent weights if goin= > g >> > foward or backward. >> > All I know is that I have to use the Combinatorica package >> >> Hi. Here are some commands you may find helpful. >> This is not complete because the diagonals are not complete. >> I'm not sure what an efficient method for the diagonals would be just >> yet. >> I'm using Mathematica ver 7. >> >> Because the diagonals are not complete, I made it a simple graph by >> removing the double path (combined path 2-3, and 3-2) >> >> This is just a 5 * 5 grid. >> Hopefully, this will give you some ideas to work with. >> >> Needs["Combinatorica`"] >> >> n = 5; >> g = GridGraph[n, n]; >> g = SetEdgeWeights[g, RandomInteger[{1, 5}, M[g]]]; >> >> diag = Table[ >> s = (r - 1)*n + c; >> {{s, s + n + 1}, {s, s + n - 1}, {s, s - n + 1}, {s, >> s - n - 1}}, {r, 2, n - 1}, {c, 2, n - 1}]; >> >> diag = Flatten[diag, 2] // Sort; >> >> g = AddEdges[g, diag]; >> >> g = SetEdgeWeights[g, diag, RandomInteger[{1, 5}, Length[diag]]]; >> >> g = MakeSimple[g]; >> >> pth = Partition[ShortestPath[g, 1, n*n], 2, 1]; >> >> g = SetEdgeLabels[g, GetEdgeWeights[g]]; >> >> ShowGraph[ >> Highlight[g, {pth}, >> HighlightedEdgeColors -> Red], >> VertexNumber -> True, >> VertexNumberColor -> Blue] >> >> = = = >> HTH >> Dana DeLouis >> >> 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 sa= > y >> > 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 the= > y >> > are asymetrical in the sense that they have diferent weights if goin= > g >> > 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. >> > > > -- DrMajorBob at longhorns.com

**References**:**Re: Shortest Path Problem***From:*Antonio <aneves@gmail.com>

**Re: Length of a held expression**

**Re: Howto change TraditionalForm Output**

**Re: Shortest Path Problem**

**Re: Shortest Path Problem**