[GIF] Reveal (The torus in relief)

Posted 3 years ago
3595 Views
|
4 Replies
|
6 Total Likes
| RevealA rather different way of producing cross sections. Here a bunch of parallel lines starting at $z=1$ and $z=-1$ move towards the $xy$-plane, getting hung up on a torus of revolution as they go. The end result is a bunch of cross sections of the torus, now realized as a sort of relief.Here's the (super-slow) code, which could undoubtedly be streamlined: ϕ[s_] := 2 + Cos[s]; ψ[s_] := Sin[s]; DynamicModule[{torus, cols, r, s}, torus[x_, y_] := {ϕ[v] Cos[u], ϕ[v] Sin[u], ψ[v]} /. {u -> ArcTan[x, y], v -> ArcCos[Sqrt[x^2 + y^2] - 2]}; cols = RGBColor /@ {"#5FC9F3", "#081F37"}; r = 2.7; Manipulate[ s = 1/2 + 1/2 Cos[θ]; ParametricPlot3D[ Table[{x, y, If[1 < x^2 + y^2 < 9, i Max[s, torus[x, y][]], i s]}, {i, {-1, 1}}, {x, -4.5, 4.5, 1/4}], {y, -4, 4}, PlotStyle -> Directive[Thickness[.003], cols[]], PlotRange -> {{-4.5, 4.5}, {-4.5, 4.5}, {-1.5, 1.5}}, PlotPoints -> 200, Boxed -> False, Axes -> None, ViewPoint -> 100 {1, 0, r}, ViewAngle -> π/(4*100*Sqrt[1 + r^2]), ImageSize -> 540, Background -> cols[]], {θ, 0, π}]] Answer
4 Replies
Sort By:
Posted 3 years ago
 Clayton, this is a cool animation, I really like the approach. But the code with the Dynamic and Manipulate ran so slow that I couldn't even see an animation. When I try to make a plot for just a single value of theta, it takes about 10 seconds on my machine. I was able to get this to about half a second by simplifying the plotted function and compiling it. It was still too slow for Manipulate in my opinion, so I made a list of images before plotting funcsc = Compile[{{th, _Real}, {y, _Real}}, Evaluate@Table[ With[{x = x, i = i, s = 1/2 + 1/2 Cos[th]}, {x, y, If[1 < x^2 + y^2 < 9, i Max[s, Sin[ArcCos[Sqrt[x^2 + y^2] - 2]]], i s]}], {i, -1, 1}, {x, -4.5, 4.5, 1/4}] ]; cols = RGBColor /@ {"#5FC9F3", "#081F37"}; r = 2.7; imglist = Table[ParametricPlot3D[funcsc[θ, y] , {y, -4, 4}, PlotStyle -> Directive[Thickness[.003], cols[]], PlotRange -> {{-4.5, 4.5}, {-4.5, 4.5}, {-1.5, 1.5}}, PlotPoints -> 100, Boxed -> False, Axes -> None, ViewPoint -> 100 {1, 0, r}, ViewAngle -> π/(4*100*Sqrt[1 + r^2]), ImageSize -> 540, Background -> cols[]], {θ, 0, 2 π, .1}];~Monitor~θ  Answer
Posted 3 years ago
 @Jason Biggs Ah, yes, compiling the function is smart. One quibble with your definition: you have an extraneous $i=0$ row in the table that just produces straight lines sitting at $z=0$. So I would define funcsc like this: funcsc = Compile[{{th, _Real}, {y, _Real}}, Evaluate@ Table[With[{x = x, i = i, s = 1/2 + 1/2 Cos[th]}, {x, y, If[1 < x^2 + y^2 < 9, i Max[s, Sin[ArcCos[Sqrt[x^2 + y^2] - 2]]], i s]}], {i, {-1, 1}}, {x, -4.5, 4.5, 1/4}]]; But otherwise, your code is definitely faster, which would have come in handy when I was rendering the GIF last night. Answer
Posted 3 years ago - another post of yours has been selected for the Staff Picks group, congratulations !We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming! Answer
Posted 3 years ago
 @Moderation Team Cool, thanks! Answer