module Math.JacobiElliptic
    ( jellip,
      jellip'
    ) where
import Data.Complex ( Complex )
import Math.NevilleTheta
    ( theta_c,
      theta_d,
      theta_n,
      theta_s,
      theta_c',
      theta_d',
      theta_n',
      theta_s' )

type Cplx = Complex Double

-- | 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
  -> Cplx -- ^ z, the variable
  -> Cplx -- ^ q, the nome
  -> Cplx
jellip :: Char -> Char -> Cplx -> Cplx -> Cplx
jellip Char
p Char
q Cplx
z Cplx
nome = 
  Cplx -> Cplx -> Cplx
theta_num Cplx
z Cplx
nome forall a. Fractional a => a -> a -> a
/ Cplx -> Cplx -> Cplx
theta_den Cplx
z Cplx
nome
  where
    theta_num :: Cplx -> Cplx -> Cplx
theta_num = case Char
p of
      Char
'c' -> Cplx -> Cplx -> Cplx
theta_c
      Char
'd' -> Cplx -> Cplx -> Cplx
theta_d
      Char
'n' -> Cplx -> Cplx -> Cplx
theta_n
      Char
's' -> Cplx -> Cplx -> Cplx
theta_s
      Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid numerator identifier."
    theta_den :: Cplx -> Cplx -> Cplx
theta_den = case Char
q of
      Char
'c' -> Cplx -> Cplx -> Cplx
theta_c
      Char
'd' -> Cplx -> Cplx -> Cplx
theta_d
      Char
'n' -> Cplx -> Cplx -> Cplx
theta_n
      Char
's' -> Cplx -> Cplx -> Cplx
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
  -> Cplx -- ^ z, the variable
  -> Cplx -- ^ m, the squared modulus
  -> Cplx
jellip' :: Char -> Char -> Cplx -> Cplx -> Cplx
jellip' Char
p Char
q Cplx
z Cplx
m = 
  Cplx -> Cplx -> Cplx
theta_num Cplx
z Cplx
m forall a. Fractional a => a -> a -> a
/ Cplx -> Cplx -> Cplx
theta_den Cplx
z Cplx
m
  where
    theta_num :: Cplx -> Cplx -> Cplx
theta_num = case Char
p of
      Char
'c' -> Cplx -> Cplx -> Cplx
theta_c'
      Char
'd' -> Cplx -> Cplx -> Cplx
theta_d'
      Char
'n' -> Cplx -> Cplx -> Cplx
theta_n'
      Char
's' -> Cplx -> Cplx -> Cplx
theta_s'
      Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid numerator identifier."
    theta_den :: Cplx -> Cplx -> Cplx
theta_den = case Char
q of
      Char
'c' -> Cplx -> Cplx -> Cplx
theta_c'
      Char
'd' -> Cplx -> Cplx -> Cplx
theta_d'
      Char
'n' -> Cplx -> Cplx -> Cplx
theta_n'
      Char
's' -> Cplx -> Cplx -> Cplx
theta_s'
      Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid denominator identifier."