{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Vector
-- Copyright   :  (c) Alberto Ruiz 2011
-- License     :  BSD3
--
-- Maintainer  :  Alberto Ruiz
-- Stability   :  provisional
--
-- Provides instances of standard classes 'Show', 'Read', 'Eq',
-- 'Num', 'Fractional',  and 'Floating' for 'Vector'.
--
-----------------------------------------------------------------------------

module Numeric.Vector () where

import Internal.Vectorized
import Internal.Vector
import Internal.Numeric
import Internal.Conversion
import Foreign.Storable(Storable)

-------------------------------------------------------------------

adaptScalar :: (Foreign.Storable.Storable t1, Foreign.Storable.Storable t2)
            => (t1 -> Vector t2 -> t)
            -> (Vector t1 -> Vector t2 -> t)
            -> (Vector t1 -> t2 -> t)
            -> Vector t1
            -> Vector t2
            -> t
adaptScalar :: (t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar t1 -> Vector t2 -> t
f1 Vector t1 -> Vector t2 -> t
f2 Vector t1 -> t2 -> t
f3 Vector t1
x Vector t2
y
    | Vector t1 -> Int
forall t. Storable t => Vector t -> Int
dim Vector t1
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = t1 -> Vector t2 -> t
f1   (Vector t1
xVector t1 -> Int -> t1
forall t. Storable t => Vector t -> Int -> t
@>Int
0) Vector t2
y
    | Vector t2 -> Int
forall t. Storable t => Vector t -> Int
dim Vector t2
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Vector t1 -> t2 -> t
f3 Vector t1
x (Vector t2
yVector t2 -> Int -> t2
forall t. Storable t => Vector t -> Int -> t
@>Int
0)
    | Bool
otherwise = Vector t1 -> Vector t2 -> t
f2 Vector t1
x Vector t2
y

------------------------------------------------------------------

instance Num (Vector I) where
    + :: Vector I -> Vector I -> Vector I
(+) = (I -> Vector I -> Vector I)
-> (Vector I -> Vector I -> Vector I)
-> (Vector I -> I -> Vector I)
-> Vector I
-> Vector I
-> Vector I
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar I -> Vector I -> Vector I
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant Vector I -> Vector I -> Vector I
forall c. Additive c => c -> c -> c
add ((I -> Vector I -> Vector I) -> Vector I -> I -> Vector I
forall a b c. (a -> b -> c) -> b -> a -> c
flip I -> Vector I -> Vector I
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant)
    negate :: Vector I -> Vector I
negate = I -> Vector I -> Vector I
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (-I
1)
    * :: Vector I -> Vector I -> Vector I
(*) = (I -> Vector I -> Vector I)
-> (Vector I -> Vector I -> Vector I)
-> (Vector I -> I -> Vector I)
-> Vector I
-> Vector I
-> Vector I
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar I -> Vector I -> Vector I
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale Vector I -> Vector I -> Vector I
forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul ((I -> Vector I -> Vector I) -> Vector I -> I -> Vector I
forall a b c. (a -> b -> c) -> b -> a -> c
flip I -> Vector I -> Vector I
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale)
    signum :: Vector I -> Vector I
signum = FunCodeV -> Vector I -> Vector I
vectorMapI FunCodeV
Sign
    abs :: Vector I -> Vector I
abs = FunCodeV -> Vector I -> Vector I
vectorMapI FunCodeV
Abs
    fromInteger :: Integer -> Vector I
fromInteger = [I] -> Vector I
forall a. Storable a => [a] -> Vector a
fromList ([I] -> Vector I) -> (Integer -> [I]) -> Integer -> Vector I
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I -> [I]
forall (m :: * -> *) a. Monad m => a -> m a
return (I -> [I]) -> (Integer -> I) -> Integer -> [I]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> I
forall a. Num a => Integer -> a
fromInteger

instance Num (Vector Z) where
    + :: Vector Z -> Vector Z -> Vector Z
(+) = (Z -> Vector Z -> Vector Z)
-> (Vector Z -> Vector Z -> Vector Z)
-> (Vector Z -> Z -> Vector Z)
-> Vector Z
-> Vector Z
-> Vector Z
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Z -> Vector Z -> Vector Z
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant Vector Z -> Vector Z -> Vector Z
forall c. Additive c => c -> c -> c
add ((Z -> Vector Z -> Vector Z) -> Vector Z -> Z -> Vector Z
forall a b c. (a -> b -> c) -> b -> a -> c
flip Z -> Vector Z -> Vector Z
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant)
    negate :: Vector Z -> Vector Z
negate = Z -> Vector Z -> Vector Z
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (-Z
1)
    * :: Vector Z -> Vector Z -> Vector Z
(*) = (Z -> Vector Z -> Vector Z)
-> (Vector Z -> Vector Z -> Vector Z)
-> (Vector Z -> Z -> Vector Z)
-> Vector Z
-> Vector Z
-> Vector Z
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Z -> Vector Z -> Vector Z
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale Vector Z -> Vector Z -> Vector Z
forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul ((Z -> Vector Z -> Vector Z) -> Vector Z -> Z -> Vector Z
forall a b c. (a -> b -> c) -> b -> a -> c
flip Z -> Vector Z -> Vector Z
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale)
    signum :: Vector Z -> Vector Z
signum = FunCodeV -> Vector Z -> Vector Z
vectorMapL FunCodeV
Sign
    abs :: Vector Z -> Vector Z
abs = FunCodeV -> Vector Z -> Vector Z
vectorMapL FunCodeV
Abs
    fromInteger :: Integer -> Vector Z
fromInteger = [Z] -> Vector Z
forall a. Storable a => [a] -> Vector a
fromList ([Z] -> Vector Z) -> (Integer -> [Z]) -> Integer -> Vector Z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Z -> [Z]
forall (m :: * -> *) a. Monad m => a -> m a
return (Z -> [Z]) -> (Integer -> Z) -> Integer -> [Z]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Z
forall a. Num a => Integer -> a
fromInteger

instance Num (Vector Float) where
    + :: Vector Float -> Vector Float -> Vector Float
(+) = (Float -> Vector Float -> Vector Float)
-> (Vector Float -> Vector Float -> Vector Float)
-> (Vector Float -> Float -> Vector Float)
-> Vector Float
-> Vector Float
-> Vector Float
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Float -> Vector Float -> Vector Float
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant Vector Float -> Vector Float -> Vector Float
forall c. Additive c => c -> c -> c
add ((Float -> Vector Float -> Vector Float)
-> Vector Float -> Float -> Vector Float
forall a b c. (a -> b -> c) -> b -> a -> c
flip Float -> Vector Float -> Vector Float
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant)
    negate :: Vector Float -> Vector Float
negate = Float -> Vector Float -> Vector Float
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (-Float
1)
    * :: Vector Float -> Vector Float -> Vector Float
(*) = (Float -> Vector Float -> Vector Float)
-> (Vector Float -> Vector Float -> Vector Float)
-> (Vector Float -> Float -> Vector Float)
-> Vector Float
-> Vector Float
-> Vector Float
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Float -> Vector Float -> Vector Float
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale Vector Float -> Vector Float -> Vector Float
forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul ((Float -> Vector Float -> Vector Float)
-> Vector Float -> Float -> Vector Float
forall a b c. (a -> b -> c) -> b -> a -> c
flip Float -> Vector Float -> Vector Float
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale)
    signum :: Vector Float -> Vector Float
signum = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Sign
    abs :: Vector Float -> Vector Float
abs = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Abs
    fromInteger :: Integer -> Vector Float
fromInteger = [Float] -> Vector Float
forall a. Storable a => [a] -> Vector a
fromList ([Float] -> Vector Float)
-> (Integer -> [Float]) -> Integer -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> [Float]
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> [Float]) -> (Integer -> Float) -> Integer -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Float
forall a. Num a => Integer -> a
fromInteger

instance Num (Vector Double) where
    + :: Vector Double -> Vector Double -> Vector Double
(+) = (Double -> Vector Double -> Vector Double)
-> (Vector Double -> Vector Double -> Vector Double)
-> (Vector Double -> Double -> Vector Double)
-> Vector Double
-> Vector Double
-> Vector Double
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Double -> Vector Double -> Vector Double
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant Vector Double -> Vector Double -> Vector Double
forall c. Additive c => c -> c -> c
add ((Double -> Vector Double -> Vector Double)
-> Vector Double -> Double -> Vector Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double -> Vector Double -> Vector Double
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant)
    negate :: Vector Double -> Vector Double
negate = Double -> Vector Double -> Vector Double
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (-Double
1)
    * :: Vector Double -> Vector Double -> Vector Double
(*) = (Double -> Vector Double -> Vector Double)
-> (Vector Double -> Vector Double -> Vector Double)
-> (Vector Double -> Double -> Vector Double)
-> Vector Double
-> Vector Double
-> Vector Double
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Double -> Vector Double -> Vector Double
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale Vector Double -> Vector Double -> Vector Double
forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul ((Double -> Vector Double -> Vector Double)
-> Vector Double -> Double -> Vector Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double -> Vector Double -> Vector Double
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale)
    signum :: Vector Double -> Vector Double
signum = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Sign
    abs :: Vector Double -> Vector Double
abs = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Abs
    fromInteger :: Integer -> Vector Double
fromInteger = [Double] -> Vector Double
forall a. Storable a => [a] -> Vector a
fromList ([Double] -> Vector Double)
-> (Integer -> [Double]) -> Integer -> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> [Double]) -> (Integer -> Double) -> Integer -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger

instance Num (Vector (Complex Double)) where
    + :: Vector (Complex Double)
-> Vector (Complex Double) -> Vector (Complex Double)
(+) = (Complex Double
 -> Vector (Complex Double) -> Vector (Complex Double))
-> (Vector (Complex Double)
    -> Vector (Complex Double) -> Vector (Complex Double))
-> (Vector (Complex Double)
    -> Complex Double -> Vector (Complex Double))
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Complex Double
-> Vector (Complex Double) -> Vector (Complex Double)
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant Vector (Complex Double)
-> Vector (Complex Double) -> Vector (Complex Double)
forall c. Additive c => c -> c -> c
add ((Complex Double
 -> Vector (Complex Double) -> Vector (Complex Double))
-> Vector (Complex Double)
-> Complex Double
-> Vector (Complex Double)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Complex Double
-> Vector (Complex Double) -> Vector (Complex Double)
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant)
    negate :: Vector (Complex Double) -> Vector (Complex Double)
negate = Complex Double
-> Vector (Complex Double) -> Vector (Complex Double)
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (-Complex Double
1)
    * :: Vector (Complex Double)
-> Vector (Complex Double) -> Vector (Complex Double)
(*) = (Complex Double
 -> Vector (Complex Double) -> Vector (Complex Double))
-> (Vector (Complex Double)
    -> Vector (Complex Double) -> Vector (Complex Double))
-> (Vector (Complex Double)
    -> Complex Double -> Vector (Complex Double))
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Complex Double
-> Vector (Complex Double) -> Vector (Complex Double)
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale Vector (Complex Double)
-> Vector (Complex Double) -> Vector (Complex Double)
forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul ((Complex Double
 -> Vector (Complex Double) -> Vector (Complex Double))
-> Vector (Complex Double)
-> Complex Double
-> Vector (Complex Double)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Complex Double
-> Vector (Complex Double) -> Vector (Complex Double)
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale)
    signum :: Vector (Complex Double) -> Vector (Complex Double)
signum = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Sign
    abs :: Vector (Complex Double) -> Vector (Complex Double)
abs = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Abs
    fromInteger :: Integer -> Vector (Complex Double)
fromInteger = [Complex Double] -> Vector (Complex Double)
forall a. Storable a => [a] -> Vector a
fromList ([Complex Double] -> Vector (Complex Double))
-> (Integer -> [Complex Double])
-> Integer
-> Vector (Complex Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Complex Double -> [Complex Double]
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex Double -> [Complex Double])
-> (Integer -> Complex Double) -> Integer -> [Complex Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Complex Double
forall a. Num a => Integer -> a
fromInteger

instance Num (Vector (Complex Float)) where
    + :: Vector (Complex Float)
-> Vector (Complex Float) -> Vector (Complex Float)
(+) = (Complex Float -> Vector (Complex Float) -> Vector (Complex Float))
-> (Vector (Complex Float)
    -> Vector (Complex Float) -> Vector (Complex Float))
-> (Vector (Complex Float)
    -> Complex Float -> Vector (Complex Float))
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Complex Float -> Vector (Complex Float) -> Vector (Complex Float)
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant Vector (Complex Float)
-> Vector (Complex Float) -> Vector (Complex Float)
forall c. Additive c => c -> c -> c
add ((Complex Float -> Vector (Complex Float) -> Vector (Complex Float))
-> Vector (Complex Float)
-> Complex Float
-> Vector (Complex Float)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Complex Float -> Vector (Complex Float) -> Vector (Complex Float)
forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant)
    negate :: Vector (Complex Float) -> Vector (Complex Float)
negate = Complex Float -> Vector (Complex Float) -> Vector (Complex Float)
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (-Complex Float
1)
    * :: Vector (Complex Float)
-> Vector (Complex Float) -> Vector (Complex Float)
(*) = (Complex Float -> Vector (Complex Float) -> Vector (Complex Float))
-> (Vector (Complex Float)
    -> Vector (Complex Float) -> Vector (Complex Float))
-> (Vector (Complex Float)
    -> Complex Float -> Vector (Complex Float))
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar Complex Float -> Vector (Complex Float) -> Vector (Complex Float)
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale Vector (Complex Float)
-> Vector (Complex Float) -> Vector (Complex Float)
forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul ((Complex Float -> Vector (Complex Float) -> Vector (Complex Float))
-> Vector (Complex Float)
-> Complex Float
-> Vector (Complex Float)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Complex Float -> Vector (Complex Float) -> Vector (Complex Float)
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale)
    signum :: Vector (Complex Float) -> Vector (Complex Float)
signum = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Sign
    abs :: Vector (Complex Float) -> Vector (Complex Float)
abs = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Abs
    fromInteger :: Integer -> Vector (Complex Float)
fromInteger = [Complex Float] -> Vector (Complex Float)
forall a. Storable a => [a] -> Vector a
fromList ([Complex Float] -> Vector (Complex Float))
-> (Integer -> [Complex Float])
-> Integer
-> Vector (Complex Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Complex Float -> [Complex Float]
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex Float -> [Complex Float])
-> (Integer -> Complex Float) -> Integer -> [Complex Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Complex Float
forall a. Num a => Integer -> a
fromInteger

---------------------------------------------------

instance (Container Vector a, Num (Vector a), Fractional a) => Fractional (Vector a) where
    fromRational :: Rational -> Vector a
fromRational Rational
n = [a] -> Vector a
forall a. Storable a => [a] -> Vector a
fromList [Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
n]
    / :: Vector a -> Vector a -> Vector a
(/) = (a -> Vector a -> Vector a)
-> (Vector a -> Vector a -> Vector a)
-> (Vector a -> a -> Vector a)
-> Vector a
-> Vector a
-> Vector a
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar a -> Vector a -> Vector a
forall (c :: * -> *) e.
(Container c e, Fractional e) =>
e -> c e -> c e
f Vector a -> Vector a -> Vector a
forall (c :: * -> *) e.
(Container c e, Fractional e) =>
c e -> c e -> c e
divide Vector a -> a -> Vector a
forall t (c :: * -> *).
(Linear t c, Fractional t) =>
c t -> t -> c t
g where
        e
r f :: e -> c e -> c e
`f` c e
v = e -> c e -> c e
forall (c :: * -> *) e.
(Container c e, Fractional e) =>
e -> c e -> c e
scaleRecip e
r c e
v
        c t
v g :: c t -> t -> c t
`g` t
r = t -> c t -> c t
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (t -> t
forall a. Fractional a => a -> a
recip t
r) c t
v

-------------------------------------------------------

instance Floating (Vector Float) where
    sin :: Vector Float -> Vector Float
sin   = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Sin
    cos :: Vector Float -> Vector Float
cos   = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Cos
    tan :: Vector Float -> Vector Float
tan   = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Tan
    asin :: Vector Float -> Vector Float
asin  = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
ASin
    acos :: Vector Float -> Vector Float
acos  = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
ACos
    atan :: Vector Float -> Vector Float
atan  = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
ATan
    sinh :: Vector Float -> Vector Float
sinh  = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Sinh
    cosh :: Vector Float -> Vector Float
cosh  = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Cosh
    tanh :: Vector Float -> Vector Float
tanh  = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Tanh
    asinh :: Vector Float -> Vector Float
asinh = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
ASinh
    acosh :: Vector Float -> Vector Float
acosh = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
ACosh
    atanh :: Vector Float -> Vector Float
atanh = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
ATanh
    exp :: Vector Float -> Vector Float
exp   = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Exp
    log :: Vector Float -> Vector Float
log   = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Log
    sqrt :: Vector Float -> Vector Float
sqrt  = FunCodeV -> Vector Float -> Vector Float
vectorMapF FunCodeV
Sqrt
    ** :: Vector Float -> Vector Float -> Vector Float
(**)  = (Float -> Vector Float -> Vector Float)
-> (Vector Float -> Vector Float -> Vector Float)
-> (Vector Float -> Float -> Vector Float)
-> Vector Float
-> Vector Float
-> Vector Float
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar (FunCodeSV -> Float -> Vector Float -> Vector Float
vectorMapValF FunCodeSV
PowSV) (FunCodeVV -> Vector Float -> Vector Float -> Vector Float
vectorZipF FunCodeVV
Pow) ((Float -> Vector Float -> Vector Float)
-> Vector Float -> Float -> Vector Float
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FunCodeSV -> Float -> Vector Float -> Vector Float
vectorMapValF FunCodeSV
PowVS))
    pi :: Vector Float
pi    = [Float] -> Vector Float
forall a. Storable a => [a] -> Vector a
fromList [Float
forall a. Floating a => a
pi]

-------------------------------------------------------------

instance Floating (Vector Double) where
    sin :: Vector Double -> Vector Double
sin   = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Sin
    cos :: Vector Double -> Vector Double
cos   = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Cos
    tan :: Vector Double -> Vector Double
tan   = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Tan
    asin :: Vector Double -> Vector Double
asin  = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
ASin
    acos :: Vector Double -> Vector Double
acos  = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
ACos
    atan :: Vector Double -> Vector Double
atan  = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
ATan
    sinh :: Vector Double -> Vector Double
sinh  = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Sinh
    cosh :: Vector Double -> Vector Double
cosh  = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Cosh
    tanh :: Vector Double -> Vector Double
tanh  = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Tanh
    asinh :: Vector Double -> Vector Double
asinh = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
ASinh
    acosh :: Vector Double -> Vector Double
acosh = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
ACosh
    atanh :: Vector Double -> Vector Double
atanh = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
ATanh
    exp :: Vector Double -> Vector Double
exp   = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Exp
    log :: Vector Double -> Vector Double
log   = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Log
    sqrt :: Vector Double -> Vector Double
sqrt  = FunCodeV -> Vector Double -> Vector Double
vectorMapR FunCodeV
Sqrt
    ** :: Vector Double -> Vector Double -> Vector Double
(**)  = (Double -> Vector Double -> Vector Double)
-> (Vector Double -> Vector Double -> Vector Double)
-> (Vector Double -> Double -> Vector Double)
-> Vector Double
-> Vector Double
-> Vector Double
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar (FunCodeSV -> Double -> Vector Double -> Vector Double
vectorMapValR FunCodeSV
PowSV) (FunCodeVV -> Vector Double -> Vector Double -> Vector Double
vectorZipR FunCodeVV
Pow) ((Double -> Vector Double -> Vector Double)
-> Vector Double -> Double -> Vector Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FunCodeSV -> Double -> Vector Double -> Vector Double
vectorMapValR FunCodeSV
PowVS))
    pi :: Vector Double
pi    = [Double] -> Vector Double
forall a. Storable a => [a] -> Vector a
fromList [Double
forall a. Floating a => a
pi]

-------------------------------------------------------------

instance Floating (Vector (Complex Double)) where
    sin :: Vector (Complex Double) -> Vector (Complex Double)
sin   = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Sin
    cos :: Vector (Complex Double) -> Vector (Complex Double)
cos   = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Cos
    tan :: Vector (Complex Double) -> Vector (Complex Double)
tan   = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Tan
    asin :: Vector (Complex Double) -> Vector (Complex Double)
asin  = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
ASin
    acos :: Vector (Complex Double) -> Vector (Complex Double)
acos  = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
ACos
    atan :: Vector (Complex Double) -> Vector (Complex Double)
atan  = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
ATan
    sinh :: Vector (Complex Double) -> Vector (Complex Double)
sinh  = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Sinh
    cosh :: Vector (Complex Double) -> Vector (Complex Double)
cosh  = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Cosh
    tanh :: Vector (Complex Double) -> Vector (Complex Double)
tanh  = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Tanh
    asinh :: Vector (Complex Double) -> Vector (Complex Double)
asinh = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
ASinh
    acosh :: Vector (Complex Double) -> Vector (Complex Double)
acosh = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
ACosh
    atanh :: Vector (Complex Double) -> Vector (Complex Double)
atanh = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
ATanh
    exp :: Vector (Complex Double) -> Vector (Complex Double)
exp   = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Exp
    log :: Vector (Complex Double) -> Vector (Complex Double)
log   = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Log
    sqrt :: Vector (Complex Double) -> Vector (Complex Double)
sqrt  = FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
vectorMapC FunCodeV
Sqrt
    ** :: Vector (Complex Double)
-> Vector (Complex Double) -> Vector (Complex Double)
(**)  = (Complex Double
 -> Vector (Complex Double) -> Vector (Complex Double))
-> (Vector (Complex Double)
    -> Vector (Complex Double) -> Vector (Complex Double))
-> (Vector (Complex Double)
    -> Complex Double -> Vector (Complex Double))
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar (FunCodeSV
-> Complex Double
-> Vector (Complex Double)
-> Vector (Complex Double)
vectorMapValC FunCodeSV
PowSV) (FunCodeVV
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
vectorZipC FunCodeVV
Pow) ((Complex Double
 -> Vector (Complex Double) -> Vector (Complex Double))
-> Vector (Complex Double)
-> Complex Double
-> Vector (Complex Double)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FunCodeSV
-> Complex Double
-> Vector (Complex Double)
-> Vector (Complex Double)
vectorMapValC FunCodeSV
PowVS))
    pi :: Vector (Complex Double)
pi    = [Complex Double] -> Vector (Complex Double)
forall a. Storable a => [a] -> Vector a
fromList [Complex Double
forall a. Floating a => a
pi]

-----------------------------------------------------------

instance Floating (Vector (Complex Float)) where
    sin :: Vector (Complex Float) -> Vector (Complex Float)
sin   = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Sin
    cos :: Vector (Complex Float) -> Vector (Complex Float)
cos   = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Cos
    tan :: Vector (Complex Float) -> Vector (Complex Float)
tan   = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Tan
    asin :: Vector (Complex Float) -> Vector (Complex Float)
asin  = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
ASin
    acos :: Vector (Complex Float) -> Vector (Complex Float)
acos  = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
ACos
    atan :: Vector (Complex Float) -> Vector (Complex Float)
atan  = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
ATan
    sinh :: Vector (Complex Float) -> Vector (Complex Float)
sinh  = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Sinh
    cosh :: Vector (Complex Float) -> Vector (Complex Float)
cosh  = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Cosh
    tanh :: Vector (Complex Float) -> Vector (Complex Float)
tanh  = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Tanh
    asinh :: Vector (Complex Float) -> Vector (Complex Float)
asinh = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
ASinh
    acosh :: Vector (Complex Float) -> Vector (Complex Float)
acosh = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
ACosh
    atanh :: Vector (Complex Float) -> Vector (Complex Float)
atanh = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
ATanh
    exp :: Vector (Complex Float) -> Vector (Complex Float)
exp   = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Exp
    log :: Vector (Complex Float) -> Vector (Complex Float)
log   = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Log
    sqrt :: Vector (Complex Float) -> Vector (Complex Float)
sqrt  = FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
vectorMapQ FunCodeV
Sqrt
    ** :: Vector (Complex Float)
-> Vector (Complex Float) -> Vector (Complex Float)
(**)  = (Complex Float -> Vector (Complex Float) -> Vector (Complex Float))
-> (Vector (Complex Float)
    -> Vector (Complex Float) -> Vector (Complex Float))
-> (Vector (Complex Float)
    -> Complex Float -> Vector (Complex Float))
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Vector t2 -> t)
-> (Vector t1 -> Vector t2 -> t)
-> (Vector t1 -> t2 -> t)
-> Vector t1
-> Vector t2
-> t
adaptScalar (FunCodeSV
-> Complex Float
-> Vector (Complex Float)
-> Vector (Complex Float)
vectorMapValQ FunCodeSV
PowSV) (FunCodeVV
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
vectorZipQ FunCodeVV
Pow) ((Complex Float -> Vector (Complex Float) -> Vector (Complex Float))
-> Vector (Complex Float)
-> Complex Float
-> Vector (Complex Float)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FunCodeSV
-> Complex Float
-> Vector (Complex Float)
-> Vector (Complex Float)
vectorMapValQ FunCodeSV
PowVS))
    pi :: Vector (Complex Float)
pi    = [Complex Float] -> Vector (Complex Float)
forall a. Storable a => [a] -> Vector a
fromList [Complex Float
forall a. Floating a => a
pi]