Math Is Fun Forum

lanxiyu

Member

Registered: 2022-05-10

Posts: 64

Mathematica implementation of lemniscate functions

BeginPackage["Lemniscate`"];

Unprotect[
	LemniscateSin, LemniscateCos, LemniscateTan, LemniscateCot, LemniscateSinh, LemniscateCosh, LemniscateSinhPrime, LemniscateCoshPrime, LemniscateTanh, LemniscateCoth,
	InverseLemniscateSin, InverseLemniscateCos, InverseLemniscateTan, InverseLemniscateCot, InverseLemniscateSinh, InverseLemniscateCosh, InverseLemniscateTanh, InverseLemniscateCoth
];

ClearAll[
	LemniscateSin, LemniscateCos, LemniscateTan, LemniscateCot, LemniscateSinh, LemniscateCosh, LemniscateSinhPrime, LemniscateCoshPrime, LemniscateTanh, LemniscateCoth,
	InverseLemniscateSin, InverseLemniscateCos, InverseLemniscateTan, InverseLemniscateCot, InverseLemniscateSinh, InverseLemniscateCosh, InverseLemniscateTanh, InverseLemniscateCoth
];

Begin["`Private`"];

LemniscateSin[z_] /; (z == 0) := z;

LemniscateSin[z_?InexactNumberQ] := JacobiSN[z, -1];

LemniscateSin /: HoldPattern[LemniscateSin'] :=
	LemniscateCos[#]*(1 + LemniscateSin[#]^2) &;

LemniscateSin /: MakeBoxes[LemniscateSin[z_], TraditionalForm] :=
	RowBox[{InterpretationBox["sl", LemniscateSin, Editable -> False, Selectable -> False, Tooltip -> "LemniscateSin"], "(", ToBoxes[z], ")"}]

LemniscateCos[z_] /; (z == 0) := 1 - z^2;

LemniscateCos[z_?InexactNumberQ] := JacobiCD[z, -1]

LemniscateCos /: HoldPattern[LemniscateCos'] :=
	-LemniscateSin[#]*(1 + LemniscateCos[#]^2) &;

LemniscateCos /: MakeBoxes[LemniscateCos[z_], TraditionalForm] :=
	RowBox[{InterpretationBox["cl", LemniscateCos, Editable -> False, Selectable -> False, Tooltip -> "LemniscateCos"], "(", ToBoxes[z], ")"}]

LemniscateTan[z_] /; (z == 0) := z;

LemniscateTan[z_?InexactNumberQ] :=
	JacobiSC[z, -1]*Sqrt[JacobiCD[z, -1]];

LemniscateTan /: HoldPattern[LemniscateTan'] :=
	LemniscateCot[#]^3 &;

LemniscateTan /: MakeBoxes[LemniscateTan[z_], TraditionalForm] :=
	RowBox[{InterpretationBox["tl", LemniscateTan, Editable -> False, Selectable -> False, Tooltip -> "LemniscateTan"], "(", ToBoxes[z], ")"}]

LemniscateCot[z_] /; (z == 0) := 1 + z^4/4;

LemniscateCot[z_?InexactNumberQ] :=
	JacobiNC[z, -1]*Sqrt[JacobiCD[z, -1]];

LemniscateCot /: HoldPattern[LemniscateCot'] :=
	LemniscateTan[#]^3 &;

LemniscateCot /: MakeBoxes[LemniscateCot[z_], TraditionalForm] :=
	RowBox[{InterpretationBox["tl", LemniscateCot, Editable -> False, Selectable -> False, Tooltip -> "LemniscateCot"], "(", ToBoxes[z], ")"}]

LemniscateSinh[z_] /; (z == 0) := z;

LemniscateSinh[z_?InexactNumberQ] :=
	JacobiSN[z, 1/2]*JacobiDC[z, 1/2];

LemniscateSinh /: HoldPattern[LemniscateSinh'] :=
	LemniscateSinhPrime;

LemniscateSinh /: MakeBoxes[LemniscateSinh[z_], TraditionalForm] :=
	RowBox[{InterpretationBox["slh", LemniscateSinh, Editable -> False, Selectable -> False, Tooltip -> "LemniscateSinh"], "(", ToBoxes[z], ")"}]

LemniscateSinhPrime[z_] /; (z == 0) := 1 + z^4/2;

LemniscateSinhPrime[z_?InexactNumberQ] :=
With[{t = JacobiCN[z, 1/2]^2},
	(t + t^(-1))/2
];

LemniscateSinhPrime /: HoldPattern[LemniscateSinhPrime'] :=
	2*LemniscateSinh[#]^3 &;

LemniscateSinhPrime /: MakeBoxes[LemniscateSinhPrime[z_], TraditionalForm] :=
	RowBox[{InterpretationBox[SuperscriptBox["slh", "\[Prime]"], LemniscateSinhPrime, Editable -> False, Selectable -> False, Tooltip -> "LemniscateSinhPrime"], "(", ToBoxes[z], ")"}]

LemniscateCosh[z_] /; (z == 0) := z^(-1);

LemniscateCosh[z_?InexactNumberQ] :=
	JacobiNS[z, 1/2]*JacobiCD[z, 1/2];

LemniscateCosh /: HoldPattern[LemniscateCosh'] :=
	LemniscateCoshPrime;

LemniscateCosh /: MakeBoxes[LemniscateCosh[z_], TraditionalForm] :=
	RowBox[{InterpretationBox["clh", LemniscateCosh, Editable -> False, Selectable -> False, Tooltip -> "LemniscateCosh"], "(", ToBoxes[z], ")"}]

LemniscateCoshPrime[z_] /; (z == 0) := -z^(-2);

LemniscateCoshPrime[z_?InexactNumberQ] :=
With[{t = JacobiSD[z, 1/2]^2},
	-(t^(-1) + t/4)
];

LemniscateCoshPrime /: HoldPattern[LemniscateCoshPrime'] :=
	2*LemniscateCosh[#]^3 &;

LemniscateCoshPrime /: MakeBoxes[LemniscateCoshPrime[z_], TraditionalForm] :=
	RowBox[{InterpretationBox[SuperscriptBox["clh", "\[Prime]"], LemniscateCoshPrime, Editable -> False, Selectable -> False, Tooltip -> "LemniscateCoshPrime"], "(", ToBoxes[z], ")"}]

LemniscateTanh[z_] /; (z == 0) := z;

LemniscateTanh[z_?InexactNumberQ] :=
With[{t = JacobiSD[z, 1/2]},
	t/Sqrt[1 + t^4/4]
];

LemniscateTanh /: HoldPattern[LemniscateTanh'] :=
	LemniscateCoth[#]^3 &;

LemniscateTanh /: MakeBoxes[LemniscateTanh[z_], TraditionalForm] :=
	RowBox[{InterpretationBox["tlh", LemniscateTanh, Editable -> False, Selectable -> False, Tooltip -> "LemniscateTanh"], "(", ToBoxes[z], ")"}]

LemniscateCoth[z_] /; (z == 0) := 1 - z^4/4;

LemniscateCoth[z_?InexactNumberQ] :=
	JacobiCD[z, 1/2]*JacobiND[z, 1/2]/Sqrt[1 + JacobiSD[z, 1/2]^4/4];

LemniscateCoth /: HoldPattern[LemniscateCoth'] :=
	-LemniscateTanh[#]^3 &;

LemniscateCoth /: MakeBoxes[LemniscateCoth[z_], TraditionalForm] :=
	RowBox[{InterpretationBox["ctlh", LemniscateCoth, Editable -> False, Selectable -> False, Tooltip -> "LemniscateCoth"], "(", ToBoxes[z], ")"}]

InverseLemniscateSin[z_] := With[{t = z*Hypergeometric2F1[1/4, 1/2, 5/4, z^4]},
	t /; FreeQ[t, Hypergeometric2F1]
];

InverseLemniscateSin /: HoldPattern[InverseLemniscateSin'] :=
	(1 - #^4)^(-1/2) &;

InverseLemniscateSin /: HoldPattern[LemniscateSin[InverseLemniscateSin[z_]]] := 
	z;

InverseLemniscateSin /: HoldPattern[LemniscateCos[InverseLemniscateSin[z_]]] := 
	Sqrt[1 - z^2]/Sqrt[1 + z^2];

InverseLemniscateSin /: HoldPattern[LemniscateTan[InverseLemniscateSin[z_]]] := 
	z/(1 - z^4)^(1/4);

InverseLemniscateSin /: HoldPattern[LemniscateCot[InverseLemniscateSin[z_]]] := 
	(1 - z^4)^(-1/4);

InverseLemniscateCos[z_] := With[{t = InverseLemniscateSin[1] - InverseLemniscateSin[z]},
	t /; FreeQ[t, InverseLemniscateSin]
];

InverseLemniscateCos /: HoldPattern[InverseLemniscateCos'] :=
	-(1 - #^4)^(-1/2) &;

InverseLemniscateCos /: HoldPattern[LemniscateSin[InverseLemniscateCos[z_]]] := 
	Sqrt[1 - z^2]/Sqrt[1 + z^2];

InverseLemniscateCos /: HoldPattern[LemniscateCos[InverseLemniscateCos[z_]]] := 
	z;

InverseLemniscateCos /: HoldPattern[LemniscateTan[InverseLemniscateCos[z_]]] := 
	Sqrt[1 - z^2]/(Sqrt[2]*Sqrt[z]);

InverseLemniscateCos /: HoldPattern[LemniscateCot[InverseLemniscateCos[z_]]] := 
	Sqrt[1 + z^2]/(Sqrt[2]*Sqrt[z]);

InverseLemniscateTan[z_] := With[{t = z*Hypergeometric2F1[1/4, 3/4, 5/4, -z^4]},
	t /; FreeQ[t, Hypergeometric2F1]
];

InverseLemniscateTan /: HoldPattern[InverseLemniscateTan'] :=
	(1 + #^4)^(-3/4) &;

InverseLemniscateCot[z_] := With[{t = z*(1 - z^(-4))^(1/4)*Hypergeometric2F1[1/4, 3/4, 5/4, 1 - z^4]},
	t /; FreeQ[t, Hypergeometric2F1]
];

InverseLemniscateCot /: HoldPattern[InverseLemniscateCot'] :=
	(#^4 - 1)^(-3/4) &;

InverseLemniscateSinh[z_] := With[{t = z*Hypergeometric2F1[1/4, 1/2, 5/4, -z^4]},
	t /; FreeQ[t, Hypergeometric2F1]
]

InverseLemniscateSinh /: HoldPattern[InverseLemniscateSinh'] :=
	(1 + #^4)^(-1/2) &

InverseLemniscateSinh /: HoldPattern[LemniscateSinh[InverseLemniscateSinh[z_]]] := 
	z;

InverseLemniscateSinh /: HoldPattern[LemniscateCosh[InverseLemniscateSinh[z_]]] := 
	z^(-1);

InverseLemniscateSinh /: HoldPattern[LemniscateSinhPrime[InverseLemniscateSinh[z_]]] := 
	Sqrt[1 + z^4];

InverseLemniscateSinh /: HoldPattern[LemniscateCoshPrime[InverseLemniscateSinh[z_]]] := 
	Sqrt[1 + z^4]/z^2;

InverseLemniscateSinh /: HoldPattern[LemniscateTanh[InverseLemniscateSinh[z_]]] := 
	z/(1 + z^4)^(1/4);

InverseLemniscateSinh /: HoldPattern[LemniscateCoth[InverseLemniscateSinh[z_]]] := 
	(1 + z^4)^(-1/4);

InverseLemniscateCosh[z_] := With[{t = 2*InverseLemniscateSinh[1] - InverseLemniscateSinh[z]},
	t /; FreeQ[t, InverseLemniscateSinh]
];

InverseLemniscateCosh /: HoldPattern[InverseLemniscateCosh'] :=
	(1 + #^4)^(-1/2) &

InverseLemniscateCosh /: HoldPattern[LemniscateSinh[InverseLemniscateCosh[z_]]] := 
	z^(-1);

InverseLemniscateCosh /: HoldPattern[LemniscateCosh[InverseLemniscateCosh[z_]]] := 
	z;

InverseLemniscateCosh /: HoldPattern[LemniscateSinhPrime[InverseLemniscateCosh[z_]]] := 
	-Sqrt[1 + z^4]/z^2;

InverseLemniscateCosh /: HoldPattern[LemniscateCoshPrime[InverseLemniscateCosh[z_]]] := 
	-Sqrt[1 + z^4];

InverseLemniscateCosh /: HoldPattern[LemniscateTanh[InverseLemniscateCosh[z_]]] := 
	(1 + z^4)^(-1/4);

InverseLemniscateCosh /: HoldPattern[LemniscateCoth[InverseLemniscateCosh[z_]]] := 
	z/(1 + z^4)^(1/4);

InverseLemniscateTanh[z_] := With[{t = z*Hypergeometric2F1[1/4, 3/4, 5/4, z^4]},
	t /; FreeQ[t, Hypergeometric2F1]
];

InverseLemniscateTanh /: HoldPattern[InverseLemniscateTanh'] :=
	(1 + #^4)^(-3/4) &;

InverseLemniscateCoth[z_] := With[{t = InverseLemniscateTanh[1] - InverseLemniscateTanh[z]},
	t /; FreeQ[t, InverseLemniscateTanh]
];

InverseLemniscateCoth /: HoldPattern[InverseLemniscateCoth'] :=
	-(1 + #^4)^(-3/4) &;

End[];

SetAttributes[{
	LemniscateSin, LemniscateCos, LemniscateTan, LemniscateCot, LemniscateSinh, LemniscateCosh, LemniscateSinhPrime, LemniscateCoshPrime, LemniscateTanh, LemniscateCoth,
	InverseLemniscateSin, InverseLemniscateCos, InverseLemniscateTan, InverseLemniscateCot, InverseLemniscateSinh, InverseLemniscateCosh, InverseLemniscateTanh, InverseLemniscateCoth
}, {Listable, NumericFunction, ReadProtected}];

Protect[
	LemniscateSin, LemniscateCos, LemniscateTan, LemniscateCot, LemniscateSinh, LemniscateCosh, LemniscateSinhPrime, LemniscateCoshPrime, LemniscateTanh, LemniscateCoth,
	InverseLemniscateSin, InverseLemniscateCos, InverseLemniscateTan, InverseLemniscateCot, InverseLemniscateSinh, InverseLemniscateCosh, InverseLemniscateTanh, InverseLemniscateCoth
];

EndPackage[];

Last edited by lanxiyu (2025-03-01 16:19:05)

Agnishom

Real Member

From: Riemann Sphere

Registered: 2011-01-29

Posts: 25,009

Website

Re: Mathematica implementation of lemniscate functions

What is the Lemniscate function?

---

'And fun? If maths is fun, then getting a tooth extraction is fun. A viral infection is fun. Rabies shots are fun.'
'God exists because Mathematics is consistent, and the devil exists because we cannot prove it'
I'm not crazy, my mother had me tested.