summaryrefslogtreecommitdiff
path: root/packages/base/src/Numeric
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src/Numeric')
-rw-r--r--packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs150
1 files changed, 0 insertions, 150 deletions
diff --git a/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs b/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs
deleted file mode 100644
index c9e75de..0000000
--- a/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs
+++ /dev/null
@@ -1,150 +0,0 @@
1{-# LANGUAGE FlexibleContexts #-}
2-----------------------------------------------------------------------------
3{- |
4Module : Numeric.LinearAlgebra.Util.Convolution
5Copyright : (c) Alberto Ruiz 2012
6License : BSD3
7Maintainer : Alberto Ruiz
8Stability : provisional
9
10-}
11-----------------------------------------------------------------------------
12{-# OPTIONS_HADDOCK hide #-}
13
14module Numeric.LinearAlgebra.Util.Convolution(
15 corr, conv, corrMin,
16 corr2, conv2, separable
17) where
18
19import qualified Data.Vector.Storable as SV
20import Data.Packed.Numeric
21
22
23vectSS :: Element t => Int -> Vector t -> Matrix t
24vectSS n v = fromRows [ subVector k n v | k <- [0 .. dim v - n] ]
25
26
27corr
28 :: (Container Vector t, Product t)
29 => Vector t -- ^ kernel
30 -> Vector t -- ^ source
31 -> Vector t
32{- ^ correlation
33
34>>> corr (fromList[1,2,3]) (fromList [1..10])
35fromList [14.0,20.0,26.0,32.0,38.0,44.0,50.0,56.0]
36
37-}
38corr ker v
39 | dim ker == 0 = konst 0 (dim v)
40 | dim ker <= dim v = vectSS (dim ker) v <> ker
41 | otherwise = error $ "corr: dim kernel ("++show (dim ker)++") > dim vector ("++show (dim v)++")"
42
43
44conv :: (Container Vector t, Product t, Num t) => Vector t -> Vector t -> Vector t
45{- ^ convolution ('corr' with reversed kernel and padded input, equivalent to polynomial product)
46
47>>> conv (fromList[1,1]) (fromList [-1,1])
48fromList [-1.0,0.0,1.0]
49
50-}
51conv ker v
52 | dim ker == 0 = konst 0 (dim v)
53 | otherwise = corr ker' v'
54 where
55 ker' = SV.reverse ker
56 v' = vjoin [z,v,z]
57 z = konst 0 (dim ker -1)
58
59corrMin :: (Container Vector t, RealElement t, Product t)
60 => Vector t
61 -> Vector t
62 -> Vector t
63-- ^ similar to 'corr', using 'min' instead of (*)
64corrMin ker v
65 | dim ker == 0 = error "corrMin: empty kernel"
66 | otherwise = minEvery ss (asRow ker) <> ones
67 where
68 minEvery a b = cond a b a a b
69 ss = vectSS (dim ker) v
70 ones = konst 1 (dim ker)
71
72
73
74matSS :: Element t => Int -> Matrix t -> [Matrix t]
75matSS dr m = map (reshape c) [ subVector (k*c) n v | k <- [0 .. r - dr] ]
76 where
77 v = flatten m
78 c = cols m
79 r = rows m
80 n = dr*c
81
82
83{- | 2D correlation (without padding)
84
85>>> disp 5 $ corr2 (konst 1 (3,3)) (ident 10 :: Matrix Double)
868x8
873 2 1 0 0 0 0 0
882 3 2 1 0 0 0 0
891 2 3 2 1 0 0 0
900 1 2 3 2 1 0 0
910 0 1 2 3 2 1 0
920 0 0 1 2 3 2 1
930 0 0 0 1 2 3 2
940 0 0 0 0 1 2 3
95
96-}
97corr2 :: Product a => Matrix a -> Matrix a -> Matrix a
98corr2 ker mat = dims
99 . concatMap (map (udot ker' . flatten) . matSS c . trans)
100 . matSS r $ mat
101 where
102 r = rows ker
103 c = cols ker
104 ker' = flatten (trans ker)
105 rr = rows mat - r + 1
106 rc = cols mat - c + 1
107 dims | rr > 0 && rc > 0 = (rr >< rc)
108 | otherwise = error $ "corr2: dim kernel ("++sz ker++") > dim matrix ("++sz mat++")"
109 sz m = show (rows m)++"x"++show (cols m)
110-- TODO check empty kernel
111
112{- | 2D convolution
113
114>>> disp 5 $ conv2 (konst 1 (3,3)) (ident 10 :: Matrix Double)
11512x12
1161 1 1 0 0 0 0 0 0 0 0 0
1171 2 2 1 0 0 0 0 0 0 0 0
1181 2 3 2 1 0 0 0 0 0 0 0
1190 1 2 3 2 1 0 0 0 0 0 0
1200 0 1 2 3 2 1 0 0 0 0 0
1210 0 0 1 2 3 2 1 0 0 0 0
1220 0 0 0 1 2 3 2 1 0 0 0
1230 0 0 0 0 1 2 3 2 1 0 0
1240 0 0 0 0 0 1 2 3 2 1 0
1250 0 0 0 0 0 0 1 2 3 2 1
1260 0 0 0 0 0 0 0 1 2 2 1
1270 0 0 0 0 0 0 0 0 1 1 1
128
129-}
130conv2
131 :: (Num (Matrix a), Product a, Container Vector a)
132 => Matrix a -- ^ kernel
133 -> Matrix a -> Matrix a
134conv2 k m
135 | empty = konst 0 (rows m + r -1, cols m + c -1)
136 | otherwise = corr2 (fliprl . flipud $ k) padded
137 where
138 padded = fromBlocks [[z,0,0]
139 ,[0,m,0]
140 ,[0,0,z]]
141 r = rows k
142 c = cols k
143 z = konst 0 (r-1,c-1)
144 empty = r == 0 || c == 0
145
146
147separable :: Element t => (Vector t -> Vector t) -> Matrix t -> Matrix t
148-- ^ matrix computation implemented as separated vector operations by rows and columns.
149separable f = fromColumns . map f . toColumns . fromRows . map f . toRows
150