Re: FindShortestTour Function- Error
- To: mathgroup at smc.vnet.net
- Subject: [mg123272] Re: FindShortestTour Function- Error
- From: Chrissi87 <c.curtaz at googlemail.com>
- Date: Wed, 30 Nov 2011 03:19:12 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- References: <jaqdu8$nh6$1@smc.vnet.net>
On 26 Nov., 11:10, Dana DeLouis <dan... at me.com> wrote:
> ... 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]]&),Metho d->"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
Thank for all your help!
It helped me a lot!