# Map points on a square onto a Torus

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]


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.

• If I understand your problem correctly, you do want to create a random walk on the surface of a torus? – Sascha Jan 2 '16 at 16:13
• I would like to spread the upper image to a torus by wrapping or coordinate transformations. – pnz Jan 2 '16 at 17:41
• Have a look at this question on wolfram community. – Sascha Jan 2 '16 at 17:45
• I allowed myself to suggest an edit to the title of your question. I hope you don't mind – Sascha Jan 2 '16 at 17:52
• – Kuba Jan 3 '16 at 9:01

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]


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}]


• 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. :/ – pnz Jan 2 '16 at 20:16