       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