7

My goal is to generate diagrams like this. enter image description here

But I would like to be able to rotate the globe about the North Pole, so that I can represent different times of the day.

When I use ImageRotate, the results are a little weird. enter image description here

That little black spot on the lower left is what was the original black background.

It seems like I'm doing things the hard way again. I hope there is a better way, but is there a better way to rotate this globe?


Too late now, but here's the code for the original (without the point).
Show[Graphics[{Black, Rectangle[{-1.1, -1.1}, {6, 1.1}], White, Thickness[0.01], Arrowheads[0.04], Table[Arrow[{{6, y}, {1.1, y}}], {y, -1, 1, 0.5}]}], Graphics @@ GeoGraphics[GeoProjection -> "Orthographic", GeoCenter -> {90, 0}, GeoRange -> "World", GeoGridLines -> Automatic, Background -> None], ImageSize -> 800]
David Elm
  • 375
  • 2
  • 8

2 Answers2

11

Update: It turns out oblique "Orthographic" projection (mentioned in the link provided by J.M.) has been implemented. Using the option "Centering" -> {90, - 30} gives the desired rotation in OP's case without the need for ImageRotate:

Row[GeoGraphics[{PointSize[Large], Point[fresno]}, ImageSize -> 300, 
    GeoRange -> "World", GeoGridLines -> Automatic, 
    GeoBackground -> GeoStyling["StreetMapNoLabels"], 
    GeoProjection -> {"Orthographic", "Centering" -> {90, #}}] & /@ 
 {-30, -60, 45}, Spacer[10]]

enter image description here

Original answer:

fresno = Entity["City", {"Fresno", "California", "UnitedStates"}];

geog1 = GeoGraphics[{PointSize[Large], Point[fresno]}, ImageSize -> 400, GeoRange -> "World", GeoGridLines -> Automatic, GeoBackground -> GeoStyling["StreetMapNoLabels"], GeoCenter -> {90, 0}, GeoProjection -> "Orthographic"];

You can use ImageRotate with GeoStylingImageFunction as follows and post-process to rotate the Point primitive:

geog2 = GeoGraphics[{PointSize[Large], Point[fresno]}, 
    ImageSize -> 400, GeoRange -> "World", GeoGridLines -> Automatic, 
    GeoBackground -> GeoStyling["StreetMapNoLabels", 
     GeoStylingImageFunction -> (ImageRotate[#, 30 Degree, ImageDimensions@#] &)], 
    GeoCenter -> {90, 0}, GeoProjection -> "Orthographic"] /. 
   Point[x_] :> GeometricTransformation[Point[x], RotationTransform[30 Degree]];

An easier approach is to rotate Rasterized geog1:

raster = Rasterize[geog1, Background -> None];
geog3 = Show[ImageRotate[raster, 30 Degree, ImageDimensions @ raster, 
    Background -> None], ImageSize -> 300]

Row[{geog1, geog2, geog3}, Spacer[10]]

enter image description here

rotate = ImageRotate[raster, #, ImageDimensions @ raster, Background -> None] &;

arrows = Graphics[{Arrowheads[.15], AbsoluteThickness[7], White, Arrow[{Scaled[{2, #}], Scaled[{1, #}]}] & /@ (Range[4 ] / 5)}];

frames = Show[rotate[# Degree], arrows, Background -> Black, PlotRange -> All, ImageSize -> 700] & /@ Range[0, 360, 10];

Export["rotategeog.gif", frames]

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896
  • The GridLines will be off in this case, right? They won't follow the lat/long lines correctly, because only the background has rotated. – Carl Lange Feb 03 '21 at 10:59
  • @CarlLange, you are right. Not sure if OP wants to rotate the gridlines too. – kglr Feb 03 '21 at 11:06
  • 2
    @Carl and kglr, Jose mentions here that GeoGraphics[] will support more oblique projections at some point, tho I am not sure if it's been done for at least the orthographic projection. – J. M.'s missing motivation Feb 03 '21 at 11:31
  • Indeed, I came across that as well, but it doesn't appear to be in 12.2 for more than ObliqueMercator at least, which doesn't work with this range. – Carl Lange Feb 03 '21 at 11:50
  • Thank you @J.M. for the link. It turns out the option "Centering" works as described by Jose for "Orthographic" projection too. – kglr Feb 03 '21 at 12:33
  • 2
    It does!? The syntax here is a bit surprising to me - in the docs it suggests "Centering" -> {{lat, lon}, az}, but it doesn't look like that's what you're using here? Anyway, that's definitely the more correct way to do it, and it certainly does work! That should be the accepted answer. – Carl Lange Feb 03 '21 at 12:37
  • 2
    Well, that's nice to see! I don't recall if this is documented tho... (and my more unreasonable wish is that there really should be documentation for all the supported projections) – J. M.'s missing motivation Feb 03 '21 at 12:40
  • 3
    (If we're adding unreasonable wishes, I deeply want EPSG ID support for projections) – Carl Lange Feb 03 '21 at 12:43
9

kglr's updated answer is the more correct option. My less correct answer follows.

There are two tricks here - one to be able to get the same image size regardless of background in the GeoGraphics, and another to use ImageCompose to place one image inside another.

Here we have a function to give back an image of the same size given any rotation. There's a bit of a hack here to make the background of the GeoGraphics and the background of the ImageRotate Purple. Unfortunately when you use ImageRotate on a GeoGraphics, it appears to disregard the alpha channel and cast the background to white (even if you had it set to None or Transparent). We then replace all Purple with Transparent, to get a nice image we can compose with. You also use ImageCrop to get a consistent image size.

rotateGlobe[d_] := 
 ColorReplace[
  ImageCrop@
   ImageRotate[
    GeoGraphics[GeoRangePadding -> 0, ImagePadding -> 0, 
     GeoBackground -> "Coastlines", GeoProjection -> "Orthographic", 
     GeoRange -> "World", GeoGridLines -> Automatic, 
     GeoCenter -> {90, 0}, Background -> Purple, ImageSize -> 400], d,
     Background -> Purple], Purple -> Transparent]

We'll also define your "arrows" to make it more clear what we're doing.

arrows = Graphics[{Black, Rectangle[{-1.1, -1.1}, {6, 1.1}], White, 
   Thickness[0.01], Arrowheads[0.04], 
   Table[Arrow[{{6, y}, {1.1, y}}], {y, -1, 1, 0.5}]}]

And now we can animate the two together. ImageCompose here is your friend, as you have two images with quite different dimensions. I used Scaled a lot, eyeballing scale and position until it looked right.

Animate[
 ImageCompose[arrows, ImageResize[rotateGlobe[d], Scaled[.25]], 
  Scaled[{.18, .5}]],
 {d, -\[Pi], \[Pi], .1}]

or,

Table[
 ImageCompose[arrows, ImageResize[rotateGlobe[d], Scaled[.25]], 
  Scaled[{.18, .5}]],
 {d, -\[Pi], \[Pi], 1}]

enter image description here

Carl Lange
  • 13,065
  • 1
  • 36
  • 70
  • Sorry, this is very messy code, if someone would like to take the basic idea (use ImageCompose instead of Show) and create a better answer, please feel free. – Carl Lange Feb 03 '21 at 11:12