0
$\begingroup$

This question already has an answer here:

First I would have liked to map points and texture from a square map (box) in agent-based modellers to a torus.

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

enter image description here

startingpoints = {{348.488, 132.622}}
agents = 
  ListPlot[startingpoints, 
    PlotStyle -> Directive[PointSize[Medium], White], 
    AspectRatio -> 1,
    Axes -> None, 
    Frame -> False, 
    DataRange -> {{0, 400}, {0, 400}}];
Show[StartShot, agents, ImageSize -> 150]
paths = {{{348.488, 132.622}, {336.333, 63.6857}, {394.365, 24.5422},
          {39.3603, 78.1653}, {109.094, 84.2662}, {170.317, 50.3295},
          {195.403, 115.68}, {263.324, 132.615}, {316.947, 177.61},
          {381.382, 150.259}, {49.8526, 164.812}, {41.3217, 95.3342},
          {11.7384, 158.776}, {65.3616, 113.781}, {5.35985, 77.728},
          {18.7165, 9.01408}, {358.715, 372.961}, {394.767, 312.96},
          {340.367, 268.907}, {313.016, 333.343}, {269.92, 388.503}}};
arrows = {{{313.016, 333.343}, {269.92, 388.503}}}
lineplot = 
  ListLinePlot[paths,
    AspectRatio -> 1, 
    Axes -> None, 
    Frame -> False, 
    DataRange -> {{0, 400}, {0, 400}}, 
    PlotStyle -> White];
FlatTorus = 
  Show[StartShot, lineplot, agents,
    Epilog -> {White, Arrowheads[Small], Arrow /@ arrows}, 
    ImageSize -> 300]

enter image description here

Then I map the 'box' - flat coordinates:

    dataTorus = paths/400*2 π;
    r1 = 1; r2 = 0.3;
    f[{θ_, ϕ_}] := {(r1 + r2*Cos[ϕ])*Cos[θ], (r1 + r2*Cos[ϕ])*Sin[θ], r2*Sin[ϕ]}
    Show[ListPointPlot3D[Evaluate[f] /@ Flatten[dataTorus, 1], 
  PlotStyle -> Directive[PointSize[0.02]]], 
 ParametricPlot3D[
  Evaluate@f[{\[Theta], \[Phi]}], {\[Theta], 0, 2*\[Pi]}, {\[Phi], 0, 
   2*\[Pi]}, Mesh -> None, PlotStyle -> Directive[Texture[FlatTorus]],
   TextureCoordinateFunction -> ({#4, #5} &)], 
 Graphics3D[
  Line[f /@ 
      Table[{Interpolation[#[[All, 1]]][k], 
        Interpolation[#[[All, 2]]][k]}, {k, 1, Length@#, .01}]] &@
   Flatten[dataTorus, 1] (*after george2079*), Boxed -> False], PlotRange -> All, 
 Boxed -> False, Lighting -> "Neutral", Axes -> False]

enter image description here

Question:

I would like to connect my points with the shortest distances on the torus surface (in toroidal space) according to the order.

Problems:

  1. The interpolation put curves (yellow line)
  2. The long line (red) is not a shortest distance, it happened because the line is drawn in euclidean space between the points. The interpolation is done in the euclidean space, not in the toroidal space. The distances should seems to be equals, like the geodetics on the sphere surface.
$\endgroup$

marked as duplicate by Jens, user9660, MarcoB, dr.blochwave, bbgodfrey Jan 6 '16 at 13:09

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

  • $\begingroup$ I think this would best be added to the Q linked by @DavidG.Stork above. $\endgroup$ – Jens Jan 4 '16 at 3:56
  • $\begingroup$ No, that's just good for texture. Please focus on the questions. How can I join the points on the torus surface? Why the strips are there? $\endgroup$ – pnz Jan 4 '16 at 8:23
  • 2
    $\begingroup$ Let me just say that you should attribute David's solution to him when you repost it like this, by mentioning him, linking to his profile and linking to his answer. All answers on this site are licensed under cc by-sa 3.0 with attribution required. $\endgroup$ – C. E. Jan 4 '16 at 15:21
  • $\begingroup$ Perhaps, rather than using StartShot as your texture, you might rasterize FlatTorus and use that for your texture. Have not tried this myself, so it's only a suggested experiment. $\endgroup$ – m_goldberg Jan 4 '16 at 16:20
  • $\begingroup$ Flattorus is a counterexample, when the line is drawn wrong - not till the border, and from the border in the other side. $\endgroup$ – pnz Jan 5 '16 at 11:38
2
$\begingroup$

You can draw the path through your points like this:

Graphics3D[Line[f /@ Table[{
       Interpolation[#[[All, 1]]][k],
       Interpolation[#[[All, 2]]][k]}, {k, 1, Length@#, .01}]] &@
         Flatten[dataTorus, 1] ]

enter image description here

$\endgroup$
  • $\begingroup$ Thanks for your idea, but the problem still exist. Please look at the modified question. $\endgroup$ – pnz Jan 5 '16 at 13:32
  • $\begingroup$ I think you've confused matters by lumping unrelated issues into one question. $\endgroup$ – george2079 Jan 5 '16 at 15:01
  • $\begingroup$ Ok, I clarified the question. I think they were related by the way. $\endgroup$ – pnz Jan 5 '16 at 16:21

Not the answer you're looking for? Browse other questions tagged or ask your own question.