Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: "Traveling salesman on a hemisphere" problem

  • To: mathgroup at smc.vnet.net
  • Subject: [mg121474] Re: "Traveling salesman on a hemisphere" problem
  • From: Olaf <olaf.rogalsky at googlemail.com>
  • Date: Fri, 16 Sep 2011 05:49:03 -0400 (EDT)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com
  • References: <j4see5$sp4$1@smc.vnet.net>

Hi Peter,

with the arclen from http://en.wikipedia.org/wiki/Great-circle_distance,
the following code will give you the shortest route.

stars = {
   {"M51", {21, 44.7}},
   {"NGC2721", {4, -17}},
   {"a funny comet", {57.3, 7}},
   {"absolutely must see", {23, -176.3}}};

arclen[{_, {F1_, L1_}}, {_, {F2_, L2_}}] :=
 Module[{f1 = F1 Degree, l1 = L1 Degree, f2 = F2 Degree, l2 = L2
Degree, dl = (L1 - L2) Degree},
  ArcTan[Sin[f1] Sin[f2] + Cos[f1] Cos[f2] Cos[dl],
             Sqrt[(Cos[f2] Sin[dl])^2 + (Cos[f1] Sin[f2] - Sin[f1]
Cos[f2] Cos[dl])^2]]]

tour = FindShortestTour[stars, DistanceFunction -> arclen]

sortedStars = starlist[[tour[[2]]]]


And here some eye-candy:


p2c[{_, {f_, l_}}] := {Cos[f Degree] Cos[l Degree],
  Sin[f Degree] Cos[l Degree], Sin[l Degree]}
greatCircleArc[{q_, p_}] :=
 Module[{u = p2c[q], v = p2c[p], a}, a = VectorAngle[u, v];
  Table[Evaluate[RotationTransform[t, {u, v}][u]], {t, 0, a,
    a/Ceiling[10 a]}]]

Graphics3D[
 {Sphere[{0, 0, 0}, 0.97],
  {Black, Thick, Arrow[{{0, 0, -1.3}, {0, 0, 1.3}}]},
  {Red, PointSize[Medium], Point[Map[p2c, sortedStars]]},
  {Blue, Thick,
   Map[Line, Map[greatCircleArc, Partition[sortedStars, 2, 1]]]}
  }, SphericalRegion -> True]

Regards, Olaf




  • Prev by Date: Re: Defining the labels to display in ContourLabels
  • Next by Date: Re: Changing Style Sheets in 8.0
  • Previous by thread: "Traveling salesman on a hemisphere" problem
  • Next by thread: Re: "Traveling salesman on a hemisphere" problem