Suppose $\gamma$ be a given closed curve. Does anyone know how to plot a surface over the $\gamma$ with (Image of) the following equation: $$\begin{aligned} f:\gamma\times \gamma&\to \Bbb R^3\\ (x,y)&\mapsto \left(\frac{x+y}{2},\|x-y\|\right) \end{aligned}$$ I have seen this function here.
3 Answers
$\begingroup$
$\endgroup$
4
Can't watch this episode now so I will focus only on what you've written.
I think what you ask can be done as follows:
γ[t_] := {Sin[t], Sin[2 t], 0};
Show[
ParametricPlot3D[γ[u], {u, 0, 2 Pi}, PlotStyle -> Red]
, ParametricPlot3D[(γ[u] + γ[v])/2 + {0, 0, Norm[γ[v] - γ[u]]}
, {u, 0, 2 Pi}, {v, 0, 2 Pi}
, PlotStyle -> [email protected]
]
, PlotRange -> All
]
-
$\begingroup$ Thanks @Kuba. Is it possible to plot this surface in
Maple
? because I don't haveMathematica
. $\endgroup$– C.F.GCommented Jan 8, 2018 at 12:18 -
1$\begingroup$ @C.F.G I don't know :) this site is about Wolfram Mathematica software. But if there is something like parametricPlot3D there should be no problem. $\endgroup$– KubaCommented Jan 8, 2018 at 12:20
-
$\begingroup$ Is it possible plot online in wolfram web as above? $\endgroup$– C.F.GCommented Jan 8, 2018 at 12:24
-
$\begingroup$ @C.F.G try sandbox.open.wolframcloud.com $\endgroup$– KubaCommented Jan 8, 2018 at 12:29
$\begingroup$
$\endgroup$
Consider this arbitrary simple closed curve (hand drawn):
This was parametrized as follows:
xs = cd[[All, 1]]~Join~{cd[[1, 1]]};
ys = cd[[All, 2]]~Join~{cd[[1, 2]]};
ix = Interpolation[xs];
iy = Interpolation[ys];
ixf[t_] := ix[Rescale[t, {0, 2 Pi}, {1, 85}]];
iyf[t_] := iy[Rescale[t, {0, 2 Pi}, {1, 85}]];
par[t_] := {ixf[t], iyf[t]};
ParametricPlot[par[t], {t, 0, 2 Pi}]
Now to simulate video:
func[f_, u_, v_] := ((f[u] + f[v])/2)~Join~{Norm[f[u] - f[v]]}
lns[f_, u_, v_] :=
With[{p1 = f[u]~Join~{0}, p2 = f[v]~Join~{0}},
Graphics3D[{PointSize[0.04], Red, Point[p1], Blue, Point[p2],
Line[{p1, p2}], Green, Point[(p1 + p2)/2], Black, Thick,
Line[{(p1 + p2)/2, (p1 + p2)/2 + {0, 0, Norm[p1 - p2]}}]}]]
Manipulate[Show[pp, lns[par, a, b]], {a, 0, 2 Pi}, {b, 0, 2 Pi},
Initialization :> (pp =
ParametricPlot3D[func[par, u, v], {u, 0, 2 Pi}, {v, 0, 2 Pi},
MeshFunctions -> {#3 &}, Mesh -> 10, PlotStyle -> Opacity[0.1],
PerformanceGoal -> "Quality", PlotPoints -> 25])]
$\begingroup$
$\endgroup$
2
For example let's take the closed curve
k[φ_] := {Cos[φ], Sin[φ ],Sin[2 φ]};
ParametricPlot3D[k[φ], {φ, 0, 2 Pi}, Axes -> False]
For two point k[φ1] , k[φ2]
the projection you are looking for can be created using
Show[{
ParametricPlot3D[(k[\[CurlyPhi]1] + k[\[CurlyPhi]2])/2 + (k[\[CurlyPhi]1] +k[\[CurlyPhi]2])/ Sqrt[(k[\[CurlyPhi]1] + k[\[CurlyPhi]2]).(k[\[CurlyPhi]1]+k[\[CurlyPhi]2])]Sqrt[(k[\[CurlyPhi]1] - k[\[CurlyPhi]2]).(k[\[CurlyPhi]1] -k[\[CurlyPhi]2])]
, {\[CurlyPhi]1, 0, 2 Pi}, {\[CurlyPhi]2, 0,
2 Pi}, Mesh -> None, Boxed -> False, Axes -> False,PlotStyle -> Opacity[0.5]]
, ParametricPlot3D[k[\[CurlyPhi]], {\[CurlyPhi], 0, 2 Pi},Axes -> False,PlotStyle -> Red]
}]
-
$\begingroup$ I'm not sure how to interpret the question for general 3D closed curve but your solution does not match mine in 2D case. I don't claim mine is correct though. $\endgroup$– KubaCommented Jan 8, 2018 at 11:14
-
$\begingroup$ In my approach the surface point[k1,k2] is
(k1+k2)/2+Normalize[k1+k2] |k1-k2]
$\endgroup$ Commented Jan 8, 2018 at 11:33
((x+y)/2, ||x-y||)
is. Also, a curve example is always a good idea (and clarifies the first issue automatically). $\endgroup$