{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
module Numeric.LAPACK.Scalar (
   RealOf,
   ComplexOf,
   zero,
   one,
   minusOne,
   isZero,

   selectReal,
   selectFloating,
   ComplexSingleton(Real,Complex),
   complexSingleton,
   complexSingletonOf,
   complexSingletonOfFunctor,

   PrecisionSingleton(Float,Double),
   precisionSingleton,
   precisionOf,
   precisionOfFunctor,

   equal,
   fromReal,
   toComplex,
   absolute,
   absoluteSquared,
   norm1,
   realPart,
   conjugate,
   ) where

import qualified Numeric.Netlib.Class as Class

import Data.Functor.Identity (Identity(Identity, runIdentity))

import qualified Data.Complex as Complex
import Data.Complex (Complex((:+)))


type family RealOf x

type instance RealOf Float = Float
type instance RealOf Double = Double
type instance RealOf (Complex.Complex a) = a


type ComplexOf x = Complex.Complex (RealOf x)


data ComplexSingleton a where
   Real :: (Class.Real a, RealOf a ~ a) => ComplexSingleton a
   Complex :: (Class.Real a) => ComplexSingleton (Complex.Complex a)

complexSingleton :: (Class.Floating a) => ComplexSingleton a
complexSingleton :: ComplexSingleton a
complexSingleton = ComplexSingleton Float
-> ComplexSingleton Double
-> ComplexSingleton (Complex Float)
-> ComplexSingleton (Complex Double)
-> ComplexSingleton a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating ComplexSingleton Float
forall a. (Real a, RealOf a ~ a) => ComplexSingleton a
Real ComplexSingleton Double
forall a. (Real a, RealOf a ~ a) => ComplexSingleton a
Real ComplexSingleton (Complex Float)
forall a. Real a => ComplexSingleton (Complex a)
Complex ComplexSingleton (Complex Double)
forall a. Real a => ComplexSingleton (Complex a)
Complex

complexSingletonOf :: (Class.Floating a) => a -> ComplexSingleton a
complexSingletonOf :: a -> ComplexSingleton a
complexSingletonOf = ComplexSingleton a -> a -> ComplexSingleton a
forall a b. a -> b -> a
const ComplexSingleton a
forall a. Floating a => ComplexSingleton a
complexSingleton

complexSingletonOfFunctor :: (Class.Floating a) => f a -> ComplexSingleton a
complexSingletonOfFunctor :: f a -> ComplexSingleton a
complexSingletonOfFunctor = ComplexSingleton a -> f a -> ComplexSingleton a
forall a b. a -> b -> a
const ComplexSingleton a
forall a. Floating a => ComplexSingleton a
complexSingleton

withComplexSingleton :: (Class.Floating a) => (ComplexSingleton a -> a) -> a
withComplexSingleton :: (ComplexSingleton a -> a) -> a
withComplexSingleton ComplexSingleton a -> a
f = ComplexSingleton a -> a
f ComplexSingleton a
forall a. Floating a => ComplexSingleton a
complexSingleton


data PrecisionSingleton a where
   Float :: PrecisionSingleton Float
   Double :: PrecisionSingleton Double

precisionSingleton :: (Class.Real a) => PrecisionSingleton a
precisionSingleton :: PrecisionSingleton a
precisionSingleton = PrecisionSingleton Float
-> PrecisionSingleton Double -> PrecisionSingleton a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
Class.switchReal PrecisionSingleton Float
Float PrecisionSingleton Double
Double

precisionOf :: (Class.Real a) => a -> PrecisionSingleton a
precisionOf :: a -> PrecisionSingleton a
precisionOf a
_ = PrecisionSingleton a
forall a. Real a => PrecisionSingleton a
precisionSingleton

precisionOfFunctor :: (Class.Real a) => f a -> PrecisionSingleton a
precisionOfFunctor :: f a -> PrecisionSingleton a
precisionOfFunctor f a
_ = PrecisionSingleton a
forall a. Real a => PrecisionSingleton a
precisionSingleton


-- move to netlib-carray:Utility or netlib-ffi:Class
zero, one, minusOne :: Class.Floating a => a
zero :: a
zero = Float -> Double -> Complex Float -> Complex Double -> a
forall a.
Floating a =>
Float -> Double -> Complex Float -> Complex Double -> a
selectFloating Float
0 Double
0 Complex Float
0 Complex Double
0
one :: a
one = Float -> Double -> Complex Float -> Complex Double -> a
forall a.
Floating a =>
Float -> Double -> Complex Float -> Complex Double -> a
selectFloating Float
1 Double
1 Complex Float
1 Complex Double
1
minusOne :: a
minusOne = Float -> Double -> Complex Float -> Complex Double -> a
forall a.
Floating a =>
Float -> Double -> Complex Float -> Complex Double -> a
selectFloating (-Float
1) (-Double
1) (-Complex Float
1) (-Complex Double
1)

selectReal :: (Class.Real a) => Float -> Double -> a
selectReal :: Float -> Double -> a
selectReal Float
rf Double
rd = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ Identity Float -> Identity Double -> Identity a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
Class.switchReal (Float -> Identity Float
forall a. a -> Identity a
Identity Float
rf) (Double -> Identity Double
forall a. a -> Identity a
Identity Double
rd)

selectFloating ::
   (Class.Floating a) =>
   Float -> Double -> Complex.Complex Float -> Complex.Complex Double -> a
selectFloating :: Float -> Double -> Complex Float -> Complex Double -> a
selectFloating Float
rf Double
rd Complex Float
cf Complex Double
cd =
   (ComplexSingleton a -> a) -> a
forall a. Floating a => (ComplexSingleton a -> a) -> a
withComplexSingleton ((ComplexSingleton a -> a) -> a) -> (ComplexSingleton a -> a) -> a
forall a b. (a -> b) -> a -> b
$ \ComplexSingleton a
sw ->
      case ComplexSingleton a
sw of
         ComplexSingleton a
Real -> Float -> Double -> a
forall a. Real a => Float -> Double -> a
selectReal Float
rf Double
rd
         ComplexSingleton a
Complex -> Complex Float -> Complex Double -> Complex a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
Class.switchReal Complex Float
cf Complex Double
cd



equal :: (Class.Floating a) => a -> a -> Bool
equal :: a -> a -> Bool
equal a
a a
b =
   case a -> ComplexSingleton a
forall a. Floating a => a -> ComplexSingleton a
complexSingletonOf a
a of
      ComplexSingleton a
Real -> a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b
      ComplexSingleton a
Complex -> a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b


isZero :: (Class.Floating a) => a -> Bool
isZero :: a -> Bool
isZero = a -> a -> Bool
forall a. Floating a => a -> a -> Bool
equal a
forall a. Floating a => a
zero


fromReal :: (Class.Floating a) => RealOf a -> a
fromReal :: RealOf a -> a
fromReal RealOf a
a =
   (ComplexSingleton a -> a) -> a
forall a. Floating a => (ComplexSingleton a -> a) -> a
withComplexSingleton ((ComplexSingleton a -> a) -> a) -> (ComplexSingleton a -> a) -> a
forall a b. (a -> b) -> a -> b
$ \ComplexSingleton a
sw ->
      case ComplexSingleton a
sw of
         ComplexSingleton a
Real -> a
RealOf a
a
         ComplexSingleton a
Complex -> a
RealOf a
aa -> a -> Complex a
forall a. a -> a -> Complex a
:+a
0

toComplex :: (Class.Floating a) => a -> ComplexOf a
toComplex :: a -> ComplexOf a
toComplex a
a =
   case a -> ComplexSingleton a
forall a. Floating a => a -> ComplexSingleton a
complexSingletonOf a
a of
      ComplexSingleton a
Real -> a
aa -> a -> Complex a
forall a. a -> a -> Complex a
:+a
0
      ComplexSingleton a
Complex -> a
ComplexOf a
a

realPart :: (Class.Floating a) => a -> RealOf a
realPart :: a -> RealOf a
realPart a
a =
   case a -> ComplexSingleton a
forall a. Floating a => a -> ComplexSingleton a
complexSingletonOf a
a of
      ComplexSingleton a
Real -> a
RealOf a
a
      ComplexSingleton a
Complex -> Complex a -> a
forall a. Complex a -> a
Complex.realPart a
Complex a
a

absolute :: (Class.Floating a) => a -> RealOf a
absolute :: a -> RealOf a
absolute a
a =
   case a -> ComplexSingleton a
forall a. Floating a => a -> ComplexSingleton a
complexSingletonOf a
a of
      ComplexSingleton a
Real -> a -> a
forall a. Num a => a -> a
abs a
a
      ComplexSingleton a
Complex -> Complex a -> a
forall a. RealFloat a => Complex a -> a
Complex.magnitude a
Complex a
a


norm1 :: (Class.Floating a) => a -> RealOf a
norm1 :: a -> RealOf a
norm1 a
a =
   case a -> ComplexSingleton a
forall a. Floating a => a -> ComplexSingleton a
complexSingletonOf a
a of
      ComplexSingleton a
Real -> a -> a
forall a. Num a => a -> a
abs a
a
      ComplexSingleton a
Complex -> case a
a of r:+i -> a -> a
forall a. Num a => a -> a
abs a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Num a => a -> a
abs a
i


absoluteSquared :: (Class.Floating a) => a -> RealOf a
absoluteSquared :: a -> RealOf a
absoluteSquared a
a =
   case a -> ComplexSingleton a
forall a. Floating a => a -> ComplexSingleton a
complexSingletonOf a
a of
      ComplexSingleton a
Real -> a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
a
      ComplexSingleton a
Complex -> case a
a of r:+i -> a
ra -> a -> a
forall a. Num a => a -> a -> a
*a
ra -> a -> a
forall a. Num a => a -> a -> a
+a
ia -> a -> a
forall a. Num a => a -> a -> a
*a
i


conjugate :: (Class.Floating a) => a -> a
conjugate :: a -> a
conjugate a
a =
   case a -> ComplexSingleton a
forall a. Floating a => a -> ComplexSingleton a
complexSingletonOf a
a of
      ComplexSingleton a
Real -> a
a
      ComplexSingleton a
Complex -> Complex a -> Complex a
forall a. Num a => Complex a -> Complex a
Complex.conjugate a
Complex a
a