4
$\begingroup$

A band surrounding a sphere could be plotted using the ParametricPlot3D function:

base=Block[{r=10,urange=15,vrange=1.5},
 ParametricPlot3D[Evaluate[{Cos[u], Sin[u], ((u+v)/r)}/Sqrt[1 + ((u+v)/r)^2]], 
   {u, -urange,urange},{v,-vrange,vrange}, 
 Mesh->None,MaxRecursion->5,Axes->False,Boxed->False]]

enter image description here

Now, I would like to project a global geomap, such as: enter image description here

onto the spherical band above. I have tried the Texture function, but clearly it does not offer correct projection:

Block[{r=10,urange=15,vrange=1.5},
ParametricPlot3D[Evaluate[{Cos[u], Sin[u], ((u+v)/r)}/Sqrt[1 + ((u+v)/r)^2]], {u, -urange,urange},{v,-vrange,vrange},
Mesh->None,MaxRecursion->5,Axes->False,Boxed->False,
TextureCoordinateScaling->False,
TextureCoordinateFunction -> ({#4/3,#5/5}&),
PlotStyle -> Directive[Specularity[White, 10], Texture[map],Opacity[.9]]]]

enter image description here

The problem should be the TextureCoordinateFunction, however, I could not figure out the exact solution. Thanks for helping out!

$\endgroup$
2
  • $\begingroup$ Do you want to project it on a sphere and cut the band or do you want the whole map stretched on a band? $\endgroup$
    – Kuba
    Aug 24, 2021 at 4:21
  • $\begingroup$ The former, project on a sphere and save only the banded region. $\endgroup$ Aug 24, 2021 at 4:29

1 Answer 1

9
$\begingroup$
  • The key point is we need to unitization the spherical coordinate. {φ/(2 π), -θ/π}

  • To illustrate the method,we change some parametric here: use t=2 instead of r=10,use vrange = 3 instead of vrange = 1.5.

  • Normalize the mapping to unit-sphere.

t = 2;
f[u_, v_] = Normalize[{Cos[u], Sin[u], (u + v)/t}, Sqrt[# . #] &];
  • calculate the spherical coordinate {r, θ, φ} functions according to the parametric{u,v}.
{r, θ, φ} = 
  ToSphericalCoordinates[{x, y, z}] /. Thread[{x, y, z} -> f[u, v]] //
    FullSimplify;
  • for convenience, we use map from the wolfram data.
map = GeoGraphics[{EdgeForm[Brown], 
    Polygon[GeoVariant[#, "SimplifiedArea"], CommonName[#]] & /@ 
     CountryData[]}, GeoBackground -> None];
  • unitization and rotate the spherical coordinate {θ,φ} to get {φ/(2 π), -θ/π}. To illustrate the spherical coordinate, we also draw some meshs according to {u,v}.
urange = 15; vrange = 3; 
ParametricPlot3D[
 f[u, v], {u, -urange, urange}, {v, -vrange, vrange}, Mesh -> 8, 
 MeshStyle -> Directive[Thick,Cyan], 
 MeshFunctions -> {Function[{x, y, z, u, v}, θ], 
   Function[{x, y, z, u, v}, φ]}, MaxRecursion -> 4, 
 Axes -> False, Boxed -> False, TextureCoordinateScaling -> False, 
 TextureCoordinateFunction -> 
  Function[{x, y, z, u, 
    v}, {φ/(2 π), -θ/π}],
 PlotStyle -> Texture[map], PlotPoints -> 30]

enter image description here

Reply to comment

Take from https://reference.wolfram.com/language/ref/Texture.html The picture take from https://reference.wolfram.com/language/ref/Texture.html

Clear[map, urange, t,r, θ, φ];
map=Import["https://i.sstatic.net/4QRoH.jpg"];
t = 10;
f[u_, v_] = Normalize[{Cos[u], Sin[u], (u + v)/t}, Sqrt[# . #] &];
{r, θ, φ} = 
  ToSphericalCoordinates[{x, y, z}] /. Thread[{x, y, z} -> f[u, v]] //
    FullSimplify;
urange = 15; vrange = 1.5;
ParametricPlot3D[f[u, v], {u, -urange, urange}, {v, -vrange, vrange}, 
 Mesh -> 8, MeshStyle -> Cyan, 
 MeshFunctions -> {Function[{x, y, z, u, v}, θ], 
   Function[{x, y, z, u, v}, φ]}, MaxRecursion -> 4, 
 Axes -> False, Boxed -> False, TextureCoordinateScaling -> False, 
 TextureCoordinateFunction -> 
  Function[{x, y, z, u, v}, {φ/(2 π), -θ/π}],
  PlotStyle -> Texture[map], PerformanceGoal -> "Quality"]

enter image description here

Appendix

The example as below indicate the equivalence of unitization and TextureCoordinateScaling -> True for the simple unit sphere.

map = Graphics[{FaceForm[RandomColor[]], 
     CountryData[#, "SchematicPolygon"]} & /@ 
   CountryData[]]; nonscaling = 
 SphericalPlot3D[1, {θ, 0, π}, {φ, 0, 2 π}, 
  Mesh -> None, 
  TextureCoordinateFunction -> 
   Function[{x, y, 
     z, θ, φ}, {φ/(2 π), -θ/π}], TextureCoordinateScaling -> False, 
  PlotStyle -> Directive[Specularity[White, 10], Texture[map]], 
  Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip"]
scaling = 
 SphericalPlot3D[1, {θ, 0, π}, {φ, 0, 2 π}, 
  Mesh -> None, 
  TextureCoordinateFunction -> 
   Function[{x, y, 
     z, θ, φ}, {φ, -θ}], 
  TextureCoordinateScaling -> True, 
  PlotStyle -> Directive[Specularity[White, 10], Texture[map]], 
  Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip"]

enter image description here

$\endgroup$
4
  • $\begingroup$ Thanks for the help, however, the purpose here is to have the geomap projected to the correct position of the sphere, which is banded sampled. $\endgroup$ Aug 24, 2021 at 3:38
  • $\begingroup$ Thank you so much for the help! I will try to digest the code. Meanwhile, is the code for the last figure missing? $\endgroup$ Aug 25, 2021 at 16:05
  • $\begingroup$ @BaoxiangPan Please see the update. $\endgroup$
    – cvgmt
    Aug 25, 2021 at 23:09
  • $\begingroup$ Thank you so much. This is thought provoking! $\endgroup$ Aug 28, 2021 at 18:08

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.