How can I generate a world map like the one here, but for an arbitrary hand-drawn map?

For example, starting from scratch, how can I manipulate this world map

enter image description here

to get something that looks like this?

enter image description here

Attempt: Starting with the world map, I thought to cut the image into vertical strips and somehow contract each rectangular strip at its upper and lower ends while keeping the middle constant to make symmetric lenses, i.e. the transformation that does this:

enter image description here

However, I don't how to do this, and I suspect there may be an easier way. Any suggestions are appreciated.

  • $\begingroup$ Your first image seems to be cut off (i.e. not a complete equirectangular projection of the world). $\endgroup$ Jul 26, 2016 at 4:00
  • $\begingroup$ Wolfram Research has posted a page, Make a Map That Wraps a Globe. There you can find Mathematica code that should answer your question; follow this link $\endgroup$
    – m_goldberg
    Jul 26, 2016 at 4:32
  • $\begingroup$ @m_goldberg I was aware of that page (it was the first link I included in my question). I am asking how to do something similar but with an arbitrary map, say the map of some fictional planet, not one of Earth. I wasn't aware that the code given on that page could be adapted for an imported image as JM's answer demonstrated. $\endgroup$
    – user170231
    Jul 26, 2016 at 13:17

2 Answers 2


I'm going to take the interpretation that you want to apply the transverse Mercator projection to an image you have to produce something like the one in the Wolfram page you linked to. One only needs to make a few changes to the code in that link. I will be using a different image, since the one in the OP is awkwardly cut off, which will mess with the mapping.

With[{Δ = 30},
     earth = Import["https://i.sstatic.net/jteWq.jpg"];
          GeoGraphics[GeoBackground -> GeoStyling[{"GeoImage", #2}], 
                      GeoRange -> {{-90, 90}, #1[[1]]}, 
                      GeoProjection -> {"TransverseMercator", "Centering" -> #1[[2]]},
                      ImageSize -> Large], 
                    ImageSize -> Large] &,
                    {Table[{{λ, λ + Δ}, {0, λ + Δ/2}}, {λ, -180, 180 - Δ, Δ}],
                     First @ ImagePartition[earth, Scaled[{Δ/360, 1}]]}]]]

transverse Mercator

Here is a slower method that uses ImageTransformation[] and formulae 22-23 from here to directly transform the map (note that I took the liberty to work directly in radians instead of degrees):

With[{Δ = π/6},
     earth = Import["https://i.sstatic.net/jteWq.jpg"];
                   Module[{x = #[[1]], y = #[[2]], h = Δ/2, λt},
                          λt = ArcTan[Cos[y], Sinh[x]]; 
                          If[-h <= λt <= h,
                             {λ + h + λt, ArcSin[Sin[y] Sech[x]]},
                             {π, π/2} (* dummy value for off-range pixels *)]] &, 
                   Background -> White, DataRange -> {{-π, π}, {-π/2, π/2}}, 
                   Masking -> All, 
                   PlotRange -> {{-InverseGudermannian[Δ/2], InverseGudermannian[Δ/2]},
                                 {-π/2, π/2}}],
                   {λ, -π, π - Δ, Δ}]]]

directly transformed image

  • $\begingroup$ Bonus image: here is the result of applying the piecewise transverse Mercator projection to the ETOPO1 global relief. $\endgroup$ Jul 26, 2016 at 8:34
  • $\begingroup$ This looks quite promising. I'll give it a try when I get to my desktop. $\endgroup$
    – user170231
    Jul 26, 2016 at 13:17
  • $\begingroup$ @J.M. What would be the parametric equation for a single flat gore region? $\endgroup$
    – Young
    Jul 26, 2016 at 14:13
  • $\begingroup$ @Young, pardon me, but what is a "flat gore region"? $\endgroup$ Jul 26, 2016 at 14:15
  • 1
    $\begingroup$ I'm trying this img = Import["https://i.sstatic.net/jteWq.jpg"]; gore = 12; tex = First@ImagePartition[img, Scaled[{1/gore, 1}]]; Row[Table[ ParametricPlot[{phi Sin[theta]^2, gore/2 phi Cos[theta]}, {phi, -Pi/gore, Pi/gore}, {theta, -Pi, Pi}, PlotStyle -> Directive[Texture[tex[[i]]], Opacity[1]], TextureCoordinateFunction -> ({#1, #2} &), Frame -> False, Axes -> False, BoundaryStyle -> None, ImageSize -> Medium], {i, 1, gore}]] $\endgroup$
    – Young
    Jul 26, 2016 at 14:19

J.M.'s answer is the best and he helped me figure out the correct parametric equations from here, but the method I've been working on is very fast (<0.5 sec) and doesn't include any white-space where the slices connect.

img = Import["https://i.sstatic.net/jteWq.jpg"];
gore = 12;
tex = First @ ImagePartition[img, Scaled[{1/gore, 1}]];
  ParametricPlot[{ArcTanh[Cos[ϕ] Sin[λ]],  ArcTan[Cos[ϕ] Cos[λ], Sin[ϕ]]},
   {ϕ, -π/2, π/2}, {λ, -π/gore, π/gore},
   PlotStyle -> Directive[Texture[tex[[i]]], Opacity[1]], 
   TextureCoordinateFunction -> ({#1, #2} &), Frame -> False, 
   Axes -> False, BoundaryStyle -> None, PlotRangePadding -> 0],
  {i, 1, gore}]]

Mercator-projected map

  • 1
    $\begingroup$ Here's an alternative: Show[Table[ParametricPlot[{2 (i - 1) InverseGudermannian[π/gore] + ArcTanh[Cos[ϕ] Sin[λ]], ArcTan[Cos[ϕ] Cos[λ], Sin[ϕ]]}, {ϕ, -π/2, π/2}, {λ, -π/gore, π/gore}, Axes -> False, BoundaryStyle -> None, Frame -> False, PlotStyle -> Directive[Texture[tex[[i]]], Opacity[1]], TextureCoordinateFunction -> ({#1, #2} &)], {i, 1, gore}], PlotRange -> All]. $\endgroup$ Jul 28, 2016 at 11:31

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.