{-|
Module      : Math.JacobiElliptic
Description : Jacobi elliptic functions.
Copyright   : (c) Stéphane Laurent, 2023
License     : BSD3
Maintainer  : laurent_step@outlook.fr

Provides the Jacobi elliptic functions and the amplitude function.
-}
module Math.JacobiElliptic
    ( jellip,
      jellip',
      am
    ) where
import Data.Complex       ( Complex, realPart, imagPart )
import Math.NevilleTheta
                          ( theta_c,
                            theta_d,
                            theta_n,
                            theta_s,
                            theta_c',
                            theta_d',
                            theta_n',
                            theta_s' )


-- | Jacobi elliptic function in terms of the nome.

jellip :: 
     Char -- ^ a letter among 'c', 'd', 'n', 's' identifying the Neville function at the numerator

  -> Char -- ^ a letter among 'c', 'd', 'n', 's' identifying the Neville function at the denominator

  -> Complex Double -- ^ z, the variable

  -> Complex Double -- ^ q, the nome

  -> Complex Double
jellip :: Char -> Char -> Complex Double -> Complex Double -> Complex Double
jellip Char
p Char
q Complex Double
z Complex Double
nome = 
  Complex Double -> Complex Double -> Complex Double
theta_num Complex Double
z Complex Double
nome forall a. Fractional a => a -> a -> a
/ Complex Double -> Complex Double -> Complex Double
theta_den Complex Double
z Complex Double
nome
  where
    theta_num :: Complex Double -> Complex Double -> Complex Double
theta_num = case Char
p of
      Char
'c' -> Complex Double -> Complex Double -> Complex Double
theta_c
      Char
'd' -> Complex Double -> Complex Double -> Complex Double
theta_d
      Char
'n' -> Complex Double -> Complex Double -> Complex Double
theta_n
      Char
's' -> Complex Double -> Complex Double -> Complex Double
theta_s
      Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid numerator identifier."
    theta_den :: Complex Double -> Complex Double -> Complex Double
theta_den = case Char
q of
      Char
'c' -> Complex Double -> Complex Double -> Complex Double
theta_c
      Char
'd' -> Complex Double -> Complex Double -> Complex Double
theta_d
      Char
'n' -> Complex Double -> Complex Double -> Complex Double
theta_n
      Char
's' -> Complex Double -> Complex Double -> Complex Double
theta_s
      Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid denominator identifier."

-- | Jacobi elliptic function in terms of the squared modulus.

jellip' :: 
     Char -- ^ a letter among 'c', 'd', 'n', 's' identifying the Neville function at the numerator

  -> Char -- ^ a letter among 'c', 'd', 'n', 's' identifying the Neville function at the denominator

  -> Complex Double -- ^ z, the variable

  -> Complex Double -- ^ m, the squared modulus

  -> Complex Double
jellip' :: Char -> Char -> Complex Double -> Complex Double -> Complex Double
jellip' Char
p Char
q Complex Double
z Complex Double
m = 
  Complex Double -> Complex Double -> Complex Double
theta_num Complex Double
z Complex Double
m forall a. Fractional a => a -> a -> a
/ Complex Double -> Complex Double -> Complex Double
theta_den Complex Double
z Complex Double
m
  where
    theta_num :: Complex Double -> Complex Double -> Complex Double
theta_num = case Char
p of
      Char
'c' -> Complex Double -> Complex Double -> Complex Double
theta_c'
      Char
'd' -> Complex Double -> Complex Double -> Complex Double
theta_d'
      Char
'n' -> Complex Double -> Complex Double -> Complex Double
theta_n'
      Char
's' -> Complex Double -> Complex Double -> Complex Double
theta_s'
      Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid numerator identifier."
    theta_den :: Complex Double -> Complex Double -> Complex Double
theta_den = case Char
q of
      Char
'c' -> Complex Double -> Complex Double -> Complex Double
theta_c'
      Char
'd' -> Complex Double -> Complex Double -> Complex Double
theta_d'
      Char
'n' -> Complex Double -> Complex Double -> Complex Double
theta_n'
      Char
's' -> Complex Double -> Complex Double -> Complex Double
theta_s'
      Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid denominator identifier."

-- | The amplitude function.

am ::
     Complex Double -- ^ u, a complex number 

  -> Complex Double -- ^ m, the squared elliptic modulus

  -> Complex Double
am :: Complex Double -> Complex Double -> Complex Double
am Complex Double
u Complex Double
m = forall a. Num a => Integer -> a
fromInteger ((-Integer
1)forall a b. (Num a, Integral b) => a -> b -> a
^Integer
k) forall a. Num a => a -> a -> a
* Complex Double
w forall a. Num a => a -> a -> a
+ Complex Double
k' forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi
  where
    k :: Integer
k = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Complex a -> a
realPart Complex Double
u forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi) forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Complex a -> a
imagPart Complex Double
u forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi)
    k' :: Complex Double
k' = forall a. Num a => Integer -> a
fromInteger Integer
k
    w :: Complex Double
w = forall a. Floating a => a -> a
asin (Char -> Char -> Complex Double -> Complex Double -> Complex Double
jellip' Char
's' Char
'n' Complex Double
u Complex Double
m)