diff options
author | Alberto Ruiz <aruiz@um.es> | 2015-06-05 16:50:43 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2015-06-05 16:50:43 +0200 |
commit | 83f3371700441e50927f24a19e28164cc5194f03 (patch) | |
tree | 2c24b393c63db0750732b24e9d89433c6f87a3ea /packages/base/src/Internal/Vectorized.hs | |
parent | 45ccf2b25783c656b5ecd48027d8f3a3f2dea001 (diff) |
move vectorized
Diffstat (limited to 'packages/base/src/Internal/Vectorized.hs')
-rw-r--r-- | packages/base/src/Internal/Vectorized.hs | 469 |
1 files changed, 469 insertions, 0 deletions
diff --git a/packages/base/src/Internal/Vectorized.hs b/packages/base/src/Internal/Vectorized.hs new file mode 100644 index 0000000..ddb14c9 --- /dev/null +++ b/packages/base/src/Internal/Vectorized.hs | |||
@@ -0,0 +1,469 @@ | |||
1 | {-# LANGUAGE TypeOperators #-} | ||
2 | |||
3 | ----------------------------------------------------------------------------- | ||
4 | -- | | ||
5 | -- Module : Numeric.Vectorized | ||
6 | -- Copyright : (c) Alberto Ruiz 2007-15 | ||
7 | -- License : BSD3 | ||
8 | -- Maintainer : Alberto Ruiz | ||
9 | -- Stability : provisional | ||
10 | -- | ||
11 | -- Low level interface to vector operations. | ||
12 | -- | ||
13 | ----------------------------------------------------------------------------- | ||
14 | |||
15 | module Internal.Vectorized where | ||
16 | |||
17 | import Internal.Tools | ||
18 | import Internal.Vector | ||
19 | import Internal.Devel | ||
20 | |||
21 | import Data.Complex | ||
22 | import Foreign.Marshal.Alloc(free,malloc) | ||
23 | import Foreign.Marshal.Array(newArray,copyArray) | ||
24 | import Foreign.Ptr(Ptr) | ||
25 | import Foreign.Storable(peek,Storable) | ||
26 | import Foreign.C.Types | ||
27 | import Foreign.C.String | ||
28 | import System.IO.Unsafe(unsafePerformIO) | ||
29 | |||
30 | import Control.Monad(when) | ||
31 | import Data.Vector.Storable ( unsafeWith ) | ||
32 | |||
33 | |||
34 | fromei x = fromIntegral (fromEnum x) :: CInt | ||
35 | |||
36 | data FunCodeV = Sin | ||
37 | | Cos | ||
38 | | Tan | ||
39 | | Abs | ||
40 | | ASin | ||
41 | | ACos | ||
42 | | ATan | ||
43 | | Sinh | ||
44 | | Cosh | ||
45 | | Tanh | ||
46 | | ASinh | ||
47 | | ACosh | ||
48 | | ATanh | ||
49 | | Exp | ||
50 | | Log | ||
51 | | Sign | ||
52 | | Sqrt | ||
53 | deriving Enum | ||
54 | |||
55 | data FunCodeSV = Scale | ||
56 | | Recip | ||
57 | | AddConstant | ||
58 | | Negate | ||
59 | | PowSV | ||
60 | | PowVS | ||
61 | | ModSV | ||
62 | | ModVS | ||
63 | deriving Enum | ||
64 | |||
65 | data FunCodeVV = Add | ||
66 | | Sub | ||
67 | | Mul | ||
68 | | Div | ||
69 | | Pow | ||
70 | | ATan2 | ||
71 | | Mod | ||
72 | deriving Enum | ||
73 | |||
74 | data FunCodeS = Norm2 | ||
75 | | AbsSum | ||
76 | | MaxIdx | ||
77 | | Max | ||
78 | | MinIdx | ||
79 | | Min | ||
80 | deriving Enum | ||
81 | |||
82 | ------------------------------------------------------------------ | ||
83 | |||
84 | -- | sum of elements | ||
85 | sumF :: Vector Float -> Float | ||
86 | sumF = sumg c_sumF | ||
87 | |||
88 | -- | sum of elements | ||
89 | sumR :: Vector Double -> Double | ||
90 | sumR = sumg c_sumR | ||
91 | |||
92 | -- | sum of elements | ||
93 | sumQ :: Vector (Complex Float) -> Complex Float | ||
94 | sumQ = sumg c_sumQ | ||
95 | |||
96 | -- | sum of elements | ||
97 | sumC :: Vector (Complex Double) -> Complex Double | ||
98 | sumC = sumg c_sumC | ||
99 | |||
100 | -- | sum of elements | ||
101 | sumI :: Vector CInt -> CInt | ||
102 | sumI = sumg c_sumI | ||
103 | |||
104 | sumg f x = unsafePerformIO $ do | ||
105 | r <- createVector 1 | ||
106 | app2 f vec x vec r "sum" | ||
107 | return $ r @> 0 | ||
108 | |||
109 | type TVV t = t :> t :> Ok | ||
110 | |||
111 | foreign import ccall unsafe "sumF" c_sumF :: TVV Float | ||
112 | foreign import ccall unsafe "sumR" c_sumR :: TVV Double | ||
113 | foreign import ccall unsafe "sumQ" c_sumQ :: TVV (Complex Float) | ||
114 | foreign import ccall unsafe "sumC" c_sumC :: TVV (Complex Double) | ||
115 | foreign import ccall unsafe "sumI" c_sumI :: TVV CInt | ||
116 | |||
117 | -- | product of elements | ||
118 | prodF :: Vector Float -> Float | ||
119 | prodF = prodg c_prodF | ||
120 | |||
121 | -- | product of elements | ||
122 | prodR :: Vector Double -> Double | ||
123 | prodR = prodg c_prodR | ||
124 | |||
125 | -- | product of elements | ||
126 | prodQ :: Vector (Complex Float) -> Complex Float | ||
127 | prodQ = prodg c_prodQ | ||
128 | |||
129 | -- | product of elements | ||
130 | prodC :: Vector (Complex Double) -> Complex Double | ||
131 | prodC = prodg c_prodC | ||
132 | |||
133 | -- | product of elements | ||
134 | prodI :: Vector CInt -> CInt | ||
135 | prodI = prodg c_prodI | ||
136 | |||
137 | |||
138 | prodg f x = unsafePerformIO $ do | ||
139 | r <- createVector 1 | ||
140 | app2 f vec x vec r "prod" | ||
141 | return $ r @> 0 | ||
142 | |||
143 | |||
144 | foreign import ccall unsafe "prodF" c_prodF :: TVV Float | ||
145 | foreign import ccall unsafe "prodR" c_prodR :: TVV Double | ||
146 | foreign import ccall unsafe "prodQ" c_prodQ :: TVV (Complex Float) | ||
147 | foreign import ccall unsafe "prodC" c_prodC :: TVV (Complex Double) | ||
148 | foreign import ccall unsafe "prodI" c_prodI :: TVV (CInt) | ||
149 | |||
150 | ------------------------------------------------------------------ | ||
151 | |||
152 | toScalarAux fun code v = unsafePerformIO $ do | ||
153 | r <- createVector 1 | ||
154 | app2 (fun (fromei code)) vec v vec r "toScalarAux" | ||
155 | return (r @> 0) | ||
156 | |||
157 | vectorMapAux fun code v = unsafePerformIO $ do | ||
158 | r <- createVector (dim v) | ||
159 | app2 (fun (fromei code)) vec v vec r "vectorMapAux" | ||
160 | return r | ||
161 | |||
162 | vectorMapValAux fun code val v = unsafePerformIO $ do | ||
163 | r <- createVector (dim v) | ||
164 | pval <- newArray [val] | ||
165 | app2 (fun (fromei code) pval) vec v vec r "vectorMapValAux" | ||
166 | free pval | ||
167 | return r | ||
168 | |||
169 | vectorZipAux fun code u v = unsafePerformIO $ do | ||
170 | r <- createVector (dim u) | ||
171 | app3 (fun (fromei code)) vec u vec v vec r "vectorZipAux" | ||
172 | return r | ||
173 | |||
174 | --------------------------------------------------------------------- | ||
175 | |||
176 | -- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc. | ||
177 | toScalarR :: FunCodeS -> Vector Double -> Double | ||
178 | toScalarR oper = toScalarAux c_toScalarR (fromei oper) | ||
179 | |||
180 | foreign import ccall unsafe "toScalarR" c_toScalarR :: CInt -> TVV Double | ||
181 | |||
182 | -- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc. | ||
183 | toScalarF :: FunCodeS -> Vector Float -> Float | ||
184 | toScalarF oper = toScalarAux c_toScalarF (fromei oper) | ||
185 | |||
186 | foreign import ccall unsafe "toScalarF" c_toScalarF :: CInt -> TVV Float | ||
187 | |||
188 | -- | obtains different functions of a vector: only norm1, norm2 | ||
189 | toScalarC :: FunCodeS -> Vector (Complex Double) -> Double | ||
190 | toScalarC oper = toScalarAux c_toScalarC (fromei oper) | ||
191 | |||
192 | foreign import ccall unsafe "toScalarC" c_toScalarC :: CInt -> Complex Double :> Double :> Ok | ||
193 | |||
194 | -- | obtains different functions of a vector: only norm1, norm2 | ||
195 | toScalarQ :: FunCodeS -> Vector (Complex Float) -> Float | ||
196 | toScalarQ oper = toScalarAux c_toScalarQ (fromei oper) | ||
197 | |||
198 | foreign import ccall unsafe "toScalarQ" c_toScalarQ :: CInt -> Complex Float :> Float :> Ok | ||
199 | |||
200 | -- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc. | ||
201 | toScalarI :: FunCodeS -> Vector CInt -> CInt | ||
202 | toScalarI oper = toScalarAux c_toScalarI (fromei oper) | ||
203 | |||
204 | foreign import ccall unsafe "toScalarI" c_toScalarI :: CInt -> TVV CInt | ||
205 | |||
206 | ------------------------------------------------------------------ | ||
207 | |||
208 | -- | map of real vectors with given function | ||
209 | vectorMapR :: FunCodeV -> Vector Double -> Vector Double | ||
210 | vectorMapR = vectorMapAux c_vectorMapR | ||
211 | |||
212 | foreign import ccall unsafe "mapR" c_vectorMapR :: CInt -> TVV Double | ||
213 | |||
214 | -- | map of complex vectors with given function | ||
215 | vectorMapC :: FunCodeV -> Vector (Complex Double) -> Vector (Complex Double) | ||
216 | vectorMapC oper = vectorMapAux c_vectorMapC (fromei oper) | ||
217 | |||
218 | foreign import ccall unsafe "mapC" c_vectorMapC :: CInt -> TVV (Complex Double) | ||
219 | |||
220 | -- | map of real vectors with given function | ||
221 | vectorMapF :: FunCodeV -> Vector Float -> Vector Float | ||
222 | vectorMapF = vectorMapAux c_vectorMapF | ||
223 | |||
224 | foreign import ccall unsafe "mapF" c_vectorMapF :: CInt -> TVV Float | ||
225 | |||
226 | -- | map of real vectors with given function | ||
227 | vectorMapQ :: FunCodeV -> Vector (Complex Float) -> Vector (Complex Float) | ||
228 | vectorMapQ = vectorMapAux c_vectorMapQ | ||
229 | |||
230 | foreign import ccall unsafe "mapQ" c_vectorMapQ :: CInt -> TVV (Complex Float) | ||
231 | |||
232 | -- | map of real vectors with given function | ||
233 | vectorMapI :: FunCodeV -> Vector CInt -> Vector CInt | ||
234 | vectorMapI = vectorMapAux c_vectorMapI | ||
235 | |||
236 | foreign import ccall unsafe "mapI" c_vectorMapI :: CInt -> TVV CInt | ||
237 | |||
238 | ------------------------------------------------------------------- | ||
239 | |||
240 | -- | map of real vectors with given function | ||
241 | vectorMapValR :: FunCodeSV -> Double -> Vector Double -> Vector Double | ||
242 | vectorMapValR oper = vectorMapValAux c_vectorMapValR (fromei oper) | ||
243 | |||
244 | foreign import ccall unsafe "mapValR" c_vectorMapValR :: CInt -> Ptr Double -> TVV Double | ||
245 | |||
246 | -- | map of complex vectors with given function | ||
247 | vectorMapValC :: FunCodeSV -> Complex Double -> Vector (Complex Double) -> Vector (Complex Double) | ||
248 | vectorMapValC = vectorMapValAux c_vectorMapValC | ||
249 | |||
250 | foreign import ccall unsafe "mapValC" c_vectorMapValC :: CInt -> Ptr (Complex Double) -> TVV (Complex Double) | ||
251 | |||
252 | -- | map of real vectors with given function | ||
253 | vectorMapValF :: FunCodeSV -> Float -> Vector Float -> Vector Float | ||
254 | vectorMapValF oper = vectorMapValAux c_vectorMapValF (fromei oper) | ||
255 | |||
256 | foreign import ccall unsafe "mapValF" c_vectorMapValF :: CInt -> Ptr Float -> TVV Float | ||
257 | |||
258 | -- | map of complex vectors with given function | ||
259 | vectorMapValQ :: FunCodeSV -> Complex Float -> Vector (Complex Float) -> Vector (Complex Float) | ||
260 | vectorMapValQ oper = vectorMapValAux c_vectorMapValQ (fromei oper) | ||
261 | |||
262 | foreign import ccall unsafe "mapValQ" c_vectorMapValQ :: CInt -> Ptr (Complex Float) -> TVV (Complex Float) | ||
263 | |||
264 | -- | map of real vectors with given function | ||
265 | vectorMapValI :: FunCodeSV -> CInt -> Vector CInt -> Vector CInt | ||
266 | vectorMapValI oper = vectorMapValAux c_vectorMapValI (fromei oper) | ||
267 | |||
268 | foreign import ccall unsafe "mapValI" c_vectorMapValI :: CInt -> Ptr CInt -> TVV CInt | ||
269 | |||
270 | |||
271 | ------------------------------------------------------------------- | ||
272 | |||
273 | type TVVV t = t :> t :> t :> Ok | ||
274 | |||
275 | -- | elementwise operation on real vectors | ||
276 | vectorZipR :: FunCodeVV -> Vector Double -> Vector Double -> Vector Double | ||
277 | vectorZipR = vectorZipAux c_vectorZipR | ||
278 | |||
279 | foreign import ccall unsafe "zipR" c_vectorZipR :: CInt -> TVVV Double | ||
280 | |||
281 | -- | elementwise operation on complex vectors | ||
282 | vectorZipC :: FunCodeVV -> Vector (Complex Double) -> Vector (Complex Double) -> Vector (Complex Double) | ||
283 | vectorZipC = vectorZipAux c_vectorZipC | ||
284 | |||
285 | foreign import ccall unsafe "zipC" c_vectorZipC :: CInt -> TVVV (Complex Double) | ||
286 | |||
287 | -- | elementwise operation on real vectors | ||
288 | vectorZipF :: FunCodeVV -> Vector Float -> Vector Float -> Vector Float | ||
289 | vectorZipF = vectorZipAux c_vectorZipF | ||
290 | |||
291 | foreign import ccall unsafe "zipF" c_vectorZipF :: CInt -> TVVV Float | ||
292 | |||
293 | -- | elementwise operation on complex vectors | ||
294 | vectorZipQ :: FunCodeVV -> Vector (Complex Float) -> Vector (Complex Float) -> Vector (Complex Float) | ||
295 | vectorZipQ = vectorZipAux c_vectorZipQ | ||
296 | |||
297 | foreign import ccall unsafe "zipQ" c_vectorZipQ :: CInt -> TVVV (Complex Float) | ||
298 | |||
299 | -- | elementwise operation on CInt vectors | ||
300 | vectorZipI :: FunCodeVV -> Vector CInt -> Vector CInt -> Vector CInt | ||
301 | vectorZipI = vectorZipAux c_vectorZipI | ||
302 | |||
303 | foreign import ccall unsafe "zipI" c_vectorZipI :: CInt -> TVVV CInt | ||
304 | |||
305 | |||
306 | -------------------------------------------------------------------------------- | ||
307 | |||
308 | foreign import ccall unsafe "vectorScan" c_vectorScan | ||
309 | :: CString -> Ptr CInt -> Ptr (Ptr Double) -> IO CInt | ||
310 | |||
311 | vectorScan :: FilePath -> IO (Vector Double) | ||
312 | vectorScan s = do | ||
313 | pp <- malloc | ||
314 | pn <- malloc | ||
315 | cs <- newCString s | ||
316 | ok <- c_vectorScan cs pn pp | ||
317 | when (not (ok == 0)) $ | ||
318 | error ("vectorScan: file \"" ++ s ++"\" not found") | ||
319 | n <- fromIntegral <$> peek pn | ||
320 | p <- peek pp | ||
321 | v <- createVector n | ||
322 | free pn | ||
323 | free cs | ||
324 | unsafeWith v $ \pv -> copyArray pv p n | ||
325 | free p | ||
326 | free pp | ||
327 | return v | ||
328 | |||
329 | -------------------------------------------------------------------------------- | ||
330 | |||
331 | type Seed = Int | ||
332 | |||
333 | data RandDist = Uniform -- ^ uniform distribution in [0,1) | ||
334 | | Gaussian -- ^ normal distribution with mean zero and standard deviation one | ||
335 | deriving Enum | ||
336 | |||
337 | -- | Obtains a vector of pseudorandom elements (use randomIO to get a random seed). | ||
338 | randomVector :: Seed | ||
339 | -> RandDist -- ^ distribution | ||
340 | -> Int -- ^ vector size | ||
341 | -> Vector Double | ||
342 | randomVector seed dist n = unsafePerformIO $ do | ||
343 | r <- createVector n | ||
344 | app1 (c_random_vector (fi seed) ((fi.fromEnum) dist)) vec r "randomVector" | ||
345 | return r | ||
346 | |||
347 | foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> Double :> Ok | ||
348 | |||
349 | -------------------------------------------------------------------------------- | ||
350 | |||
351 | roundVector v = unsafePerformIO $ do | ||
352 | r <- createVector (dim v) | ||
353 | app2 c_round_vector vec v vec r "roundVector" | ||
354 | return r | ||
355 | |||
356 | foreign import ccall unsafe "round_vector" c_round_vector :: TVV Double | ||
357 | |||
358 | -------------------------------------------------------------------------------- | ||
359 | |||
360 | -- | | ||
361 | -- >>> range 5 | ||
362 | -- fromList [0,1,2,3,4] | ||
363 | -- | ||
364 | range :: Int -> Vector I | ||
365 | range n = unsafePerformIO $ do | ||
366 | r <- createVector n | ||
367 | app1 c_range_vector vec r "range" | ||
368 | return r | ||
369 | |||
370 | foreign import ccall unsafe "range_vector" c_range_vector :: CInt :> Ok | ||
371 | |||
372 | |||
373 | float2DoubleV :: Vector Float -> Vector Double | ||
374 | float2DoubleV = tog c_float2double | ||
375 | |||
376 | double2FloatV :: Vector Double -> Vector Float | ||
377 | double2FloatV = tog c_double2float | ||
378 | |||
379 | double2IntV :: Vector Double -> Vector CInt | ||
380 | double2IntV = tog c_double2int | ||
381 | |||
382 | int2DoubleV :: Vector CInt -> Vector Double | ||
383 | int2DoubleV = tog c_int2double | ||
384 | |||
385 | float2IntV :: Vector Float -> Vector CInt | ||
386 | float2IntV = tog c_float2int | ||
387 | |||
388 | int2floatV :: Vector CInt -> Vector Float | ||
389 | int2floatV = tog c_int2float | ||
390 | |||
391 | |||
392 | tog f v = unsafePerformIO $ do | ||
393 | r <- createVector (dim v) | ||
394 | app2 f vec v vec r "tog" | ||
395 | return r | ||
396 | |||
397 | foreign import ccall unsafe "float2double" c_float2double :: Float :> Double :> Ok | ||
398 | foreign import ccall unsafe "double2float" c_double2float :: Double :> Float :> Ok | ||
399 | foreign import ccall unsafe "int2double" c_int2double :: CInt :> Double :> Ok | ||
400 | foreign import ccall unsafe "double2int" c_double2int :: Double :> CInt :> Ok | ||
401 | foreign import ccall unsafe "int2float" c_int2float :: CInt :> Float :> Ok | ||
402 | foreign import ccall unsafe "float2int" c_float2int :: Float :> CInt :> Ok | ||
403 | |||
404 | |||
405 | --------------------------------------------------------------- | ||
406 | |||
407 | stepg f v = unsafePerformIO $ do | ||
408 | r <- createVector (dim v) | ||
409 | app2 f vec v vec r "step" | ||
410 | return r | ||
411 | |||
412 | stepD :: Vector Double -> Vector Double | ||
413 | stepD = stepg c_stepD | ||
414 | |||
415 | stepF :: Vector Float -> Vector Float | ||
416 | stepF = stepg c_stepF | ||
417 | |||
418 | stepI :: Vector CInt -> Vector CInt | ||
419 | stepI = stepg c_stepI | ||
420 | |||
421 | foreign import ccall unsafe "stepF" c_stepF :: TVV Float | ||
422 | foreign import ccall unsafe "stepD" c_stepD :: TVV Double | ||
423 | foreign import ccall unsafe "stepI" c_stepI :: TVV CInt | ||
424 | |||
425 | |||
426 | -------------------------------------------------------------------------------- | ||
427 | |||
428 | conjugateAux fun x = unsafePerformIO $ do | ||
429 | v <- createVector (dim x) | ||
430 | app2 fun vec x vec v "conjugateAux" | ||
431 | return v | ||
432 | |||
433 | conjugateQ :: Vector (Complex Float) -> Vector (Complex Float) | ||
434 | conjugateQ = conjugateAux c_conjugateQ | ||
435 | foreign import ccall unsafe "conjugateQ" c_conjugateQ :: TVV (Complex Float) | ||
436 | |||
437 | conjugateC :: Vector (Complex Double) -> Vector (Complex Double) | ||
438 | conjugateC = conjugateAux c_conjugateC | ||
439 | foreign import ccall unsafe "conjugateC" c_conjugateC :: TVV (Complex Double) | ||
440 | |||
441 | -------------------------------------------------------------------------------- | ||
442 | |||
443 | cloneVector :: Storable t => Vector t -> IO (Vector t) | ||
444 | cloneVector v = do | ||
445 | let n = dim v | ||
446 | r <- createVector n | ||
447 | let f _ s _ d = copyArray d s n >> return 0 | ||
448 | app2 f vec v vec r "cloneVector" | ||
449 | return r | ||
450 | |||
451 | -------------------------------------------------------------------------------- | ||
452 | |||
453 | constantAux fun x n = unsafePerformIO $ do | ||
454 | v <- createVector n | ||
455 | px <- newArray [x] | ||
456 | app1 (fun px) vec v "constantAux" | ||
457 | free px | ||
458 | return v | ||
459 | |||
460 | type TConst t = Ptr t -> t :> Ok | ||
461 | |||
462 | foreign import ccall unsafe "constantF" cconstantF :: TConst Float | ||
463 | foreign import ccall unsafe "constantR" cconstantR :: TConst Double | ||
464 | foreign import ccall unsafe "constantQ" cconstantQ :: TConst (Complex Float) | ||
465 | foreign import ccall unsafe "constantC" cconstantC :: TConst (Complex Double) | ||
466 | foreign import ccall unsafe "constantI" cconstantI :: TConst CInt | ||
467 | |||
468 | ---------------------------------------------------------------------- | ||
469 | |||