10
$\begingroup$

Is there an efficient and elegant method so that multiple calls of GeoPath for the same segment (path) yield visibly separate segments on a map?

For instance, this code calls two "equivalent" GeoPaths (from China to Brazil):

GeoGraphics[
 {Red, Thick, 
  GeoPath[#] & /@ 
   {{Entity["Country", "China"], Entity["Country", "Brazil"]},
    {Entity["Country", "China"], Entity["Country", "Brazil"]}}},
 GeoRange -> "World"]

Two GeoPaths overlapping

Because the GeoPaths are the same, the two overlap and appear as a single segment or path.

The same problem arises if one uses specific locations, such as:

{CityData["BuenosAires", "Coordinates"], CityData["Beijing", "Coordinates"]}

I'd like to displace each path slightly, so that the two paths (or in general $n$ paths) appear separate (even if $n-1$ paths are not geodesics). Note that such displacement is done automatically in renderings of edges in Multigraphs. (Background: I want to plot a complicated multi-city itinerary in which several legs of the trip were between the same pair of cities.)

I could do this "by hand," for each such set of overlapping paths (either by displacing, or using dashes and coloring, etc.), but I'm seeking a far more elegant and automatic method.

Ideally, I think Wolfram should implement an option for GeoGraphics such as MultiSegment -> True which draws the $n$ separate paths, even if they are specified in a non-sequential order such as:

{{Entity["Country", "India"], Entity["Country", "China"]}, 
 {Entity["Country", "China"], Entity["Country", "Brazil"]},
 {Entity["Country", "Brazil"], Entity["Country", "Chile"]},
 {Entity["Country", "Chile"], Entity["Country", "Brazil"]},
 {Entity["Country", "Brazil"], Entity["Country", "China"]}}
$\endgroup$
4
  • $\begingroup$ This is a very rough data from country to country, when the size of the country is very large. Apparently, you need to specify the exact coordinates. $\endgroup$ Oct 5, 2018 at 10:02
  • $\begingroup$ @AlexTrounev: The same problem arises, of course, if one uses precise coordinates. $\endgroup$ Oct 5, 2018 at 12:35
  • $\begingroup$ You do realize that by displacing, those displaced paths won't be geodesic paths anymore? $\endgroup$ Oct 5, 2018 at 12:45
  • $\begingroup$ I have no problem with the fact that the resulting $n-1$ paths will not be geodesics, of course. $\endgroup$ Oct 5, 2018 at 12:46

5 Answers 5

2
$\begingroup$

A completely different answer, this time ignoring Geo methods and focusing on Graph connectivity: just place the Graph object on the map.

Take your entity pairs:

ents = {
    {Entity["Country", "India"], Entity["Country", "China"]},
    {Entity["Country", "China"], Entity["Country", "Brazil"]},
    {Entity["Country", "Brazil"], Entity["Country", "Chile"]},
    {Entity["Country", "Chile"], Entity["Country", "Brazil"]},
    {Entity["Country", "Brazil"], Entity["Country", "China"]}
};

Draw a map with those entities. This time we use the Mollweide projection and a vector background:

map = GeoGraphics[ents, GeoProjection -> "Mollweide", GeoBackground -> "CountryBorders"];

Extract the actual projection used by GeoGraphics. Recall that GeoGraphics adds parameters to the projection to adapt it to the situation, unless those parameters are explicit:

proj = GeoProjection /. Options[map, GeoProjection]
(* {"Mollweide", "Centering" -> GeoPosition[{-1.07727, 29.5607}]} *)

Now, eliminate duplicate entities and find their respective projected coordinates:

uents = Union[Flatten[ents]]
(* {Entity["Country", "Brazil"], Entity["Country", "Chile"], 
    Entity["Country", "China"], Entity["Country", "India"]} *)

coords = GeoGridPosition[GeoPosition[uents], proj][[1]]
(* {{-1.31625, -0.19348}, {-1.44548, -0.571304},
    {1.04746, 0.66214}, {0.717329, 0.384687}} *)

Construct a Graph object using those coordinates:

graph = Graph[uents, UndirectedEdge @@@ ents, VertexCoordinates -> coords]

And finally show the map and the graph together (Show should be able to merge directly the GeoGraphics and Graph objects, but currently we need to extract the Graphics from GeoGraphics):

Show[map[[1]], graph]

enter image description here

$\endgroup$
1
  • $\begingroup$ Very clever. Thanks! (+1) And your solution can be easily modified to give a directed route! $\endgroup$ Oct 8, 2018 at 23:01
8
$\begingroup$

Here's one idea. Start with the geodesic, then walk an offset perpendicular to that path. The offset length should vary along the path.

multiGeoPath[spec_, n_Integer?Positive, offset_] :=
  Block[{pts, degs, len, offsets},
    pts = Reverse[GeoGraphics`GeoEvaluate[GeoPath[spec]][[1]], {2}];
    degs = Prepend[GeoDirection @@@ Partition[pts, 2, 1] - Quantity[90, "Degrees"], Quantity[0, "Degrees"]];

    len = Length[pts];
    offsets = offset Range[-Quotient[n-1, 2], Quotient[n, 2]];

    Line /@ Table[
      GeoDestination[
        GeoPosition[pts[[i]]], 
        GeoDisplacement[{1000k Sin[π(i - 1)/(len - 1)], degs[[i]]}]
      ],
      {k, offsets}, 
      {i, Length[pts]}
    ]
  ]

spec = {Entity["Country", "China"], Entity["Country", "Brazil"]};
GeoGraphics[{Red, multiGeoPath[spec, 2, 500]}, GeoRange -> "World"]

enter image description here

GeoGraphics[{Red, multiGeoPath[spec, 5, 500]}, GeoRange -> "World"]

enter image description here

gplot = GeoGraphics[MapIndexed[{ColorData[112][First[#2]], #1} &,
  multiGeoPath[spec, 18, 500]], GeoRange -> "World"]

enter image description here

These end up looking quite natural when lifted back up to 3D. Mimicking Jose's technique:

{loc1, loc2} = GeoPosition /@ spec;
midp = GeoDestination[loc1, {GeoDistance[loc1, loc2]/2, GeoDirection[loc1, loc2]}];

Show[gplot, GeoProjection -> {"Orthographic", "Centering" -> midp}, 
  GeoRange -> "World", GeoZoomLevel -> 3]

enter image description here

$\endgroup$
4
  • $\begingroup$ Thanks for the nice solution (+1). Let me wait a day or two to accept it in case someone comes up with something a bit more elegant. Frankly, I think Wolfram should introduce an options such as MultiPaths->True to implement something close to your solution. $\endgroup$ Oct 6, 2018 at 0:55
  • $\begingroup$ @DavidG.Stork I think that’s a good idea, and similar to Graph. I like the idea of it not being default, as the extra paths won’t be geodesic, rhumb, etc. $\endgroup$
    – Greg Hurst
    Oct 6, 2018 at 1:02
  • $\begingroup$ Also I didn’t add any logic to auto determine a nice offset, based on the scale. That’s en exercise left to the reader :) $\endgroup$
    – Greg Hurst
    Oct 6, 2018 at 1:05
  • $\begingroup$ I agree, the multi-path option should not be True by default, but it would be very nice indeed if one could specify it when desired. As you can see, none of the solutions quite solve my general problem, where the $n$ paths can be specified in any order and number, and then rendered slightly displaced. $\endgroup$ Oct 8, 2018 at 12:32
7
$\begingroup$

Let me propose an alternative, very similar in spirit to Chip's idea, but avoiding the use of the internal GeoGraphics`GeoEvaluate. I'll base the construction on a L-type displacement that moves a distance d in a given direction and then a distance t in the perpendicular at the final point:

GeoKnightDestination[loc_, a_, {d_, t_}] := Module[{p, pa},
   p = GeoDestination[loc, {d, a}];
   pa = GeoDirection[p, loc] + Quantity[90, "AngularDegrees"];
   GeoDestination[p, {t, pa}]
]

We will call the pair {d, t} a "knight". We need to create a grid of them:

loc1 = Entity["City", {"Petropolis", "RioDeJaneiro", "Brazil"}];
loc2 = Entity["City", {"Beijing", "Beijing", "China"}];

d = GeoDistance[loc1, loc2];
a = GeoDirection[loc1, loc2];
midp = GeoDestination[loc1, {d/2, a}];

npaths = 7;
npoints = 21;
dists = Subdivide[Quantity[0, "Miles"], d, npoints - 1];

These are the distances to the central path (controlling the mutual deviation):

perp = Subdivide[-d/4, d/4, npaths - 1];

This constructs the knights, with some parabolic distribution:

Dimensions[
    knights = Transpose[
        Thread /@ MapThread[List,
           {dists, TensorProduct[1 - Subdivide[-1, 1, npoints - 1]^2, perp]}
        ]
    ]
]
(* {7, 21, 2} *)

This constructs the grid of points:

GeoPosition[grid = Map[GeoKnightDestination[loc1, a, #] &, knights, {2}]]

And this is the result, with some styling. I add the yellow points to help understanding:

GeoGraphics[
   {Orange, GeoPath /@ grid, PointSize[Medium], Yellow, Point[grid]}, 
   GeoProjection -> {"Orthographic", "Centering" -> midp}, 
   GeoBackground -> "Satellite", Background -> Black,
   GeoRange -> "World", GeoZoomLevel -> 2, PlotRangePadding -> 0.1, 
   GeoGridLines -> Automatic
]

enter image description here

$\endgroup$
2
  • $\begingroup$ Wonderful idea, and very elegant (+1). However, what I truly need is for the number of paths to be computed automatically. For instance, suppose I have a complicated route with many individual inter-city segments of which three just happen to be between New York and London. I want to call GeoPath and have it automatically determine how many such segments there are and render them precisely. Consider Multigraph: you input the edges (or connection matrix) and the code automatically displaces the edges for ease in visibility. Ideally, WRI should implement a "multi-segment" rendering option. $\endgroup$ Oct 6, 2018 at 16:45
  • 1
    $\begingroup$ GeoPath is a geometric construction. It's a geodesic, a loxodrome, etc. Given the two end points of a GeoPath segment, its intermediate points are uniquely defined, no matter how many times the GeoPath is given. The same could be said of Line with standard flat Graphics: Line is formed by straight segments, and therefore if you specify the same Line object twice, Graphics will draw the same straight segment twice. Having said that, now I realize that you are not interested in the geometric integrity of the paths, but in the connectivity of the problem. I'll post another suggestion. $\endgroup$
    – jose
    Oct 8, 2018 at 14:11
1
$\begingroup$
ClearAll[paths]
paths[a_, b_, n_, colors_: ColorData[97, "ColorList"] ] := Module[{pos = 
  First /@ GeoPosition /@ {a, b}},
 {#, GraphElementData[{"CurvedArc", "Curvature" -> #2}][pos, {}]} & @@@ 
    Transpose[{colors[[;; n]], If[n == 1, {0}, Subdivide[-1/2, 1/2, n - 1]]}] /. 
   BezierCurve[x_] :> BezierCurve[GeoGridPosition[GeoPosition@#, "Mercator"][[1]] & /@ x]]

GeoGraphics[ {Thick, 
  paths[Entity["Country", "China"], Entity["Country", "Brazil"], 5]}, GeoRange -> "World"]

enter image description here

Note: As is, this works only for "Mercator" projection. For an alternative projection proj, add the option GeoProjection -> proj to GeoGraphics and change "Mercator" to proj in the second argument of GeoGridPosition.

$\endgroup$
1
  • $\begingroup$ I had this deleted this answer after seeing Chip's great answer. Given the accepted answer this seems not too far off the mark. $\endgroup$
    – kglr
    Oct 9, 2018 at 19:17
0
$\begingroup$

You can use standard options.

GeoGraphics[{Red, 
  GeoPath[{{Entity["Country", "China"], Entity["Country", "Brazil"]}},
    "Rhumb"], 
  GeoPath[{{Entity["Country", "China"], Entity["Country", "Brazil"]}},
    "Geodesic"]}, GeoRange -> "World"]

fig1

$\endgroup$
2
  • $\begingroup$ That just gives two different paths; what if the user wants more than two? $\endgroup$ Oct 6, 2018 at 8:18
  • $\begingroup$ Exactly. I need more than can be covered by the standard options. Moreover, I would like the path variations to be derived automatically. That is, if I generate a complicated route that just happens to have three segments between New York and London (say), I want the code to figure that out and generate the three paths automatically. In short, I don't want to have to count the paths and then call GeoPath with some parameter set to $3$. $\endgroup$ Oct 6, 2018 at 16:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.