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!