diff options
Diffstat (limited to 'packages/base/src/Numeric/Vectorized.hs')
-rw-r--r-- | packages/base/src/Numeric/Vectorized.hs | 399 |
1 files changed, 0 insertions, 399 deletions
diff --git a/packages/base/src/Numeric/Vectorized.hs b/packages/base/src/Numeric/Vectorized.hs deleted file mode 100644 index 589cb49..0000000 --- a/packages/base/src/Numeric/Vectorized.hs +++ /dev/null | |||
@@ -1,399 +0,0 @@ | |||
1 | ----------------------------------------------------------------------------- | ||
2 | -- | | ||
3 | -- Module : Numeric.Vectorized | ||
4 | -- Copyright : (c) Alberto Ruiz 2007-15 | ||
5 | -- License : BSD3 | ||
6 | -- Maintainer : Alberto Ruiz | ||
7 | -- Stability : provisional | ||
8 | -- | ||
9 | -- Low level interface to vector operations. | ||
10 | -- | ||
11 | ----------------------------------------------------------------------------- | ||
12 | |||
13 | module Numeric.Vectorized ( | ||
14 | sumF, sumR, sumQ, sumC, sumI, | ||
15 | prodF, prodR, prodQ, prodC, prodI, | ||
16 | FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, toScalarI, | ||
17 | FunCodeV(..), vectorMapR, vectorMapC, vectorMapF, vectorMapQ, vectorMapI, | ||
18 | FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF, vectorMapValQ, vectorMapValI, | ||
19 | FunCodeVV(..), vectorZipR, vectorZipC, vectorZipF, vectorZipQ, vectorZipI, | ||
20 | vectorScan, saveMatrix, | ||
21 | Seed, RandDist(..), randomVector, | ||
22 | roundVector, | ||
23 | range, | ||
24 | -- compareD, compareF, compareI, | ||
25 | -- chooseD, chooseF, chooseI | ||
26 | ) where | ||
27 | |||
28 | import Data.Packed.Internal.Common | ||
29 | import Data.Packed.Internal.Signatures | ||
30 | import Data.Packed.Internal.Vector | ||
31 | import Data.Packed.Internal.Matrix | ||
32 | |||
33 | import Data.Complex | ||
34 | import Foreign.Marshal.Alloc(free,malloc) | ||
35 | import Foreign.Marshal.Array(newArray,copyArray) | ||
36 | import Foreign.Ptr(Ptr) | ||
37 | import Foreign.Storable(peek) | ||
38 | import Foreign.C.Types | ||
39 | import Foreign.C.String | ||
40 | import System.IO.Unsafe(unsafePerformIO) | ||
41 | |||
42 | import Control.Monad(when) | ||
43 | |||
44 | |||
45 | |||
46 | fromei x = fromIntegral (fromEnum x) :: CInt | ||
47 | |||
48 | data FunCodeV = Sin | ||
49 | | Cos | ||
50 | | Tan | ||
51 | | Abs | ||
52 | | ASin | ||
53 | | ACos | ||
54 | | ATan | ||
55 | | Sinh | ||
56 | | Cosh | ||
57 | | Tanh | ||
58 | | ASinh | ||
59 | | ACosh | ||
60 | | ATanh | ||
61 | | Exp | ||
62 | | Log | ||
63 | | Sign | ||
64 | | Sqrt | ||
65 | deriving Enum | ||
66 | |||
67 | data FunCodeSV = Scale | ||
68 | | Recip | ||
69 | | AddConstant | ||
70 | | Negate | ||
71 | | PowSV | ||
72 | | PowVS | ||
73 | | ModSV | ||
74 | | ModVS | ||
75 | deriving Enum | ||
76 | |||
77 | data FunCodeVV = Add | ||
78 | | Sub | ||
79 | | Mul | ||
80 | | Div | ||
81 | | Pow | ||
82 | | ATan2 | ||
83 | | Mod | ||
84 | deriving Enum | ||
85 | |||
86 | data FunCodeS = Norm2 | ||
87 | | AbsSum | ||
88 | | MaxIdx | ||
89 | | Max | ||
90 | | MinIdx | ||
91 | | Min | ||
92 | deriving Enum | ||
93 | |||
94 | ------------------------------------------------------------------ | ||
95 | |||
96 | -- | sum of elements | ||
97 | sumF :: Vector Float -> Float | ||
98 | sumF = sumg c_sumF | ||
99 | |||
100 | -- | sum of elements | ||
101 | sumR :: Vector Double -> Double | ||
102 | sumR = sumg c_sumR | ||
103 | |||
104 | -- | sum of elements | ||
105 | sumQ :: Vector (Complex Float) -> Complex Float | ||
106 | sumQ = sumg c_sumQ | ||
107 | |||
108 | -- | sum of elements | ||
109 | sumC :: Vector (Complex Double) -> Complex Double | ||
110 | sumC = sumg c_sumC | ||
111 | |||
112 | -- | sum of elements | ||
113 | sumI :: Vector CInt -> CInt | ||
114 | sumI = sumg c_sumI | ||
115 | |||
116 | sumg f x = unsafePerformIO $ do | ||
117 | r <- createVector 1 | ||
118 | app2 f vec x vec r "sum" | ||
119 | return $ r @> 0 | ||
120 | |||
121 | foreign import ccall unsafe "sumF" c_sumF :: TFF | ||
122 | foreign import ccall unsafe "sumR" c_sumR :: TVV | ||
123 | foreign import ccall unsafe "sumQ" c_sumQ :: TQVQV | ||
124 | foreign import ccall unsafe "sumC" c_sumC :: TCVCV | ||
125 | foreign import ccall unsafe "sumC" c_sumI :: CV CInt (CV CInt (IO CInt)) | ||
126 | |||
127 | -- | product of elements | ||
128 | prodF :: Vector Float -> Float | ||
129 | prodF = prodg c_prodF | ||
130 | |||
131 | -- | product of elements | ||
132 | prodR :: Vector Double -> Double | ||
133 | prodR = prodg c_prodR | ||
134 | |||
135 | -- | product of elements | ||
136 | prodQ :: Vector (Complex Float) -> Complex Float | ||
137 | prodQ = prodg c_prodQ | ||
138 | |||
139 | -- | product of elements | ||
140 | prodC :: Vector (Complex Double) -> Complex Double | ||
141 | prodC = prodg c_prodC | ||
142 | |||
143 | -- | product of elements | ||
144 | prodI :: Vector CInt -> CInt | ||
145 | prodI = prodg c_prodI | ||
146 | |||
147 | |||
148 | prodg f x = unsafePerformIO $ do | ||
149 | r <- createVector 1 | ||
150 | app2 f vec x vec r "prod" | ||
151 | return $ r @> 0 | ||
152 | |||
153 | |||
154 | foreign import ccall unsafe "prodF" c_prodF :: TFF | ||
155 | foreign import ccall unsafe "prodR" c_prodR :: TVV | ||
156 | foreign import ccall unsafe "prodQ" c_prodQ :: TQVQV | ||
157 | foreign import ccall unsafe "prodC" c_prodC :: TCVCV | ||
158 | foreign import ccall unsafe "prodI" c_prodI :: CV CInt (CV CInt (IO CInt)) | ||
159 | |||
160 | ------------------------------------------------------------------ | ||
161 | |||
162 | toScalarAux fun code v = unsafePerformIO $ do | ||
163 | r <- createVector 1 | ||
164 | app2 (fun (fromei code)) vec v vec r "toScalarAux" | ||
165 | return (r `at` 0) | ||
166 | |||
167 | vectorMapAux fun code v = unsafePerformIO $ do | ||
168 | r <- createVector (dim v) | ||
169 | app2 (fun (fromei code)) vec v vec r "vectorMapAux" | ||
170 | return r | ||
171 | |||
172 | vectorMapValAux fun code val v = unsafePerformIO $ do | ||
173 | r <- createVector (dim v) | ||
174 | pval <- newArray [val] | ||
175 | app2 (fun (fromei code) pval) vec v vec r "vectorMapValAux" | ||
176 | free pval | ||
177 | return r | ||
178 | |||
179 | vectorZipAux fun code u v = unsafePerformIO $ do | ||
180 | r <- createVector (dim u) | ||
181 | app3 (fun (fromei code)) vec u vec v vec r "vectorZipAux" | ||
182 | return r | ||
183 | |||
184 | --------------------------------------------------------------------- | ||
185 | |||
186 | -- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc. | ||
187 | toScalarR :: FunCodeS -> Vector Double -> Double | ||
188 | toScalarR oper = toScalarAux c_toScalarR (fromei oper) | ||
189 | |||
190 | foreign import ccall unsafe "toScalarR" c_toScalarR :: CInt -> TVV | ||
191 | |||
192 | -- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc. | ||
193 | toScalarF :: FunCodeS -> Vector Float -> Float | ||
194 | toScalarF oper = toScalarAux c_toScalarF (fromei oper) | ||
195 | |||
196 | foreign import ccall unsafe "toScalarF" c_toScalarF :: CInt -> TFF | ||
197 | |||
198 | -- | obtains different functions of a vector: only norm1, norm2 | ||
199 | toScalarC :: FunCodeS -> Vector (Complex Double) -> Double | ||
200 | toScalarC oper = toScalarAux c_toScalarC (fromei oper) | ||
201 | |||
202 | foreign import ccall unsafe "toScalarC" c_toScalarC :: CInt -> TCVV | ||
203 | |||
204 | -- | obtains different functions of a vector: only norm1, norm2 | ||
205 | toScalarQ :: FunCodeS -> Vector (Complex Float) -> Float | ||
206 | toScalarQ oper = toScalarAux c_toScalarQ (fromei oper) | ||
207 | |||
208 | foreign import ccall unsafe "toScalarQ" c_toScalarQ :: CInt -> TQVF | ||
209 | |||
210 | -- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc. | ||
211 | toScalarI :: FunCodeS -> Vector CInt -> CInt | ||
212 | toScalarI oper = toScalarAux c_toScalarI (fromei oper) | ||
213 | |||
214 | foreign import ccall unsafe "toScalarI" c_toScalarI :: CInt -> CV CInt (CV CInt (IO CInt)) | ||
215 | |||
216 | ------------------------------------------------------------------ | ||
217 | |||
218 | -- | map of real vectors with given function | ||
219 | vectorMapR :: FunCodeV -> Vector Double -> Vector Double | ||
220 | vectorMapR = vectorMapAux c_vectorMapR | ||
221 | |||
222 | foreign import ccall unsafe "mapR" c_vectorMapR :: CInt -> TVV | ||
223 | |||
224 | -- | map of complex vectors with given function | ||
225 | vectorMapC :: FunCodeV -> Vector (Complex Double) -> Vector (Complex Double) | ||
226 | vectorMapC oper = vectorMapAux c_vectorMapC (fromei oper) | ||
227 | |||
228 | foreign import ccall unsafe "mapC" c_vectorMapC :: CInt -> TCVCV | ||
229 | |||
230 | -- | map of real vectors with given function | ||
231 | vectorMapF :: FunCodeV -> Vector Float -> Vector Float | ||
232 | vectorMapF = vectorMapAux c_vectorMapF | ||
233 | |||
234 | foreign import ccall unsafe "mapF" c_vectorMapF :: CInt -> TFF | ||
235 | |||
236 | -- | map of real vectors with given function | ||
237 | vectorMapQ :: FunCodeV -> Vector (Complex Float) -> Vector (Complex Float) | ||
238 | vectorMapQ = vectorMapAux c_vectorMapQ | ||
239 | |||
240 | foreign import ccall unsafe "mapQ" c_vectorMapQ :: CInt -> TQVQV | ||
241 | |||
242 | -- | map of real vectors with given function | ||
243 | vectorMapI :: FunCodeV -> Vector CInt -> Vector CInt | ||
244 | vectorMapI = vectorMapAux c_vectorMapI | ||
245 | |||
246 | foreign import ccall unsafe "mapI" c_vectorMapI :: CInt -> CV CInt (CV CInt (IO CInt)) | ||
247 | |||
248 | ------------------------------------------------------------------- | ||
249 | |||
250 | -- | map of real vectors with given function | ||
251 | vectorMapValR :: FunCodeSV -> Double -> Vector Double -> Vector Double | ||
252 | vectorMapValR oper = vectorMapValAux c_vectorMapValR (fromei oper) | ||
253 | |||
254 | foreign import ccall unsafe "mapValR" c_vectorMapValR :: CInt -> Ptr Double -> TVV | ||
255 | |||
256 | -- | map of complex vectors with given function | ||
257 | vectorMapValC :: FunCodeSV -> Complex Double -> Vector (Complex Double) -> Vector (Complex Double) | ||
258 | vectorMapValC = vectorMapValAux c_vectorMapValC | ||
259 | |||
260 | foreign import ccall unsafe "mapValC" c_vectorMapValC :: CInt -> Ptr (Complex Double) -> TCVCV | ||
261 | |||
262 | -- | map of real vectors with given function | ||
263 | vectorMapValF :: FunCodeSV -> Float -> Vector Float -> Vector Float | ||
264 | vectorMapValF oper = vectorMapValAux c_vectorMapValF (fromei oper) | ||
265 | |||
266 | foreign import ccall unsafe "mapValF" c_vectorMapValF :: CInt -> Ptr Float -> TFF | ||
267 | |||
268 | -- | map of complex vectors with given function | ||
269 | vectorMapValQ :: FunCodeSV -> Complex Float -> Vector (Complex Float) -> Vector (Complex Float) | ||
270 | vectorMapValQ oper = vectorMapValAux c_vectorMapValQ (fromei oper) | ||
271 | |||
272 | foreign import ccall unsafe "mapValQ" c_vectorMapValQ :: CInt -> Ptr (Complex Float) -> TQVQV | ||
273 | |||
274 | -- | map of real vectors with given function | ||
275 | vectorMapValI :: FunCodeSV -> CInt -> Vector CInt -> Vector CInt | ||
276 | vectorMapValI oper = vectorMapValAux c_vectorMapValI (fromei oper) | ||
277 | |||
278 | foreign import ccall unsafe "mapValI" c_vectorMapValI :: CInt -> Ptr CInt -> CV CInt (CV CInt (IO CInt)) | ||
279 | |||
280 | |||
281 | ------------------------------------------------------------------- | ||
282 | |||
283 | -- | elementwise operation on real vectors | ||
284 | vectorZipR :: FunCodeVV -> Vector Double -> Vector Double -> Vector Double | ||
285 | vectorZipR = vectorZipAux c_vectorZipR | ||
286 | |||
287 | foreign import ccall unsafe "zipR" c_vectorZipR :: CInt -> TVVV | ||
288 | |||
289 | -- | elementwise operation on complex vectors | ||
290 | vectorZipC :: FunCodeVV -> Vector (Complex Double) -> Vector (Complex Double) -> Vector (Complex Double) | ||
291 | vectorZipC = vectorZipAux c_vectorZipC | ||
292 | |||
293 | foreign import ccall unsafe "zipC" c_vectorZipC :: CInt -> TCVCVCV | ||
294 | |||
295 | -- | elementwise operation on real vectors | ||
296 | vectorZipF :: FunCodeVV -> Vector Float -> Vector Float -> Vector Float | ||
297 | vectorZipF = vectorZipAux c_vectorZipF | ||
298 | |||
299 | foreign import ccall unsafe "zipF" c_vectorZipF :: CInt -> TFFF | ||
300 | |||
301 | -- | elementwise operation on complex vectors | ||
302 | vectorZipQ :: FunCodeVV -> Vector (Complex Float) -> Vector (Complex Float) -> Vector (Complex Float) | ||
303 | vectorZipQ = vectorZipAux c_vectorZipQ | ||
304 | |||
305 | foreign import ccall unsafe "zipQ" c_vectorZipQ :: CInt -> TQVQVQV | ||
306 | |||
307 | -- | elementwise operation on CInt vectors | ||
308 | vectorZipI :: FunCodeVV -> Vector CInt -> Vector CInt -> Vector CInt | ||
309 | vectorZipI = vectorZipAux c_vectorZipI | ||
310 | |||
311 | foreign import ccall unsafe "zipI" c_vectorZipI :: CInt -> CV CInt (CV CInt (CV CInt (IO CInt))) | ||
312 | |||
313 | |||
314 | -------------------------------------------------------------------------------- | ||
315 | |||
316 | foreign import ccall unsafe "vectorScan" c_vectorScan | ||
317 | :: CString -> Ptr CInt -> Ptr (Ptr Double) -> IO CInt | ||
318 | |||
319 | vectorScan :: FilePath -> IO (Vector Double) | ||
320 | vectorScan s = do | ||
321 | pp <- malloc | ||
322 | pn <- malloc | ||
323 | cs <- newCString s | ||
324 | ok <- c_vectorScan cs pn pp | ||
325 | when (not (ok == 0)) $ | ||
326 | error ("vectorScan: file \"" ++ s ++"\" not found") | ||
327 | n <- fromIntegral <$> peek pn | ||
328 | p <- peek pp | ||
329 | v <- createVector n | ||
330 | free pn | ||
331 | free cs | ||
332 | unsafeWith v $ \pv -> copyArray pv p n | ||
333 | free p | ||
334 | free pp | ||
335 | return v | ||
336 | |||
337 | -------------------------------------------------------------------------------- | ||
338 | |||
339 | foreign import ccall unsafe "saveMatrix" c_saveMatrix | ||
340 | :: CString -> CString -> TM | ||
341 | |||
342 | {- | save a matrix as a 2D ASCII table | ||
343 | -} | ||
344 | saveMatrix | ||
345 | :: FilePath | ||
346 | -> String -- ^ \"printf\" format (e.g. \"%.2f\", \"%g\", etc.) | ||
347 | -> Matrix Double | ||
348 | -> IO () | ||
349 | saveMatrix name format m = do | ||
350 | cname <- newCString name | ||
351 | cformat <- newCString format | ||
352 | app1 (c_saveMatrix cname cformat) mat m "saveMatrix" | ||
353 | free cname | ||
354 | free cformat | ||
355 | return () | ||
356 | |||
357 | -------------------------------------------------------------------------------- | ||
358 | |||
359 | type Seed = Int | ||
360 | |||
361 | data RandDist = Uniform -- ^ uniform distribution in [0,1) | ||
362 | | Gaussian -- ^ normal distribution with mean zero and standard deviation one | ||
363 | deriving Enum | ||
364 | |||
365 | -- | Obtains a vector of pseudorandom elements (use randomIO to get a random seed). | ||
366 | randomVector :: Seed | ||
367 | -> RandDist -- ^ distribution | ||
368 | -> Int -- ^ vector size | ||
369 | -> Vector Double | ||
370 | randomVector seed dist n = unsafePerformIO $ do | ||
371 | r <- createVector n | ||
372 | app1 (c_random_vector (fi seed) ((fi.fromEnum) dist)) vec r "randomVector" | ||
373 | return r | ||
374 | |||
375 | foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV | ||
376 | |||
377 | -------------------------------------------------------------------------------- | ||
378 | |||
379 | roundVector v = unsafePerformIO $ do | ||
380 | r <- createVector (dim v) | ||
381 | app2 c_round_vector vec v vec r "roundVector" | ||
382 | return r | ||
383 | |||
384 | foreign import ccall unsafe "round_vector" c_round_vector :: TVV | ||
385 | |||
386 | -------------------------------------------------------------------------------- | ||
387 | |||
388 | -- | | ||
389 | -- >>> range 5 | ||
390 | -- fromList [0,1,2,3,4] | ||
391 | -- | ||
392 | range :: Int -> Vector I | ||
393 | range n = unsafePerformIO $ do | ||
394 | r <- createVector n | ||
395 | app1 c_range_vector vec r "range" | ||
396 | return r | ||
397 | |||
398 | foreign import ccall unsafe "range_vector" c_range_vector :: CV CInt (IO CInt) | ||
399 | |||