diff options
Diffstat (limited to 'lib/GSL/Vector.hs')
-rw-r--r-- | lib/GSL/Vector.hs | 163 |
1 files changed, 163 insertions, 0 deletions
diff --git a/lib/GSL/Vector.hs b/lib/GSL/Vector.hs new file mode 100644 index 0000000..e538b7e --- /dev/null +++ b/lib/GSL/Vector.hs | |||
@@ -0,0 +1,163 @@ | |||
1 | {-# OPTIONS_GHC -fglasgow-exts #-} | ||
2 | ----------------------------------------------------------------------------- | ||
3 | -- | | ||
4 | -- Module : GSL.Vector | ||
5 | -- Copyright : (c) Alberto Ruiz 2007 | ||
6 | -- License : GPL-style | ||
7 | -- | ||
8 | -- Maintainer : Alberto Ruiz <aruiz@um.es> | ||
9 | -- Stability : provisional | ||
10 | -- Portability : portable (uses FFI) | ||
11 | -- | ||
12 | -- Vector operations | ||
13 | -- | ||
14 | ----------------------------------------------------------------------------- | ||
15 | |||
16 | module GSL.Vector ( | ||
17 | FunCodeS(..), toScalarR, | ||
18 | FunCodeV(..), vectorMapR, vectorMapC, | ||
19 | FunCodeSV(..), vectorMapValR, vectorMapValC, | ||
20 | FunCodeVV(..), vectorZipR, vectorZipC, | ||
21 | scale, addConstant | ||
22 | ) where | ||
23 | |||
24 | import Data.Packed.Internal | ||
25 | import Complex | ||
26 | import Foreign | ||
27 | |||
28 | data FunCodeV = Sin | ||
29 | | Cos | ||
30 | | Tan | ||
31 | | Abs | ||
32 | | ASin | ||
33 | | ACos | ||
34 | | ATan | ||
35 | | Sinh | ||
36 | | Cosh | ||
37 | | Tanh | ||
38 | | ASinh | ||
39 | | ACosh | ||
40 | | ATanh | ||
41 | | Exp | ||
42 | | Log | ||
43 | | Sign | ||
44 | | Sqrt | ||
45 | deriving Enum | ||
46 | |||
47 | data FunCodeSV = Scale | ||
48 | | Recip | ||
49 | | AddConstant | ||
50 | | Negate | ||
51 | | PowSV | ||
52 | | PowVS | ||
53 | deriving Enum | ||
54 | |||
55 | data FunCodeVV = Add | ||
56 | | Sub | ||
57 | | Mul | ||
58 | | Div | ||
59 | | Pow | ||
60 | | ATan2 | ||
61 | deriving Enum | ||
62 | |||
63 | data FunCodeS = Norm2 | ||
64 | | AbsSum | ||
65 | | MaxIdx | ||
66 | | Max | ||
67 | | MinIdx | ||
68 | | Min | ||
69 | deriving Enum | ||
70 | |||
71 | |||
72 | scale :: (Num a, Field a) => a -> Vector a -> Vector a | ||
73 | scale x v | isReal baseOf v = scast $ vectorMapValR Scale (scast x) (scast v) | ||
74 | | isComp baseOf v = scast $ vectorMapValC Scale (scast x) (scast v) | ||
75 | | otherwise = fromList $ map (*x) $ toList v | ||
76 | |||
77 | addConstant :: (Num a, Field a) => a -> Vector a -> Vector a | ||
78 | addConstant x v | isReal baseOf v = scast $ vectorMapValR AddConstant (scast x) (scast v) | ||
79 | | isComp baseOf v = scast $ vectorMapValC AddConstant (scast x) (scast v) | ||
80 | | otherwise = fromList $ map (*x) $ toList v | ||
81 | |||
82 | ------------------------------------------------------------------ | ||
83 | |||
84 | toScalarAux fun code v = unsafePerformIO $ do | ||
85 | r <- createVector 1 | ||
86 | fun (fromEnum code) // vec v // vec r // check "toScalarAux" [v] | ||
87 | return (r `at` 0) | ||
88 | |||
89 | vectorMapAux fun code v = unsafePerformIO $ do | ||
90 | r <- createVector (dim v) | ||
91 | fun (fromEnum code) // vec v // vec r // check "vectorMapAux" [v] | ||
92 | return r | ||
93 | |||
94 | vectorMapValAux fun code val v = unsafePerformIO $ do | ||
95 | r <- createVector (dim v) | ||
96 | pval <- newArray [val] | ||
97 | fun (fromEnum code) pval // vec v // vec r // check "vectorMapValAux" [v] | ||
98 | free pval | ||
99 | return r | ||
100 | |||
101 | vectorZipAux fun code u v = unsafePerformIO $ do | ||
102 | r <- createVector (dim u) | ||
103 | fun (fromEnum code) // vec u // vec v // vec r // check "vectorZipAux" [u,v] | ||
104 | return r | ||
105 | |||
106 | --------------------------------------------------------------------- | ||
107 | |||
108 | -- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc. | ||
109 | toScalarR :: FunCodeS -> Vector Double -> Double | ||
110 | toScalarR oper = toScalarAux c_toScalarR (fromEnum oper) | ||
111 | |||
112 | foreign import ccall safe "gsl-aux.h toScalarR" | ||
113 | c_toScalarR :: Int -> Double :> Double :> IO Int | ||
114 | |||
115 | ------------------------------------------------------------------ | ||
116 | |||
117 | -- | map of real vectors with given function | ||
118 | vectorMapR :: FunCodeV -> Vector Double -> Vector Double | ||
119 | vectorMapR = vectorMapAux c_vectorMapR | ||
120 | |||
121 | foreign import ccall safe "gsl-aux.h mapR" | ||
122 | c_vectorMapR :: Int -> Double :> Double :> IO Int | ||
123 | |||
124 | -- | map of complex vectors with given function | ||
125 | vectorMapC :: FunCodeV -> Vector (Complex Double) -> Vector (Complex Double) | ||
126 | vectorMapC oper = vectorMapAux c_vectorMapC (fromEnum oper) | ||
127 | |||
128 | foreign import ccall safe "gsl-aux.h mapC" | ||
129 | c_vectorMapC :: Int -> Complex Double :> Complex Double :> IO Int | ||
130 | |||
131 | ------------------------------------------------------------------- | ||
132 | |||
133 | -- | map of real vectors with given function | ||
134 | vectorMapValR :: FunCodeSV -> Double -> Vector Double -> Vector Double | ||
135 | vectorMapValR oper = vectorMapValAux c_vectorMapValR (fromEnum oper) | ||
136 | |||
137 | foreign import ccall safe "gsl-aux.h mapValR" | ||
138 | c_vectorMapValR :: Int -> Ptr Double -> Double :> Double :> IO Int | ||
139 | |||
140 | -- | map of complex vectors with given function | ||
141 | vectorMapValC :: FunCodeSV -> Complex Double -> Vector (Complex Double) -> Vector (Complex Double) | ||
142 | vectorMapValC = vectorMapValAux c_vectorMapValC | ||
143 | |||
144 | foreign import ccall safe "gsl-aux.h mapValC" | ||
145 | c_vectorMapValC :: Int -> Ptr (Complex Double) -> Complex Double :> Complex Double :> IO Int | ||
146 | |||
147 | ------------------------------------------------------------------- | ||
148 | |||
149 | -- | elementwise operation on real vectors | ||
150 | vectorZipR :: FunCodeVV -> Vector Double -> Vector Double -> Vector Double | ||
151 | vectorZipR = vectorZipAux c_vectorZipR | ||
152 | |||
153 | foreign import ccall safe "gsl-aux.h zipR" | ||
154 | c_vectorZipR :: Int -> Double :> Double :> Double :> IO Int | ||
155 | |||
156 | -- | elementwise operation on complex vectors | ||
157 | vectorZipC :: FunCodeVV -> Vector (Complex Double) -> Vector (Complex Double) -> Vector (Complex Double) | ||
158 | vectorZipC = vectorZipAux c_vectorZipC | ||
159 | |||
160 | foreign import ccall safe "gsl-aux.h zipC" | ||
161 | c_vectorZipC :: Int -> Complex Double :> Complex Double :> Complex Double :> IO Int | ||
162 | |||
163 | |||