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