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: Shortest Path Problem