Superellipse

Author

Eric W. Weisstein
June 6, 2014

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneCurves/Superellipse.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Superellipse.html.

©2014 Wolfram Research, Inc. except for portions noted otherwise

Equation

Implicit

Eliminate[{x==a Cos[t]^r,y==b Sin[t]^r,Cos[t]^2+Sin[t]^2==1},{Cos[t],Sin[t]}]

Eliminate[{x==a Cos[t]^q,y==b Sin[t]^q,Cos[t]^2+Sin[t]^2==1},{Cos[t],Sin[t]}]/.q->2/r

Parametric

<<Graphics`Colors`

t

Solve[(x/a)^r+(y/b)^r==1,y]

Limit[{t,b (((1-((((t/a)))^r)))^(1/r))},t->#,Assumptions->{r>0,a>0,b>0}]&/@{0,a}

With[{a=1,b=1,r=2/3},ParametricPlot[{t,b (((1-((((t/a)))^r)))^(1/r))},
{t,0,a},AspectRatio->Automatic,PlotStyle->Red]
]

Cos,Sin t

ParametricPlot[{Cos[t]^3,Sin[t]^3},{t,0,Pi/2},AspectRatio->Automatic,PlotStyle->Red]

Range of Exponents

Solve[x^r+y^r==1,y]

{-1,1}#&/@{1,2}

r1=.3;
r2=3.;
dr=.1;
Show[GraphicsArray[{
Plot[Evaluate[Transpose[{-1,1}#&/@Table[(1-Abs[x]^r)^(1/r),{r,r1,r2,dr}]]],
{x,-1,1},
PlotStyle->Table[{Thickness[.015],Hue[(r-r1)/(r2-r1)]},{r,r1,r2,dr}],
Ticks->None,DisplayFunction->Identity,AspectRatio->Automatic
],
Plot[Evaluate[Transpose[{-1,1}#&/@Function[r,(1-Abs[x]^r)^(1/r)]/@{2/3,1,2}]],
{x,-1,1},
PlotStyle->Red,DisplayFunction->Identity,
Ticks->None,AspectRatio->Automatic
]
}]]

ContourPlot[Abs[x/#1]^(2/#3)+Abs[y/#2]^(2/#3)==1,{x,-2,2},{y,-2,2}]&@@@{{1,1,3},{1,1,2.5},{1,1,2},{1,1.5,2},{1,1,2/3},{1,1,1}}

ParametricPlot[{#1 Cos[t]^(2/#3),#2 Sin[t]^(2/#3)},{t,0,2π}]&@@@{{1,1,3},{1,1,2},{1,1.5,2},{1,1,2/3},{1,1,1.001}}

Filled Plots for ((Abs[x])^p)+((Abs[y])^q)≤1

<<Graphics`InequalityGraphics`

Show[GraphicsArray[ 
Table[InequalityPlot[((Abs[x])^p)+((Abs[y])^q)≤1,{x,-1,1},{y,-1,1},Ticks-> None, DisplayFunction->Identity],{p,4},{q,4} ]
]]

Properties

curve={Cos[q],Sin[q]}(Abs[Cos[m q/4]/a]^β+Abs[Sin[m q/4]/b]^γ)^(-1/α);

ArcLength

Cos,Sin

FullSimplify[Sqrt[#.#]&[D[{a Cos[t]^(2/r),b Sin[t]^(2/r)},t]],r>0]

Integrate[((2 (Sqrt[(a^2) ((Cos[t])^(-2+(4/r))) ((Sin[t])^2)+(b^2) ((Cos[t])^2) ((Sin[t])^(-2+(4/r)))]))/r),t]//Timing

Integrate[((2 (Sqrt[(a^2) ((Cos[t])^(-2+(4/r))) ((Sin[t])^2)+(b^2) ((Cos[t])^2) ((Sin[t])^(-2+(4/r)))]))/r),{t,0,2Pi},Assumptions->a>0&&b>0&&r>0]//Timing

Special cases

Circle

With[{b=a,r=2},Integrate[((2 (Sqrt[(a^2) ((Cos[t])^(-2+(4/r))) ((Sin[t])^2)+(b^2) ((Cos[t])^2) ((Sin[t])^(-2+(4/r)))]))/r),{t,0,2Pi},Assumptions->a>0&&b>0&&r>0]]

Ellipse

With[{r=2},Integrate[((2 (Sqrt[(a^2) ((Cos[t])^(-2+(4/r))) ((Sin[t])^2)+(b^2) ((Cos[t])^2) ((Sin[t])^(-2+(4/r)))]))/r),{t,0,Pi/2},Assumptions->Assumptions->0<b<a]]

FullSimplify[%,0<b<a]

With[{r=2},Integrate[((2 (Sqrt[(a^2) ((Cos[t])^(-2+(4/r))) ((Sin[t])^2)+(b^2) ((Cos[t])^2) ((Sin[t])^(-2+(4/r)))]))/r),{t,0,2Pi},Assumptions->0<b<a]]

FullSimplify[%]

FullSimplify[%,a>0&&b>0]

Diamond

With[{r=1},Integrate[((2 (Sqrt[(a^2) ((Cos[t])^(-2+(4/r))) ((Sin[t])^2)+(b^2) ((Cos[t])^2) ((Sin[t])^(-2+(4/r)))]))/r),{t,0,2Pi},Assumptions->0<b<a]]

Astroid

With[{r=2/3},Integrate[((2 (Sqrt[(a^2) ((Cos[t])^(-2+(4/r))) ((Sin[t])^2)+(b^2) ((Cos[t])^2) ((Sin[t])^(-2+(4/r)))]))/r),{t,0,2Pi},Assumptions->0<b<a]]

b (((1-((((t/a)))^r)))^(1/r))

FullSimplify[Sqrt[1+D[b (((1-((((t/a)))^r)))^(1/r)),t]^2],a>0&&b>0&&r>0&&t>0]

Special Cases

Astroid

4With[{b=a,r=2/3},Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a},Assumptions->a>0]]

4With[{r=2/3},Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a},Assumptions->a>0&&b>0&&a≠b]]

Circle

4With[{b=a,r=2},Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a},Assumptions->a>0]]

Ellipse

With[{r=2},Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a},Assumptions->0<b<a]]

With[{a=1,b=1/2},N[-a EllipticE[1-((b^2)/(a^2))]]]

With[{r=2,a=1,b=1/2},NIntegrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a}]]

Diamond

4With[{b=a,r=1},Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a},Assumptions->a>0]]

Hein's superellipse

v4.2

4With[{b=a,r=5/2},Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a},Assumptions->a>0]]

With[{r=5/2},FullSimplify[Together[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))],a>0&&t>0]]

Integrate[(((a^(5/2))-(t^(5/2))+(((b^2) (t^3))/((a^(5/2)) (((1-(1/((((a/t)))^(5/2)))))^(1/5)))))/((a^(5/2))-(t^(5/2)))),{t,0,a}]

v5.0

4With[{b=a,r=5/2},Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a},Assumptions->a>0]]

With[{a=1},NIntegrate[(((a^(5/2))-(t^(5/2))+(((b^2) (t^3))/((a^(5/2)) (((1-(1/((((a/t)))^(5/2)))))^(1/5)))))/((a^(5/2))-(t^(5/2)))),{t,0,a}]]

Integrate[Sqrt[(((a^(5/2))-(t^(5/2))+(((b^2) (t^3))/((a^(5/2)) (((1-(1/((((a/t)))^(5/2)))))^(1/5)))))/((a^(5/2))-(t^(5/2))))],{t,0,a}]

Integrate[(((a^(5/2))-(t^(5/2))+(((b^2) (t^3))/((a^(5/2)) (((1-(1/((((a/t)))^(5/2)))))^(1/5)))))/((a^(5/2))-(t^(5/2)))),{t,0,a},Assumptions->a>0]

Attempt to make series

Series[(t^2)+(b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))),{t,0,4}]

Numerical Check

ivalues=Table[{Random[Real,{0,3}],Random[Real,{0,3}],Random[Real,{0,3}]},{5}]

ivalues

ivalues={{1.6910531640977187`,0.0967239705180028`,1.7668387814359705`},{0.18245029319129283`,1.0276723763541618`,1.6423912287625932`},{2.497271797493085`,2.1166222515501736`,0.2285031438607264`},{2.832253619690242`,0.19740043283833741`,0.4548082937242404`},{0.9599135180218092`,2.993968838159511`,1.1315721327880341`}};

With[{a=#1,b=#2,r=#3},NIntegrate[Evaluate[SetPrecision[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),Infinity]],{t,0,a}]]&@@@ivalues

Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a},Assumptions->{a>0&&b>0&&r>0}]

With[{a=#1,b=#2,r=#3},Integrate[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),{t,0,a}]]&@@@ivalues

cvalues=Table[{Random[Complex,{0,2I}],Random[Complex,{0,2I}],Random[Real,{0,2}]},{5}]

With[{a=#1,b=#2,r=#3},NIntegrate[Evaluate[SetPrecision[(Sqrt[1+(((b^2) ((((t/a)))^(2 r)) (((1-((((t/a)))^r)))^(-2+(2/r))))/(t^2))]),17]],{t,0,a}]]&@@@cvalues

Area

Solve[(x/a)^r+(y/b)^r==1,y]

4Integrate[b (((1-((((x/a)))^r)))^(1/r)),{x,0,a},Assumptions->a>0&&r≥0]//Timing

Integrate[Boole[((Abs[x])^r)+((Abs[y])^r)],{x,-∞,∞},{y,-∞,∞}]//Timing

Integrate[Boole[((Abs[x])^r)+((Abs[y])^r)],{x,-∞,∞},{y,-∞,∞},Assumptions->r≥0]//Timing

AreaInertiaTensor

AreaInertiaTensor[a>0&&b>0&&r>0,Centroid[Abs[x/a]^r+Abs[y/b]^r<1,{x,y}]]//Timing

Centroid

Assuming[a>0&&b>0&&r>0,Centroid[Abs[x/a]^r+Abs[y/b]^r<1,{x,y}]]//Timing

ImplicitCurvature

FullSimplify[ImplicitCurvature[Abs[x/a]^r+Abs[y/b]^r-1/.Abs[t_]:>Sqrt[t^2],{x,y}],a>0&&b>0&&r>0]

Slope

FullSimplify[Slope[Sqrt[(x/a)^2]^r+Sqrt[(y/b)^2]^r==1,{x,y}],r>0&&a>0&&b>0&&(x|y)∈Reals]

ByteCount/@%

FullSimplify[((y-(b^r) y (1/((Abs[y])^r)))/x)]

ByteCount[%]

SpecialAffineCurvature

FullSimplify[SpecialAffineCurvature[curve,t],a>0&&0<t<2π]

((Abs[(Subscript[x, 1])])^(Subscript[p, 1]))+((Abs[(Subscript[x, 2])])^(Subscript[p, 2]))+…

(∫_(-∞)^∞)Boole[((|x|)^p)<1]dx

Integrate[Boole[((Abs[x])^p)<1],{x,-∞,∞}]

Integrate[Boole[x^p<1],{x,-∞,∞}]

Table[(∫_(-∞)^∞)Boole[((Abs[x])^p)<1]\[DifferentialD]x,{p,5}]

(∫_(-∞)^∞)Boole[((|x|)^p)+((|y|)^q)<1]dxdy

(∫_(-∞)^∞)Boole[|x|+|y|<1]dxdy

Table[Integrate[Boole[Abs[x]+((Abs[y])^p)<1],{y,-∞,∞},{x,-∞,∞}],{p,20}]

Through[{Numerator,Denominator}[%]]

(∫_(-∞)^∞)Boole[((|x|)^p)+((|y|)^p)<1]dxdy

4b Integrate[(((1-((((x/a)))^r)))^(1/r)),{x,0,a},Assumptions->a>0&&r≥0]

Table[(((4^(1-1/r))(Sqrt[π])Gamma[1+(1/r)])/(Gamma[(1/2)+(1/r)])),{r,10}]//FullSimplify

<<Utilities`Simplify`

GammaSimplify[FullSimplify[GammaSimplify[%49]]]

(∫_(-∞)^∞)Boole[((|x|)^p)+((|x|)^q)<1]dx

Integrate[Boole[((Abs[x])^p)+((Abs[y])^q)<1],{y,-∞,∞},{x,-∞,∞}]

Table[NIntegrate[Boole[((Abs[x])^p)+((Abs[y])^q)<1],{y,-∞,∞},{x,-∞,∞}],{p,5},{q,5}]

Table[Integrate[Boole[((Abs[x])^p)+((Abs[y])^q)<1],{y,-∞,∞},{x,-∞,∞}],{p,2},{q,5}]

Gielis's "Superformula"

<<Graphics`Graphics`

Superformula[{a_,b_,m_},{n1_,n2_,n3_},phi_]:=(Abs[Cos[m phi/4]/a]^n2+Abs[Sin[m phi/4]/b]^n3)^(-1/n1)

Gielis's natural supershapes

Show[GraphicsArray[
Graphics[#,Ticks->None,Axes->True,AspectRatio->Automatic]&/@(PolarPlot[Superformula[Sequence@@Rest[#],ϕ],{ϕ,0,2π},
PlotLabel->First[#],TextStyle->{FontFamily->"Times",FontSlant->"Italic",FontSize->10},
Axes->None,
DisplayFunction->Identity]&/@{
{"Nuphar luteum",{1,1,3},{4.5,10,10}},
{"Scrophularia nodosa",{1,1,4},{12,15,15}},
{"Equisetum",{1,1,7},{10,6,6}},
{"raspberry",{1,1,5},{4,4,4}},
{"starfish",{10,10,5},{2,7,7}}
}/.Line[x_]:>{{Hue[1/2],Polygon[x]},Line[x]})
]]

Gielis's array

l={2,500,500,1980,1000,620,390,320,250};

Show[GraphicsArray[
Table[PolarPlot[Superformula[Sequence@@#,ϕ],{ϕ,0,2π},
DisplayFunction->Identity,
PlotStyle->Red,Ticks->None]&/@{
{{1,1,m},{1,1,1}},
{{1,1,m},{1000,l[[m+1]],l[[m+1]]}},
{{1,1,m},{1,1,1}/2},
{{1,1,m},{30,15,15}}
},{m,0,8}]
]]

Array as a function of m and n==(Subscript[n, 1])==(Subscript[n, 2])==(Subscript[n, 3])

Show[GraphicsArray[
Table[PolarPlot[Superformula[{1,1,m},{n,n,n},ϕ],{ϕ,0,2π},
DisplayFunction->Identity,
PlotStyle->Red,Ticks->None],
{n,.5,2,.5},{m,0,8}]
]]

Array for values of m with a range of values of n==(Subscript[n, 1])==(Subscript[n, 2])==(Subscript[n, 3]) in each plot

With[{max=2,steps=10},
Show[GraphicsArray[
Partition[
Table[PolarPlot[Evaluate[Table[Superformula[{1,1,m},{n,n,n},ϕ],{n,1/steps,max,max/steps}]],{ϕ,0,2π},
DisplayFunction->Identity,
PlotStyle->Red,Ticks->None],
{m,8}],4]
]]
]

With[{max=2,steps=100},
Show[GraphicsArray[
Partition[
Table[PolarPlot[Evaluate[Table[Superformula[{1,1,m},{n,n,n},ϕ],{n,1/steps,max,max/steps}]],{ϕ,0,2π},
DisplayFunction->Identity,
PlotStyle->Evaluate[{Thickness[.01],Hue[#]}&/@Range[0,1,1/steps]],Ticks->None],
{m,8}],4]
]]
]

Properties

Area

Curvature

abs[x_]:=Sqrt[x^2]

FullSimplify[Curvature[(abs[Cos[m q/4]/a]^β+abs[Sin[m q/4]/b]^γ)^(-1/α),q]]

Slope

FullSimplify[Slope[{Cos[q],Sin[q]}(Sqrt[(Cos[m q/4]/a)^2]^beta+Sqrt[(Sin[m q/4]/b)^2]^gamma)^(-1/alpha),q],a>0&&b>0]

FullSimplify[Slope[(Sqrt[(Cos[m q/4]/a)^2]^beta+Sqrt[(Sin[m q/4]/b)^2]^gamma)^(-1/alpha),q],a>0&&b>0]

Vector Properties

parm={Cos[q],Sin[q]}(Abs[Cos[m q/4]/a]^beta+Abs[Sin[m q/4]/b]^gamma)^(-1/alpha);
assum=0<t<2π;
xform={Abs[x_]^(n_/;Mod[n,2]==0):>x^n,Sqrt[x_^(n_/;Mod[n,2]==0)]:>Abs[x]^(n/2)};

VectorLength

Assuming[assum,FullSimplify[Norm[parm]/.xform]]/.xform

NormalVector

Assuming[assum,FullSimplify[NormalVector[parm,q]/.xform]]/.xform//Timing

TangentVector

Assuming[assum,FullSimplify[TangentVector[parm,q]/.xform]]/.xform//Timing