Re: FindShortestTour Function- Error
- To: mathgroup at smc.vnet.net
- Subject: [mg123140] Re: FindShortestTour Function- Error
- From: Dana DeLouis <dana01 at me.com>
- Date: Thu, 24 Nov 2011 06:58:00 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
Hi. I get the error Infinity::indet with my Version 8 for Mac.
I believe this is caused by the problem having no feasible solution.
data = << your data points here >>
d=SparseArray[data,{20,20} ,\[Infinity]]
{len,tour}=FindShortestTour[Range[20],DistanceFunction-> (d[[#1,#2]]&)]
Infinity::indet:
{\[Infinity],{1,4,5,6,7,8,9,10,11,12,13,14,15,20,19,18,17,16,3,2}}
The distance is Infinity with the given path.
Here are the paths...
Partition[tour,2,1]
{{1,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},
{15,20},{20,19},{19,18},{18,17},{17,16},{16,3},{3,2}}
Here are the lengths:
%/.data
{290,220,170,270,100,120,250,210,250,280,850,90,1000,500,350,700,250,{16,3},130}
Hmmm. Notice the {16,3}.
This was the best it could come up with. However, there is no distance associated with the path from 16 to 3.
Therefore, It's an unfeasible solution.
The best it came up with is 6,030, but it doesn't know the distance from 16 back to 3.
Cases[%,_Integer] //Total
6030
If you jump ahead, you will also notice there is no distance given from 2 back to the starting point of 1.
= = = = =
Let's give a distance of 1 to the gap between 3 & 16 so as not to change our solution:
data=Join[data, {{16,3}->1,{3,16}->1}];
d=SparseArray[data,{20,20} ,\[Infinity]]
{len,tour}=FindShortestTour[Range[20],DistanceFunction-> (d[[#1,#2]]&)] //Quiet
{\[Infinity],{1,4,5,6,7,8,9,10,11,12,13,14,15,20,19,18,17,16,3,2}}
Partition[tour,2,1]/.data
{290,220,170,270,100,120,250,210,250,280,850,90,1000,500,350,700,250,1,130}
Cases[%,_Integer] //Total
6031
We increased the solution by 1 to 6031.
We still have infinity for a distance because there is no distance given between the points 1 & 2, or 2 &1.
Here's the gap between 1 & 2 :
GraphPlot[d, VertexLabeling -> True,
EdgeRenderingFunction -> ({If[
MemberQ[Thread[{tour, RotateLeft[tour]}], #2 | Reverse[#2]],
Red, Yellow], Line[#1], Black,
Text[d[[#2[[1]], #2[[2]]]], Mean[#1], Background -> White]} &)]
Here's a slight variation to your first example that works.
Maybe you can find it useful.
You are working with a Symmetric matrix, so perhaps:
MakeSymmetric[data_]:=Module[{sym,x,y,z},
sym[{x_,y_}->z_]:={{x,y}->z,{y,x}->z};
Sort[Flatten[sym/@data,1]]
]
Let's just work with half of the 20 data points.
Only work with x & y in which x < y.
The function will make sure the other half are equal.
t={{1,2}->1,{1,4}->1,{1,5}->1,{1,6}->1,{2,3}->10,
{2,5}->1,{2,6}->1,{3,4}->1,{3,5}->1,{4,5}->15};
d=SparseArray[MakeSymmetric[t],{6,6},Infinity]
{len,tour}=FindShortestTour[Range[6],DistanceFunction-> (d[[#1,#2]]&)]
{6,{1,4,3,5,2,6}}
Same as yours: Result: {6, {1, 4, 3, 5, 2, 6}}
For your project, you may be interested in the function TravelingSalesman.
Needs["Combinatorica`"]
Here's your first example, with x, or 0 taking on the value Infinity.
The advantage here, if you need it, is that you can have different values in each direction.
m={
{x,1,0,1,1,1},
{1,x,10,0,1,1},
{0,10,x,1,1,0},
{1,0,1,x,15,0},
{1,1,1,15,x,0},
{1,1,0,0,0,x}
} /. {x|0->\[Infinity]};
m//MatrixForm
g=FromAdjacencyMatrix[m,EdgeWeight,Type->Directed]
ts=TravelingSalesman[g]
{1,4,3,5,2,6,1}
CostOfPath[g,ts]
6
ShowGraph[Highlight[g,{Partition[ts,2,1]},
HighlightedEdgeColors->{Red}],
VertexLabel->True,
EdgeLabel->GetEdgeWeights[g],
PlotLabel->"\n"~~"Path: " ~~ToString[ts]~~"\n"]
< graph here>
Here's a slight advantage of using this:
On the path from 5 to 2, perhaps there is now construction along this route, but not from 2 to 5.
We can give it a penalty of say 20. (Infinity if road closed in this direction)
m={
{x,1,0,1,1,1},
{1,x,10,0,1,1},
{0,10,x,1,1,0},
{1,0,1,x,15,0},
{1,20,1,15,x,0},
{1,1,0,0,0,x}
}/.{x|0->\[Infinity]};
g=FromAdjacencyMatrix[m,EdgeWeight,Type->Directed]
ts=TravelingSalesman[g]
{1,6,2,5,3,4,1}
CostOfPath[g,ts]
6
ShowGraph[Highlight[g,{Partition[ts,2,1]},HighlightedEdgeColors->{Red}],
VertexLabel->True,
EdgeLabel->GetEdgeWeights[g],
PlotLabel->"\n"~~"Path: " ~~ToString[ts]~~"\n"]
<graph here>
We take the road from 2 to 5 instead because of the construction penalty along the route from 5 to 2.
Setting Infinity will close that direction of travel.
Penalties can be given in a direction due to Construction, Traffic, Uphill vs Downhill, Toll road in 1 direction, etc...
= = = = = = = = = = = = = =
HTH :>)
Good Luck on the Thesis.
Dana DeLouis
Mac, Ver #8
= = = = = = = = = = = = = =
On Nov 23, 7:16 am, Chrissi87 <c.cur... at googlemail.com> wrote:
> Dear readers,
> I am writing my master thesis about the routing of winter gritting
> systems. My problem is a traveling salesman problem and I want to use
> the function:
> "FindShortestTour" in mathematika.
> Under this link one can find a lot of exampleshttp://reference.wolfram.com/mathematica/ref/FindShortestTour.html,
> but for my problem there is only one example and it does not work. My
> problem is that my matrix has no euclidian distances, because a
> street network can not be euclidian, since a street is never the
> direct distance between two points. For this I made a matrix,
> measuring the real distances of the streets between the several knots.
> And of course there is not a conection between all knots.
> So I changed the one example one can find under the link in my
> problem.
>
> This is the example out of the link:
>
> d = SparseArray[{{1, 2} -> 1, {2, 1} -> 1, {6, 1} -> 1, {6, 2} -> 1,
> {5, 1} -> 1, {1, 5} -> 1, {2, 6} -> 1, {2, 3} -> 10, {3, 2} ->
> 10, {3, 5} -> 1, {5, 3} -> 1, {3, 4} -> 1, {4, 3} -> 1, {4, 5} -> 15, {4, 1} -> 1, {5, 4} -> 15, {5, 2} ->
>
> 1, {1, 4} -> 1, {2, 5} -> 1, {1, 6} -> 1}, {6, 6}, Infinity];
>
> {len, tour} = FindShortestTour[{1, 2, 3, 4, 5, 6}, DistanceFunction -> (d[[#1, #2]] &)]
>
> Result: {6, {1, 4, 3, 5, 2, 6}}
>
> Mine looks as follows:
>
> d = SparseArray[{{1, 4} -> 290, {1, 12} -> 1600, {2, 3 } -> 130, {2,
> 12} -> 1950, {3, 2} -> 130, {3, 4} -> 230, {3, 18} -> 1720, {4, 1} ->
> 290, {4, 3} -> 230, {4, 5} -> 220, {4, 18} -> 1490,
> {5, 4} -> 220, {5, 6} -> 170, {6, 5} -> 170, {6, 7} -> 270, {6, 18} ->
> 1100, {7, 6} -> 270, {7, 8} -> 100, {7, 17} -> 250, {8, 7} -> 100, {8,
> 9} -> 120, {8, 16} -> 450, {9, 8} -> 120, {9, 10} -> 250, {10, 9} ->
> 250, {10, 11} -> 210, {10, 15} -> 280, {10,
> 16} -> 290, {10, 20} -> 750, {11, 10} -> 210, {11, 12} -> 250, {12, 1}
> -> 1600, {12, 2} -> 1950, {12, 11} -> 250, {12, 13} -> 280, {13, 12} -> 280, {13, 14} -> 850, {14, 13} -> 850, {14, 15} -> 90, {15, 10} ->
>
> 280, {15, 14} -> 90, {15, 20} -> 1000, {16, 8} -> 450, {16, 10} ->
> 290, {16, 17} -> 250, {17, 7} -> 250, {17, 16} -> 250, {17, 18} ->
> 700, {18, 3} -> 1720, {18, 4} -> 1490, {18, 6} -> 1100, {18, 17} ->
> 700, {18, 19} -> 350, {19, 18} -> 350, {19,
> 20} -> 500, {20, 10} -> 750, {20, 15} -> 1000, {20, 19} -> 500}, {20,
> 20} Infinity ];
>
> {len, tour} = FindShortestTour[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
> 13, 14, 15, 16, 17, 18, 19, 20}, DistanceFunction -> (d[[#1, #2]] &)]
>
> Then the Error comes and says:
>
> FindShortestTour::dist: The distance function d[[#1,#2]]& does not
> give a numerical result when applied to two points. >>
> Set::shape: Lists {len,tour} and
> FindShortestTour[{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20},Dista nceFunction-
>
> >(d[[#1,#2]]&)] are not the same shape. >>
>
> I just do not know what it means and where my mistake ist. I just
> bought this program some weeks ago, so the synatax is hart for me.
> I would really appreciate it if somebody could help me. Thanks!
>
> Chrissi