diff options
author | Alberto Ruiz <aruiz@um.es> | 2014-05-08 12:18:56 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2014-05-08 12:18:56 +0200 |
commit | 561a6c0e21bb77c21114ccbbd86d3af5ddb5a3f1 (patch) | |
tree | d49b67d75d63938229f2d5cbed5c49d06dc02bcf /packages/base/src/Numeric/Conversion.hs | |
parent | 5992d92357cfd911c8f2e9f5faaa4fd8a323fd9a (diff) |
Conversion, LAPACK -> base
Diffstat (limited to 'packages/base/src/Numeric/Conversion.hs')
-rw-r--r-- | packages/base/src/Numeric/Conversion.hs | 91 |
1 files changed, 91 insertions, 0 deletions
diff --git a/packages/base/src/Numeric/Conversion.hs b/packages/base/src/Numeric/Conversion.hs new file mode 100644 index 0000000..a1f9385 --- /dev/null +++ b/packages/base/src/Numeric/Conversion.hs | |||
@@ -0,0 +1,91 @@ | |||
1 | {-# LANGUAGE TypeFamilies #-} | ||
2 | {-# LANGUAGE FlexibleContexts #-} | ||
3 | {-# LANGUAGE FlexibleInstances #-} | ||
4 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
5 | {-# LANGUAGE FunctionalDependencies #-} | ||
6 | {-# LANGUAGE UndecidableInstances #-} | ||
7 | |||
8 | ----------------------------------------------------------------------------- | ||
9 | -- | | ||
10 | -- Module : Numeric.Conversion | ||
11 | -- Copyright : (c) Alberto Ruiz 2010 | ||
12 | -- License : BSD3 | ||
13 | -- Maintainer : Alberto Ruiz | ||
14 | -- Stability : provisional | ||
15 | -- | ||
16 | -- Conversion routines | ||
17 | -- | ||
18 | ----------------------------------------------------------------------------- | ||
19 | {-# OPTIONS_HADDOCK hide #-} | ||
20 | |||
21 | |||
22 | module Numeric.Conversion ( | ||
23 | Complexable(..), RealElement, | ||
24 | module Data.Complex | ||
25 | ) where | ||
26 | |||
27 | import Data.Packed.Internal.Vector | ||
28 | import Data.Packed.Internal.Matrix | ||
29 | import Data.Complex | ||
30 | import Control.Arrow((***)) | ||
31 | |||
32 | ------------------------------------------------------------------- | ||
33 | |||
34 | -- | Supported single-double precision type pairs | ||
35 | class (Element s, Element d) => Precision s d | s -> d, d -> s where | ||
36 | double2FloatG :: Vector d -> Vector s | ||
37 | float2DoubleG :: Vector s -> Vector d | ||
38 | |||
39 | instance Precision Float Double where | ||
40 | double2FloatG = double2FloatV | ||
41 | float2DoubleG = float2DoubleV | ||
42 | |||
43 | instance Precision (Complex Float) (Complex Double) where | ||
44 | double2FloatG = asComplex . double2FloatV . asReal | ||
45 | float2DoubleG = asComplex . float2DoubleV . asReal | ||
46 | |||
47 | -- | Supported real types | ||
48 | class (Element t, Element (Complex t), RealFloat t | ||
49 | -- , RealOf t ~ t, RealOf (Complex t) ~ t | ||
50 | ) | ||
51 | => RealElement t | ||
52 | |||
53 | instance RealElement Double | ||
54 | instance RealElement Float | ||
55 | |||
56 | |||
57 | -- | Structures that may contain complex numbers | ||
58 | class Complexable c where | ||
59 | toComplex' :: (RealElement e) => (c e, c e) -> c (Complex e) | ||
60 | fromComplex' :: (RealElement e) => c (Complex e) -> (c e, c e) | ||
61 | comp' :: (RealElement e) => c e -> c (Complex e) | ||
62 | single' :: Precision a b => c b -> c a | ||
63 | double' :: Precision a b => c a -> c b | ||
64 | |||
65 | |||
66 | instance Complexable Vector where | ||
67 | toComplex' = toComplexV | ||
68 | fromComplex' = fromComplexV | ||
69 | comp' v = toComplex' (v,constantD 0 (dim v)) | ||
70 | single' = double2FloatG | ||
71 | double' = float2DoubleG | ||
72 | |||
73 | |||
74 | -- | creates a complex vector from vectors with real and imaginary parts | ||
75 | toComplexV :: (RealElement a) => (Vector a, Vector a) -> Vector (Complex a) | ||
76 | toComplexV (r,i) = asComplex $ flatten $ fromColumns [r,i] | ||
77 | |||
78 | -- | the inverse of 'toComplex' | ||
79 | fromComplexV :: (RealElement a) => Vector (Complex a) -> (Vector a, Vector a) | ||
80 | fromComplexV z = (r,i) where | ||
81 | [r,i] = toColumns $ reshape 2 $ asReal z | ||
82 | |||
83 | |||
84 | instance Complexable Matrix where | ||
85 | toComplex' = uncurry $ liftMatrix2 $ curry toComplex' | ||
86 | fromComplex' z = (reshape c *** reshape c) . fromComplex' . flatten $ z | ||
87 | where c = cols z | ||
88 | comp' = liftMatrix comp' | ||
89 | single' = liftMatrix single' | ||
90 | double' = liftMatrix double' | ||
91 | |||