diff options
author | Alberto Ruiz <aruiz@um.es> | 2014-05-16 13:35:35 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2014-05-16 13:35:35 +0200 |
commit | 1838c4248679b7476bb8716a76171712dc3cd335 (patch) | |
tree | e3909ac3354eaf917bb1ebc5a7366412b6ab8f0f /packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs | |
parent | a2d99e7d0e83fcedf3a856cdb927309e28a8eddd (diff) |
linear algebra moved
Diffstat (limited to 'packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs')
-rw-r--r-- | packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs | 115 |
1 files changed, 115 insertions, 0 deletions
diff --git a/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs b/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs new file mode 100644 index 0000000..d04c46b --- /dev/null +++ b/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs | |||
@@ -0,0 +1,115 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | ----------------------------------------------------------------------------- | ||
3 | {- | | ||
4 | Module : Numeric.LinearAlgebra.Util.Convolution | ||
5 | Copyright : (c) Alberto Ruiz 2012 | ||
6 | License : GPL | ||
7 | |||
8 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
9 | Stability : provisional | ||
10 | |||
11 | -} | ||
12 | ----------------------------------------------------------------------------- | ||
13 | {-# OPTIONS_HADDOCK hide #-} | ||
14 | |||
15 | module Numeric.LinearAlgebra.Util.Convolution( | ||
16 | corr, conv, corrMin, | ||
17 | corr2, conv2, separable | ||
18 | ) where | ||
19 | |||
20 | import Numeric.LinearAlgebra | ||
21 | |||
22 | |||
23 | vectSS :: Element t => Int -> Vector t -> Matrix t | ||
24 | vectSS n v = fromRows [ subVector k n v | k <- [0 .. dim v - n] ] | ||
25 | |||
26 | |||
27 | corr :: Product t => Vector t -- ^ kernel | ||
28 | -> Vector t -- ^ source | ||
29 | -> Vector t | ||
30 | {- ^ correlation | ||
31 | |||
32 | >>> corr (fromList[1,2,3]) (fromList [1..10]) | ||
33 | fromList [14.0,20.0,26.0,32.0,38.0,44.0,50.0,56.0] | ||
34 | |||
35 | -} | ||
36 | corr ker v | dim ker <= dim v = vectSS (dim ker) v <> ker | ||
37 | | otherwise = error $ "corr: dim kernel ("++show (dim ker)++") > dim vector ("++show (dim v)++")" | ||
38 | |||
39 | |||
40 | conv :: (Product t, Num t) => Vector t -> Vector t -> Vector t | ||
41 | {- ^ convolution ('corr' with reversed kernel and padded input, equivalent to polynomial product) | ||
42 | |||
43 | >>> conv (fromList[1,1]) (fromList [-1,1]) | ||
44 | fromList [-1.0,0.0,1.0] | ||
45 | |||
46 | -} | ||
47 | conv ker v = corr ker' v' | ||
48 | where | ||
49 | ker' = (flatten.fliprl.asRow) ker | ||
50 | v' | dim ker > 1 = vjoin [z,v,z] | ||
51 | | otherwise = v | ||
52 | z = constant 0 (dim ker -1) | ||
53 | |||
54 | corrMin :: (Container Vector t, RealElement t, Product t) | ||
55 | => Vector t | ||
56 | -> Vector t | ||
57 | -> Vector t | ||
58 | -- ^ similar to 'corr', using 'min' instead of (*) | ||
59 | corrMin ker v = minEvery ss (asRow ker) <> ones | ||
60 | where | ||
61 | minEvery a b = cond a b a a b | ||
62 | ss = vectSS (dim ker) v | ||
63 | ones = konst 1 (dim ker) | ||
64 | |||
65 | |||
66 | |||
67 | matSS :: Element t => Int -> Matrix t -> [Matrix t] | ||
68 | matSS dr m = map (reshape c) [ subVector (k*c) n v | k <- [0 .. r - dr] ] | ||
69 | where | ||
70 | v = flatten m | ||
71 | c = cols m | ||
72 | r = rows m | ||
73 | n = dr*c | ||
74 | |||
75 | |||
76 | corr2 :: Product a => Matrix a -> Matrix a -> Matrix a | ||
77 | -- ^ 2D correlation | ||
78 | corr2 ker mat = dims | ||
79 | . concatMap (map (udot ker' . flatten) . matSS c . trans) | ||
80 | . matSS r $ mat | ||
81 | where | ||
82 | r = rows ker | ||
83 | c = cols ker | ||
84 | ker' = flatten (trans ker) | ||
85 | rr = rows mat - r + 1 | ||
86 | rc = cols mat - c + 1 | ||
87 | dims | rr > 0 && rc > 0 = (rr >< rc) | ||
88 | | otherwise = error $ "corr2: dim kernel ("++sz ker++") > dim matrix ("++sz mat++")" | ||
89 | sz m = show (rows m)++"x"++show (cols m) | ||
90 | |||
91 | conv2 :: (Num a, Product a, Container Vector a) => Matrix a -> Matrix a -> Matrix a | ||
92 | -- ^ 2D convolution | ||
93 | conv2 k m = corr2 (fliprl . flipud $ k) pm | ||
94 | where | ||
95 | pm | r == 0 && c == 0 = m | ||
96 | | r == 0 = fromBlocks [[z3,m,z3]] | ||
97 | | c == 0 = fromBlocks [[z2],[m],[z2]] | ||
98 | | otherwise = fromBlocks [[z1,z2,z1] | ||
99 | ,[z3, m,z3] | ||
100 | ,[z1,z2,z1]] | ||
101 | r = rows k - 1 | ||
102 | c = cols k - 1 | ||
103 | h = rows m | ||
104 | w = cols m | ||
105 | z1 = konst 0 (r,c) | ||
106 | z2 = konst 0 (r,w) | ||
107 | z3 = konst 0 (h,c) | ||
108 | |||
109 | -- TODO: could be simplified using future empty arrays | ||
110 | |||
111 | |||
112 | separable :: Element t => (Vector t -> Vector t) -> Matrix t -> Matrix t | ||
113 | -- ^ matrix computation implemented as separated vector operations by rows and columns. | ||
114 | separable f = fromColumns . map f . toColumns . fromRows . map f . toRows | ||
115 | |||