Re: "Traveling salesman on a hemisphere" problem
- To: mathgroup at smc.vnet.net
- Subject: [mg121569] Re: "Traveling salesman on a hemisphere" problem
- From: Dana DeLouis <dana01 at me.com>
- Date: Tue, 20 Sep 2011 06:09:19 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
Hi. Don't know if this could be of help.
In Version #8, I don't know of a way to customize the datum's used in the Geodesy section.
The old version has a package to manipulate Datums.
Needs["Miscellaneous`Geodesy`"]//Quiet;
ArcLen2[{_,Pt1_List},{_,Pt2_List}]:=SphericalDistance[Pt1,Pt2,Radius->1]
(* Yours *)
arclen[{"M51",{21,44.7`}},{"Comet",{57.3,7}}]
0.7945159
(* From Above *)
ArcLen2[{"M51",{21,44.7}},{"Comet",{57.3,7}}]
0.7945159
If one wanted to be close, but not highly accurate, here's an approximate way in Ver 8.
ArcLen3[{_,Pt1_List},{_,Pt2_List}]:= GeoDistance[Pt1,Pt2]/6367449
ArcLen3[{"M51",{21,44.7}},{"Comet",{57.3,7}}]
0.7948832
I used an Approximate conversion factor from the following:
Solve[Pi / 2 - GeoDistance[{0,0},{90,0}]/x==0,x][[1,1,2]] //Round
6367449
= = = = =
Dana DeLouis
$Version
8.0 for Mac OS X x86 (64-bit) (November 6, 2010)
On Sep 16, 5:55 am, Olaf <olaf.rogal... at googlemail.com> wrote:
> 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