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: [mg96541] Re: Shortest Path Problem
  • From: Dana DeLouis <dana01 at me.com>
  • Date: Mon, 16 Feb 2009 06:55:29 -0500 (EST)

 > My input is a Grid

If I understand your question, here is one solution of many using  
Combinatorica.
Note that there are many unit values on the grid, so the solution will  
be 'almost' a line from start to finish.
I do not remember how to change the double arrows to a simple line, or  
perhaps just make the arrow heads smaller.
I'm using Mathematica 7.
Hopefully, if you want to go this route, this will give you some ideas.

Needs["Combinatorica`"]

Note:  A function that, if given from a to b, then make (a to b), and  
(b to a), and assign a weight of 1 in one direction, and a random  
value between 1 and 5 in the other direction.

fx[{a_, b_}] := Module[{edgs, wts},
   edgs = {{a, b}, {b, a}};
   wts = RandomSample[{1, RandomInteger[{1, 5}]}];
   g = SetEdgeWeights[g, edgs, wts];
   ]

n = 10;

g = GridGraph[n, n]

(* Note from output that it's a graph with 180 Edges, and 100 Vertices  
*)

ShowGraph[g, VertexNumber -> True]

grid = Edges[g] // Sort;

Note:  Make Diagonals

d1 = Flatten[
    Do[If[Mod[j, n, 1] != n, Sow[{j, j + n + 1}]], {j, 1, n*n - n -  
1}] //
      Reap // Rest, 2];

d2 = Flatten[
    Do[If[Mod[j, n, 1] != 1, Sow[{j, j + n - 1}]], {j, 2, n*n - n}] //  
Reap //
     Rest, 2];

diag = Union[d1, d2];

g = AddEdges[g, diag]

(* now 342 Edges *)

ShowGraph[g, VertexNumber -> True]

g = MakeDirected[g]

(* Doubled the edges to 684 *)

ShowGraph[g, VertexNumber -> True]

Map[fx, grid];

Map[fx, diag];

Note:  ts is an abbreviation for Traveling-Salesman Path

pth = Partition[ts = ShortestPath[g, 1, n*n], 2, 1];

ShowGraph[
  Highlight[g, {pth},
   HighlightedEdgeColors -> Red],
  VertexNumber -> True,
  VertexNumberColor -> Blue,
  EdgeStyle -> Thin,
  ImageSize -> 800]

Here is the path:  1 to 12, then 12 to 22, etc...

pth

{{1, 12}, {12, 22}, {22, 23}, {23, 34}, {34, 45}, {45, 46}, {46, 56},  
{56,
   67}, {67, 78}, {78, 79}, {79, 90}, {90, 100}}

Or used in the distance function...

ts

{1, 12, 22, 23, 34, 45, 46, 56, 67, 78, 79, 90, 100}

Total Distance ...

CostOfPath[g, ts]

13


Note:  A listing of all edges and weights:

Transpose[{Edges[g], GetEdgeWeights[g]}] // Sort // MatrixForm;

An interesting change would be to make random values in both direction  
instead of one being the value '1

fx[{a_, b_}] := Module[{edgs, wts},
   edgs = {{a, b}, {b, a}};
   wts = {RandomInteger[{1, 5}], RandomInteger[{1, 5}]};
   g = SetEdgeWeights[g, edgs, wts];
   ]


= = = =
Anyway, Hope this helps...
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 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.
 > 


  • Prev by Date: Re: newbie here,, need help with parametrics
  • Next by Date: Re: New free introductory book on Mathematica programming,
  • Previous by thread: Re: Shortest Path Problem
  • Next by thread: Re: Shortest Path Problem