Function Repository Resource:

FocalSet

Compute the focal set of a surface

Contributed by: Wolfram Staff (original content by Alfred Gray)

ResourceFunction["FocalSet"][i,s,{u,v}]

gives a parametrization of the i^th focal set of a surface s parametrized by u and v.

Details and Options

i must be either 1 or 2.

The i^th focal set of a surface s parametrized by u and v is defined as z_i(u,v)=s(u,v)+U(u,v)/k_i, where k_i is the i^th principal curvature of s and U is its unit normal.

The two focal sets can be two surfaces, a curve and a surface or two curves.

Examples

Basic Examples (2)

Define a hyperbolic paraboloid:

In[1]:=

$ellipticparaboloid[a_, b_][u_, v_] := {u, v, u^2/a^2 + v^2/b^2} hyperbolicparaboloid[u_, v_] := {u, v, u v}$

The focal sets of the hyperbolic paraboloid are given by:

In[2]:=

Out[3]=

Plot an hyperbolic paraboloid (yellow) and its focal sets (blue and green):

In[4]:=

$Module[{f}, f[0] = hp; f[i_] := fshp[[i]]; ParametricPlot3D[ Evaluate[Table[f[i], {i, 0, 2}]], {u, -1, 1}, {v, -1, 1}]]$

Out[4]=

Define an elliptic paraboloid:

In[5]:=

$ellipticparaboloid[a_, b_][u_, v_] := {u, v, u^2/a^2 + v^2/b^2} hyperbolicparaboloid[u_, v_] := {u, v, u v}$

The focal sets of an elliptic paraboloid are given by:

In[6]:=

Out[6]=

Plot an elliptic paraboloid (yellow) and its focal sets (blue and green):

In[7]:=

$Module[{f}, f[0] = ep; f[i_] := fsep[[i]]; ParametricPlot3D[ Evaluate[ Table[f[i] /. {u -> r Cos[\[Theta]], v -> r Sin[\[Theta]]}, {i, 0, 2}]], {r, 0, .5}, {\[Theta], 0, 2 \[Pi]}]]$

Out[7]=

Scope (4)

A circular helicoid:

In[8]:=

$helicoid[a_, c_][u_, v_] := {a v Cos[u], a v Sin[u], c u}$

Here are the two focal sets of the helicoid:

In[9]:=

Out[9]=

Plot the focal sets:

In[10]:=

$ParametricPlot3D[#, {u, -\[Pi], \[Pi]}, {v, -2, 2}] & /@ fshel$

Out[10]=

Compute the focal sets of a monkey saddle:

In[11]:=

Out[11]=

Plot of the focal sets of the monkey saddle:

In[12]:=

$Module[{f}, f[0][u, v] = Entity["Surface", "MonkeySaddle"]["ParametricEquations"][1][u, v]; f[i_][u_, v_] := ResourceFunction["FocalSet"][i, f[0][u, v], {u, v}]; ParametricPlot3D[ Evaluate[ Table[f[i][u, v], {i, 0, 2}] /. {u -> r Cos[\[Theta]], v -> r Sin[\[Theta]]}], {r, 0.1, .85}, {\[Theta], 0, 2 \[Pi]}, PlotPoints -> {50, 30}, MaxRecursion -> 5, ViewPoint -> {-1.9, -2.73, 0.6}]]$

Out[12]=

It will be shown in the next example that one of the focal sets of a surface of revolution generated by a plane curve c is the surface of revolution generated by the evolute of c. First define a tractrix:

In[13]:=

$tractrix[a_, t_] := a {Sin[t], Cos[t] + Log[Tan[t/2]]}$

Here is its evolute, as returned by the resource function EvoluteCurve:

In[14]:=

$\[Epsilon] = ResourceFunction["EvoluteCurve"][tractrix[a, t], t] // Simplify$

Out[14]=

The evolute of a tractrix is a catenary:

In[15]:=

$\[Alpha] = tractrix[1, t]; \[Epsilon] = ResourceFunction["EvoluteCurve"][\[Alpha], t]; ParametricPlot[{\[Alpha], \[Epsilon]}, {t, 0.01, \[Pi]}, Axes -> None]$

Out[6]=

Define a catenoid, i.e. the surface of revolution of a catenary:

In[16]:=

$catenoid[c_][u_, v_] := {c Cos[u] Cosh[v/c], c Sin[u] Cosh[v/c], v}$

Define a surface of revolution:

In[17]:=

$pseudosphere[a_][u_, v_] := a {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v] + Log[Tan[v/2]]}$

Compute its focal set for the first curvature:

In[18]:=

Out[18]=

Plot the pseudosphere and the catenoid (the surface of revolution of a catenary) focal sets:

In[19]:=

$pr = 1.6; z[1] = ParametricPlot3D[ Evaluate[pseudosphere[1][u, v]], {u, 0, (3 \[Pi])/ 2}, {v, .05, \[Pi] - .05}]; z[2] = ParametricPlot3D[ Evaluate[ca], {u, 0, (3 \[Pi])/2}, {v, .7, \[Pi] - .7}]; Show[Array[z, 2], PlotRange -> {{-pr, pr}, {-pr, pr}, Automatic}]$

Out[22]=

Define an elliptic‐hyperbolic cyclide:

In[23]:=

$ellhypcyclide[a_, c_, k_][u_, v_] := Module[{A, B, s}, A = k - c Cos[u]; B = a - k Cos[v]; s = Sqrt[a^2 - c^2]; {c A + a Cos[u] B, s B Sin[u], s A Sin[v]}/( a - c Cos[u] Cos[v])]$

Compute its focal sets:

In[24]:=

Out[24]=

Define a function to generate a cyclide together with its focal curves:

In[25]:=

$cycgen[a_, c_, k_, rau_, rav_, opts___] := Module[{x, z, \[Alpha], \[Beta]}, x = ellhypcyclide[a, c, k]; z[1] = ParametricPlot3D[x[u, v], rau, rav, opts, Boxed -> False, Axes -> False]; \[Alpha][t_] := {a Cos[t], Sqrt[a^2 - c^2] Sin[t], 0}; \[Beta][t_] := {c Sec[t], 0, Sqrt[a^2 - c^2] Tan[t]}; z[2] = ParametricPlot3D[\[Alpha][t], {t, -\[Pi], \[Pi]}]; z[3] = ParametricPlot3D[\[Beta][t], {t, -.499 \[Pi], .499 \[Pi]}]; Show[Array[z, 3], PlotRange -> {{-a - c - k, a + c + k}, {-a - c - k, a + c + k}, {-a - c - k, a + c + k}}]]$

The ring cyclide with its focal curves:

In[26]:=

$x = ellhypcyclide[12, 3, 4.5]; z[1] = ParametricPlot3D[ Evaluate[x[u, v]], {u, 0, 2 \[Pi]}, {v, 0, 2 \[Pi]}, Boxed -> False, Axes -> False, PlotRange -> 19.5]; z[2] = cycgen[12, 3, 4.5, {u, 0, 2 \[Pi]}, {v, -\[Pi], 0}]; GraphicsGrid[{Array[z, 2]}]$

Out[18]=

The horn cyclide with its focal curves:

In[27]:=

$x = ellhypcyclide[8, 4, 0]; z[1] = ParametricPlot3D[ Evaluate[x[u, v]], {u, 0, 2 \[Pi]}, {v, 0, 2 \[Pi]}, Boxed -> False, Axes -> False, PlotRange -> 12]; z[2] = cycgen[8, 4, 0, {u, 0, 2 \[Pi]}, {v, -\[Pi], 0}]; GraphicsGrid[{Array[z, 2]}]$

Out[30]=

The spindle cyclide with its focal curves:

In[31]:=

$Module[{x, z}, x = ellhypcyclide[12, 4, 4]; z[1] = ParametricPlot3D[x[u, v] // Evaluate, {u, 0, 2 \[Pi]}, {v, 0, 2 \[Pi]}, Boxed -> False, Axes -> False, PlotRange -> 20]; z[2] = cycgen[12, 4, 4, {u, 0, 2 \[Pi]}, {v, -\[Pi], 0}]; GraphicsGrid[{Array[z, 2]}] ]$

Out[31]=

Publisher

Enrique Zeleny

Version History

1.0.0 – 24 April 2020

Source Metadata

Citation:
- Abbena, E., Salamon, S., Gray, A., Modern Differential Geometry of Curves and Surfaces with Mathematica, 3rd ed. Boca Raton, FL: Chapman & Hall/CRC, 2006.

Related Resources

License Information

This work is licensed under a Creative Commons Attribution 4.0 International License