Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Shortest Path Problem

  • To: mathgroup at smc.vnet.net
  • Subject: [mg96554] Re: Shortest Path Problem
  • From: Antonio <aneves at gmail.com>
  • Date: Mon, 16 Feb 2009 06:57:53 -0500 (EST)
  • References: <gn622n$iet$1@smc.vnet.net>

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.
>  >



  • Prev by Date: Re: Re: Functions inside modules with external definitions
  • Next by Date: Re: optimization
  • Previous by thread: Re: Shortest Path Problem
  • Next by thread: Re: Re: Shortest Path Problem