module AERN2.Linear.Vector.Type where

import Control.Monad.ST
import Data.STRef
import MixedTypesNumPrelude hiding (length)
import qualified Data.Vector as V
import qualified Data.Vector.Generic.Mutable as M
import AERN2.MP.Precision
import AERN2.MP.Ball
import qualified Prelude as P

type (Vector a) = V.Vector a

(+++) :: Vector a -> Vector a -> Vector a
+++ :: Vector a -> Vector a -> Vector a
(+++) = Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
(V.++)

drop :: Int -> Vector a -> Vector a 
drop :: Int -> Vector a -> Vector a
drop = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop

take :: Int -> Vector a -> Vector a 
take :: Int -> Vector a -> Vector a
take = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take

empty :: Vector a
empty :: Vector a
empty = Vector a
forall a. Vector a
V.empty

singleton :: a -> Vector a
singleton :: a -> Vector a
singleton = a -> Vector a
forall a. a -> Vector a
V.singleton

cons :: a -> Vector a -> Vector a
cons :: a -> Vector a -> Vector a
cons = a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
V.cons

fromList :: [a] -> Vector a
fromList :: [a] -> Vector a
fromList = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList

map :: (a -> b) -> Vector a -> Vector b
map :: (a -> b) -> Vector a -> Vector b
map = (a -> b) -> Vector a -> Vector b
forall a b. (a -> b) -> Vector a -> Vector b
V.map

imap :: (Integer -> a -> b) -> Vector a -> Vector b
imap :: (Integer -> a -> b) -> Vector a -> Vector b
imap Integer -> a -> b
h = (Int -> a -> b) -> Vector a -> Vector b
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i a
x -> Integer -> a -> b
h (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
i) a
x)

enumFromTo :: Enum a => a -> a -> Vector a
enumFromTo :: a -> a -> Vector a
enumFromTo = a -> a -> Vector a
forall a. Enum a => a -> a -> Vector a
V.enumFromTo

slice :: Integer -> Integer -> Vector a -> Vector a
slice :: Integer -> Integer -> Vector a -> Vector a
slice Integer
i Integer
j = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
i) (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
j)

foldl' :: (b -> a -> b) -> b -> Vector a -> b
foldl' :: (b -> a -> b) -> b -> Vector a -> b
foldl' = (b -> a -> b) -> b -> Vector a -> b
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl'

zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c
zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c
zipWith = (a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith

(!) :: Vector a -> Integer -> a
(!) Vector a
v Integer
i = Vector a -> Int -> a
forall a. Vector a -> Int -> a
(V.!) Vector a
v (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
i)

length :: Vector a -> Integer
length :: Vector a -> Integer
length = Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer (Int -> Integer) -> (Vector a -> Int) -> Vector a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Int
forall a. Vector a -> Int
V.length

intLength :: Vector a -> Int 
intLength :: Vector a -> Int
intLength = Vector a -> Int
forall a. Vector a -> Int
V.length

inftyNorm :: (HasIntegers a, CanMinMaxSameType a) => Vector a -> a
inftyNorm :: Vector a -> a
inftyNorm (Vector a
v :: Vector a) =
    (a -> a -> a) -> a -> Vector a -> a
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' a -> a -> a
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max (Integer -> a
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: a) Vector a
v

find :: (a -> Bool) -> Vector a -> Maybe a 
find :: (a -> Bool) -> Vector a -> Maybe a
find = (a -> Bool) -> Vector a -> Maybe a
forall a. (a -> Bool) -> Vector a -> Maybe a
V.find

elem :: P.Eq a => a -> Vector a -> Bool
elem :: a -> Vector a -> Bool
elem = a -> Vector a -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem

toList :: Vector a -> [a] 
toList :: Vector a -> [a]
toList = Vector a -> [a]
forall a. Vector a -> [a]
V.toList

zip :: Vector a -> Vector b -> Vector (a, b) 
zip :: Vector a -> Vector b -> Vector (a, b)
zip = Vector a -> Vector b -> Vector (a, b)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip

null :: Vector a -> Bool
null :: Vector a -> Bool
null = Vector a -> Bool
forall a. Vector a -> Bool
V.null

any :: (a -> Bool) -> V.Vector a -> Bool
any :: (a -> Bool) -> Vector a -> Bool
any = (a -> Bool) -> Vector a -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.any

all :: (a -> Bool) -> V.Vector a -> Bool
all :: (a -> Bool) -> Vector a -> Bool
all = (a -> Bool) -> Vector a -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all
instance 
    (HasAccuracy a, HasPrecision a) => HasAccuracy (Vector a)
    where
    getAccuracy :: Vector a -> Accuracy
getAccuracy Vector a
v = 
        (Accuracy -> Accuracy -> Accuracy)
-> Accuracy -> Vector Accuracy -> Accuracy
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' Accuracy -> Accuracy -> Accuracy
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Accuracy
NoInformation (Vector Accuracy -> Accuracy) -> Vector Accuracy -> Accuracy
forall a b. (a -> b) -> a -> b
$ (a -> Accuracy) -> Vector a -> Vector Accuracy
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy Vector a
v

instance 
    (HasPrecision a) => HasPrecision (Vector a)
    where
    getPrecision :: Vector a -> Precision
getPrecision Vector a
v = 
        if Vector a -> Bool
forall a. Vector a -> Bool
V.null Vector a
v then 
            (Integer -> Precision
prec Integer
2) 
        else 
            a -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision (a -> Precision) -> a -> Precision
forall a b. (a -> b) -> a -> b
$ Vector a
v Vector a -> Integer -> a
forall a. Vector a -> Integer -> a
! Integer
0 -- TODO: safe? Alternative: V.foldl' max (prec 2) $ V.map getPrecision v 

instance 
    (CanSetPrecision a) => CanSetPrecision (Vector a)
    where
    setPrecision :: Precision -> Vector a -> Vector a
setPrecision Precision
p = (a -> a) -> Vector a -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Precision -> a -> a
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p)

instance 
    (CanAddSameType a) =>
    CanAddAsymmetric (Vector a) (Vector a)
    where
    type AddType (Vector a) (Vector a) = Vector a
    add :: Vector a -> Vector a -> AddType (Vector a) (Vector a)
add Vector a
v Vector a
w =
        (forall s. ST s (Vector a)) -> Vector a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector a)) -> Vector a)
-> (forall s. ST s (Vector a)) -> Vector a
forall a b. (a -> b) -> a -> b
$
        do
        MVector s a
mv <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
M.new (Vector a -> Int
forall a. Vector a -> Int
intLength Vector a
v)
        MVector s a -> Integer -> ST s ()
forall s. MVector s a -> Integer -> ST s ()
aux MVector s a
mv Integer
0
        MVector (PrimState (ST s)) a -> ST s (Vector a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector s a
MVector (PrimState (ST s)) a
mv
        where
        lth :: Integer
lth = Vector a -> Integer
forall a. Vector a -> Integer
length Vector a
v
        aux :: (V.MVector s a) -> Integer -> (ST s ())
        aux :: MVector s a -> Integer -> ST s ()
aux MVector s a
mv Integer
k = 
            if Integer
k Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
lth then
                () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else
                do                
                MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
M.write MVector s a
MVector (PrimState (ST s)) a
mv (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
k) (Vector a
v Vector a -> Integer -> a
forall a. Vector a -> Integer -> a
! Integer
k a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Vector a
w Vector a -> Integer -> a
forall a. Vector a -> Integer -> a
! Integer
k)
                MVector s a -> Integer -> ST s ()
forall s. MVector s a -> Integer -> ST s ()
aux MVector s a
mv (Integer
k Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1)

instance 
    (CanSubSameType a) =>
    CanSub (Vector a) (Vector a)
    where
    type SubType (Vector a) (Vector a) = Vector a
    sub :: Vector a -> Vector a -> SubType (Vector a) (Vector a)
sub Vector a
v Vector a
w =
        (forall s. ST s (Vector a)) -> Vector a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector a)) -> Vector a)
-> (forall s. ST s (Vector a)) -> Vector a
forall a b. (a -> b) -> a -> b
$
        do
        MVector s a
mv <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
M.new (Vector a -> Int
forall a. Vector a -> Int
intLength Vector a
v)
        MVector s a -> Integer -> ST s ()
forall s. MVector s a -> Integer -> ST s ()
aux MVector s a
mv Integer
0
        MVector (PrimState (ST s)) a -> ST s (Vector a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector s a
MVector (PrimState (ST s)) a
mv
        where
        lth :: Integer
lth = Vector a -> Integer
forall a. Vector a -> Integer
length Vector a
v
        aux :: (V.MVector s a) -> Integer -> (ST s ())
        aux :: MVector s a -> Integer -> ST s ()
aux MVector s a
mv Integer
k = 
            if Integer
k Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
lth then
                () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else
                do                
                MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
M.write MVector s a
MVector (PrimState (ST s)) a
mv (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
k) (Vector a
v Vector a -> Integer -> a
forall a. Vector a -> Integer -> a
! Integer
k a -> a -> SubType a a
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Vector a
w Vector a -> Integer -> a
forall a. Vector a -> Integer -> a
! Integer
k)
                MVector s a -> Integer -> ST s ()
forall s. MVector s a -> Integer -> ST s ()
aux MVector s a
mv (Integer
k Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1)


instance 
    (CanAddSameType a, CanMulSameType a, HasIntegers a) =>
    CanMulAsymmetric (Vector a) (Vector a) 
    where
    type MulType (Vector a) (Vector a) = a
    mul :: Vector a -> Vector a -> MulType (Vector a) (Vector a)
mul Vector a
v Vector a
w =
        (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$
        do
        STRef s a
sum <- a -> ST s (STRef s a)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> a
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0)
        STRef s a -> Integer -> ST s ()
forall s. STRef s a -> Integer -> ST s ()
aux STRef s a
sum Integer
0
        STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef STRef s a
sum
        where
        lth :: Integer
lth = Vector a -> Integer
forall a. Vector a -> Integer
length Vector a
v
        aux :: (STRef s a) -> Integer -> (ST s ())
        aux :: STRef s a -> Integer -> ST s ()
aux STRef s a
sum Integer
k = 
            if Integer
k Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
lth then
                () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else
                do                
                STRef s a -> (a -> a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s a
sum (\a
x -> a
x a -> a -> AddType a a
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Vector a
v Vector a -> Integer -> a
forall a. Vector a -> Integer -> a
! Integer
k) a -> a -> MulType a a
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (Vector a
w Vector a -> Integer -> a
forall a. Vector a -> Integer -> a
! Integer
k))
                STRef s a -> Integer -> ST s ()
forall s. STRef s a -> Integer -> ST s ()
aux STRef s a
sum (Integer
k Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1)

instance 
    CanMulAsymmetric (CN MPBall) (Vector (CN MPBall)) where
    type MulType (CN MPBall) (Vector (CN MPBall)) = Vector (CN MPBall)
    mul :: CN MPBall
-> Vector (CN MPBall) -> MulType (CN MPBall) (Vector (CN MPBall))
mul CN MPBall
x Vector (CN MPBall)
v = (CN MPBall -> CN MPBall)
-> Vector (CN MPBall) -> Vector (CN MPBall)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\CN MPBall
y -> CN MPBall
x CN MPBall -> CN MPBall -> MulType (CN MPBall) (CN MPBall)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* CN MPBall
y) Vector (CN MPBall)
v