Re: FindShortestTour Function- Error
- To: mathgroup at smc.vnet.net
- Subject: [mg123197] Re: FindShortestTour Function- Error
- From: Dana DeLouis <dana01 at me.com>
- Date: Sat, 26 Nov 2011 05:07:20 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
... tour = nodes[[ordering]]
Thank Bob! I didn't catch the real meaning of -Ordering- on the solution from the help file.
> When I remove 1 and 12, we still don't have a valid tour in the remaining
> nodes:
Hi. Just to add:
What I found interesting was that
Method -> "TwoOpt"
was the only method that found a solution with 2 points removed.
The only solution that I found was the removal of {1,11}
I don't really know why only this method.
Following along with your code...
rules={{1,4}->290,{1,12}->1600,{2,3}->130, ...etc
nodes=Complement[Range@20,{1,11}];
d=SparseArray[rules,{20,20},\[Infinity]];
{len,ordering}=FindShortestTour[nodes,DistanceFunction->(d[[#1,#2]]&),Method->"TwoOpt"]
{7750,{1,2,3,4,5,6,7,8,9,14,15,16,17,18,13,12,11,10}}
tour=nodes[[ordering]]
{2,3,4,5,6,7,8,9,10,16,17,18,19,20,15,14,13,12}
A complete cycle takes us back to the beginning...
cycle = Append[%,First[%]]
{2,3,4,5,6,7,8,9,10,16,17,18,19,20,15,14,13,12,2}
All distances are valid...
Partition[cycle,2,1]/.rules
{130,230,220,170,270,100,120,250,290,250,700,350,500,1000,90,850,280,1950}
%//Total
7750
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]} & ), PlotLabel -> "\n"~~"Path: "~~ToString[cycle]~~
"\n"~~"Length: "~~ToString[len]~~"\n"]
<< Graph showing 1 & 11 not connected >>
I thought this was interesting for a twist on the problem.
Suppose one had only 8000 units of material to connect as many nodes as possible with the data as given.
We know it's not possible to connect them all with the data as given.
We have 250 units of extra material
8000-7750
250
Where can we connect 1 or 11 to on our cycle?
Cases[rules,({x_,y_}->z_)/;Or[x==1,x==11,y==1,y==11] ];
SortBy[%,Last]
{{10,11}->210,{11,10}->210,{11,12}->250,{12,11}->250,{1,4}->290,{4,1}->290,{1,12}->1600,{12,1}->1600}
Connecting 1 to anywhere is not possible (over 250), but we can connect 11 to either 10 or 12.
This is not ideal, but it looks like we can connect 19 points with 8000 units of material if that were the real problem.
Cycle from 12, all the way around back to 12, then over to 11 (and skipping 1)
Join[RotateRight[tour,1],{12,11}]
{12,2,3,4,5,6,7,8,9,10,16,17,18,19,20,15,14,13,12,11}
Total[Partition[%,2,1]/.rules]
8000
= = = = = = = = = = = =
Dana DeLouis
Mac, ver 8
= = = = = = = = = = = =
On Nov 24, 7:01 am, DrMajorBob <btre... at austin.rr.com> wrote:
> Mathematica finds no tour, then BADLY mishandles letting you know it.
> There's no reason to throw error messages, when an infinite path-length
> suffices.
>
> We can get more information by avoiding Infinity:
>
> rules = {{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};
> nodes = Range@20;
> bigEnough = 1 + Total@Abs@rules[[All, -1]]
> d = SparseArray[rules, {20, 20}, bigEnough];
> {len, ordering} =
> FindShortestTour[nodes, DistanceFunction -> (d[[#1, #2]] &)]
> tour = nodes[[ordering]]
> Partition[tour, 2, 1] /. rules
>
> 32281
>
> {70532, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 20, 19,
> 18, 17, 16}}
>
> {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 20, 19, 18, 17, 16}
>
> {{1, 2}, 130, 230, 220, 170, 270, 100, 120, 250, 210, 250, 280, 850, \
> 90, 1000, 500, 350, 700, 250}
>
> Mathematica used the non-existent link from 1 to 2.
>
> There is a legal path 1 -> 12 -> 2, but taking it would not allow a tour
> visiting every node ONCE.
>
> When I remove 1 and 12, we still don't have a valid tour in the remaining
> nodes:
>
> others = Complement[nodes, {1, 12}];
> {len, ordering} =
> FindShortestTour[others, DistanceFunction -> (d[[#1, #2]] &)]
> tour = others[[ordering]]
> Partition[tour, 2, 1] /. rules
>
> {70002, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 18, 17, 16, 15,
> 14}}
>
> {2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15, 20, 19, 18, 17, 16}
>
> {130, 230, 220, 170, 270, 100, 120, 250, 210, {11,
> 13}, 850, 90, 1000, 500, 350, 700, 250}
>
> as we see from use of the nonexistent 11 -> 13 link.
>
> Bottom line: your path matrix is too sparse to allow tours.
>
> Bobby
>
> On Wed, 23 Nov 2011 06:08:49 -0600, 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 examples
> >http://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
>
> --
> DrMajor... at yahoo.com