Group Abstract Group Abstract

Message Boards Message Boards

[GIF] Stereo Vision (Stereographic projection of a (24, 23)-torus knot)

7 Replies

Let's just define your expression for future use:

expr[r_, t_, \[Theta]_, s_] := {(-1105 Cos[r] Sqrt[4514 - 94 Cos[46 t]] Cos[       24 t + \[Theta]] +          2 Sin[r] (1105 Cos[              23 t] (Sqrt[1105] Cos[24 t + \[Theta]] Sin[s] -                23 Sqrt[2] Cos[s] Sin[24 t + \[Theta]]) +             24 Sin[23 t] (1105 Sqrt[2] Cos[s] Cos[24 t + \[Theta]] +                46 Sqrt[1105] Sin[s] Sin[24 t + \[Theta]])))/(-2210 Sqrt[           2257 - 47 Cos[46 t]] + 53040 Sqrt[2] Cos[s] Sin[r] +          1105 Cos[r] Sqrt[4514 - 94 Cos[46 t]] Sin[23 t] -          47 Sqrt[1105] Sin[r] Sin[s] Sin[
       46 t]), -((1105 Sqrt[2] Cos[             s] (-47 Cos[t + \[Theta]] + Cos[47 t + \[Theta]]) Sin[r] +            2208 Sqrt[1105] Cos[24 t + \[Theta]] Sin[r] Sin[s] Sin[23 t] +            1105 (Cos[r] Sqrt[4514 - 94 Cos[46 t]] -               2 Sqrt[1105] Cos[23 t] Sin[r] Sin[s]) Sin[
         24 t + \[Theta]])/(-2210 Sqrt[2257 - 47 Cos[46 t]] +            53040 Sqrt[2] Cos[s] Sin[r] +            1105 Cos[r] Sqrt[4514 - 94 Cos[46 t]] Sin[23 t] -            47 Sqrt[1105] Sin[r] Sin[s] Sin[46 t])), ((Cos[r] Cos[23 t])/          Sqrt[2] + (Sqrt[2257 - 47 Cos[46 t]] Sin[r] Sin[s])/(2 Sqrt[             1105]))/(1 - (Cos[r] Sin[23 t])/          Sqrt[2] + (Sin[             r] (-53040 Sqrt[2] Cos[s] + 
          47 Sqrt[1105] Sin[s] Sin[46 t]))/(2210 Sqrt[             2257 - 47 Cos[46 t]]))}

Two tips,

  • not 100% sure but it seems that variation in theta is just a rotation around z. One can generate ParametricPlot3D and later dynamicaly Rotate or change the ViewPoint, should be faster.

Don't have time for math now (cries internally) but random checks seem to support that claim:

    (
      RotationMatrix[.1, {0, 0, 1}].expr[r, t, 0., s] -       expr[r, t, .1, s]
     ) // N //   ReplaceAll[{r -> .3, s -> RandomReal[], t -> RandomReal[]}] // Chop 
    (* {0,0,0}*)
  • your figure is symetric and we can use that to focus plotting only on unique part instead of sampling over whole t and s.

Here is what we get:

With[{r = .03, viewpoint = {0, 3, 0}, 
  cols = RGBColor /@ {"#f54123", "#0098d8", "#0b3536"}},

 static = 
  First@ParametricPlot3D[
    expr[r, t, 0, s], {t, 0, 2 \[Pi]/23.}, {s, 0, 2 \[Pi]}
    , PlotPoints -> 50, PlotRange -> 2.7, ViewPoint -> viewpoint, 
    PlotStyle -> White, Mesh -> None, ViewAngle -> \[Pi]/9., 
    ViewVertical -> {0, 0, -1}, Boxed -> False, 
    Background -> cols[[-1]], 
    Lighting -> {{"Point", cols[[1]], {3/4, 0, 0}}, {"Point", 
       cols[[2]], {-3/4, 0, 0}}, {"Ambient", cols[[-1]], viewpoint}}, 
    ImageSize -> 540];

 Animate[
  Graphics3D[
   GeometricTransformation[
    static, 
    Table[RotationTransform[t + Dynamic@\[Theta], {0, 0, 1}], {t, 0, 
      2 Pi - 2 Pi/24, 2 Pi/24}]]

   , PlotRange -> 2.7, ViewPoint -> viewpoint, Axes -> None, 
   ViewAngle -> \[Pi]/9, ViewVertical -> {0, 0, -1}, Boxed -> False, 
   Background -> cols[[-1]],
   ImageSize -> 540]
  ,
  {\[Theta], 0., -Pi/2}
  ]
 ]

enter image description here

POSTED BY: Kuba Podkalicki

not 100% sure but it seems that variation in theta is just a rotation around z. One can generate ParametricPlot3D and later dynamicaly Rotate or change the ViewPoint, should be faster.

Yes, that's totally right. I wasn't even thinking about this, but using RotationTransform on the final image should obviously be faster than what I did. And your trick taking advantage of the symmetry and using GeometricTransformation is super clever.

Thanks!

If i understand correctly, you use ParametricPlot to create the 'tubes'. Why not use the Tube primitive? (replace the line of a parametric plot with a tube with something like:

plot /. Line[x___] :> Tube[x,0.1]

Should be faster to render?

POSTED BY: Sander Huisman

The tubes in the final animation have variable diameter, which I don't think is possible using Tube. But maybe I'm wrong?

Actually, it can be done, by specifying a list of 'r' values:

data = Transpose@Table[{{x, 0, 0}, 2 + Cos[x]}, {x, 0, 4 Pi, Pi/20.0}];
Graphics3D[{CapForm[None], Tube @@ data}]

enter image description here

POSTED BY: Sander Huisman

Ah, interesting! So now I guess I need to try to figure out what the actual tube radii are...

enter image description here - Congratulations! This post is now a Staff Pick as distinguished on your profile! Thank you for your wonderful contributions. Please, keep them coming!

POSTED BY: EDITORIAL BOARD
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard