6
$\begingroup$

I would like to create a 3D torus plot from a 2D graphic. This 2D original plot is a bit complex, and I haven't a clue how could transform it to a torus.

The below code, from this article posted on Wolfram MathSource, performs a random walk under certain conditions. It depends on the NetLogo software and the included NetLogo Mathematica link package.

StartShot = 
  ArrayPlot[NLGetPatches["covername"], 
   ColorRules ->  {"arable_land" -> Brown, 
     "forests" -> Darker[Green]}, Frame -> False, 
   DataRange -> {{-400, 0}, {0, 400}}];

startingpoints = NLReport["map last [path] of persons"];
agents = ListPlot[startingpoints, 
   PlotStyle -> Directive[PointSize[Small], White], AspectRatio -> 1, 
   Axes -> None, Frame -> False, DataRange -> {{-400, 0}, {0, 400}}];

paths = NLReport["[path] of persons"];
lineplot = 
  ListLinePlot[paths, AspectRatio -> 1, Axes -> None, Frame -> False, 
   DataRange -> {{-400, 0}, {0, 400}}, PlotStyle -> White];

Show[StartShot, lineplot, agents, ImageSize -> 300]

original pic

The lineplot and agents plots are from coordinates, but the startshot is from ArrayPlot, and therefore is a graphic which doesn't directly represent any coordinates that could be transformed onto the torus.

My aim is to create a visualisation like the one shown below, which was presented by Vitaliy Kaurov in his answer to this related question about random walks. However, I wasn't able to apply his approach to my case.

content on torus

Improve this question
$\endgroup$
6
  • $\begingroup$ If I understand your problem correctly, you do want to create a random walk on the surface of a torus? $\endgroup$
    – Sascha
    Commented Jan 2, 2016 at 16:13
  • $\begingroup$ I would like to spread the upper image to a torus by wrapping or coordinate transformations. $\endgroup$
    – pnz1337
    Commented Jan 2, 2016 at 17:41
  • $\begingroup$ Have a look at this question on wolfram community. $\endgroup$
    – Sascha
    Commented Jan 2, 2016 at 17:45
  • $\begingroup$ I allowed myself to suggest an edit to the title of your question. I hope you don't mind $\endgroup$
    – Sascha
    Commented Jan 2, 2016 at 17:52
  • 1
    $\begingroup$ related: Morphing a “sheet of paper” into a torus $\endgroup$
    – Kuba
    Commented Jan 3, 2016 at 9:01

1 Answer 1

Reset to default
4
$\begingroup$

First get your texture, then:

ParametricPlot3D[{Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]},
    {t, 0, 2 Pi}, {u, 0, 2 Pi},
 PlotStyle -> Directive[Specularity[White, 30], 
 Texture[ExampleData[{"ColorTexture", "WhiteMarble"}]]], 
 TextureCoordinateFunction -> ({#4, 2 #5} &), 
 Lighting -> "Neutral", 
 Mesh -> None, 
 PlotRange -> All]

enter image description here

Or define mytexture = and insert the graphic of your star map. Then:

ParametricPlot3D[{Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]},
    {t, 0, 2 Pi}, {u, 0, 2 Pi},
 PlotStyle -> Directive[Specularity[White, 30], 
 Texture[mytexture]], 
 TextureCoordinateFunction -> ({#4, #5} &), 
 Lighting -> "Neutral", 
 Mesh -> None, 
 PlotRange -> All, 
 Method -> {"ShrinkWrap" -> True}]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks, it's almost perfect, I only cannot correct those white bands, the forest was done by slight modifications: code ParametricPlot3D[{Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]}, {t, 0, 2 Pi}, {u, 0, 2 Pi}, PlotStyle -> Directive[Specularity[White, 30], Texture[boxworld]], TextureCoordinateFunction -> ({#4, #5} &), Lighting -> "Neutral", Mesh -> None, PlotRange -> All] code I don't understand the #4 #5 links by the way. :/ $\endgroup$
    – pnz1337
    Commented Jan 2, 2016 at 20:16

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.