summaryrefslogtreecommitdiff
path: root/lib/Numeric/LinearAlgebra/Tests/Instances.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Numeric/LinearAlgebra/Tests/Instances.hs')
-rw-r--r--lib/Numeric/LinearAlgebra/Tests/Instances.hs249
1 files changed, 0 insertions, 249 deletions
diff --git a/lib/Numeric/LinearAlgebra/Tests/Instances.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
deleted file mode 100644
index 6dd9cfe..0000000
--- a/lib/Numeric/LinearAlgebra/Tests/Instances.hs
+++ /dev/null
@@ -1,249 +0,0 @@
1{-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP, FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3-----------------------------------------------------------------------------
4{- |
5Module : Numeric.LinearAlgebra.Tests.Instances
6Copyright : (c) Alberto Ruiz 2008
7License : GPL-style
8
9Maintainer : Alberto Ruiz (aruiz at um dot es)
10Stability : provisional
11Portability : portable
12
13Arbitrary instances for vectors, matrices.
14
15-}
16
17module Numeric.LinearAlgebra.Tests.Instances(
18 Sq(..), rSq,cSq,
19 Rot(..), rRot,cRot,
20 Her(..), rHer,cHer,
21 WC(..), rWC,cWC,
22 SqWC(..), rSqWC, cSqWC,
23 PosDef(..), rPosDef, cPosDef,
24 Consistent(..), rConsist, cConsist,
25 RM,CM, rM,cM,
26 FM,ZM, fM,zM
27) where
28
29import System.Random
30
31import Numeric.LinearAlgebra
32import Control.Monad(replicateM)
33#include "quickCheckCompat.h"
34
35#if MIN_VERSION_QuickCheck(2,0,0)
36shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]]
37shrinkListElementwise [] = []
38shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ]
39 ++ [ x:ys | ys <- shrinkListElementwise xs ]
40
41shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)]
42shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ]
43#endif
44
45#if MIN_VERSION_QuickCheck(2,1,1)
46#else
47instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where
48 arbitrary = do
49 re <- arbitrary
50 im <- arbitrary
51 return (re :+ im)
52
53#if MIN_VERSION_QuickCheck(2,0,0)
54 shrink (re :+ im) =
55 [ u :+ v | (u,v) <- shrinkPair (re,im) ]
56#else
57 -- this has been moved to the 'Coarbitrary' class in QuickCheck 2
58 coarbitrary = undefined
59#endif
60
61#endif
62
63chooseDim = sized $ \m -> choose (1,max 1 m)
64
65instance (Field a, Arbitrary a) => Arbitrary (Vector a) where
66 arbitrary = do m <- chooseDim
67 l <- vector m
68 return $ fromList l
69
70#if MIN_VERSION_QuickCheck(2,0,0)
71 -- shrink any one of the components
72 shrink = map fromList . shrinkListElementwise . toList
73
74#else
75 coarbitrary = undefined
76#endif
77
78instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
79 arbitrary = do
80 m <- chooseDim
81 n <- chooseDim
82 l <- vector (m*n)
83 return $ (m><n) l
84
85#if MIN_VERSION_QuickCheck(2,0,0)
86 -- shrink any one of the components
87 shrink a = map (rows a >< cols a)
88 . shrinkListElementwise
89 . concat . toLists
90 $ a
91#else
92 coarbitrary = undefined
93#endif
94
95
96-- a square matrix
97newtype (Sq a) = Sq (Matrix a) deriving Show
98instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
99 arbitrary = do
100 n <- chooseDim
101 l <- vector (n*n)
102 return $ Sq $ (n><n) l
103
104#if MIN_VERSION_QuickCheck(2,0,0)
105 shrink (Sq a) = [ Sq b | b <- shrink a ]
106#else
107 coarbitrary = undefined
108#endif
109
110
111-- a unitary matrix
112newtype (Rot a) = Rot (Matrix a) deriving Show
113instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
114 arbitrary = do
115 Sq m <- arbitrary
116 let (q,_) = qr m
117 return (Rot q)
118
119#if MIN_VERSION_QuickCheck(2,0,0)
120#else
121 coarbitrary = undefined
122#endif
123
124
125-- a complex hermitian or real symmetric matrix
126newtype (Her a) = Her (Matrix a) deriving Show
127instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where
128 arbitrary = do
129 Sq m <- arbitrary
130 let m' = m/2
131 return $ Her (m' + ctrans m')
132
133#if MIN_VERSION_QuickCheck(2,0,0)
134#else
135 coarbitrary = undefined
136#endif
137
138class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a
139instance ArbitraryField Double
140instance ArbitraryField (Complex Double)
141
142
143-- a well-conditioned general matrix (the singular values are between 1 and 100)
144newtype (WC a) = WC (Matrix a) deriving Show
145instance (ArbitraryField a) => Arbitrary (WC a) where
146 arbitrary = do
147 m <- arbitrary
148 let (u,_,v) = svd m
149 r = rows m
150 c = cols m
151 n = min r c
152 sv' <- replicateM n (choose (1,100))
153 let s = diagRect 0 (fromList sv') r c
154 return $ WC (u <> real s <> trans v)
155
156#if MIN_VERSION_QuickCheck(2,0,0)
157#else
158 coarbitrary = undefined
159#endif
160
161
162-- a well-conditioned square matrix (the singular values are between 1 and 100)
163newtype (SqWC a) = SqWC (Matrix a) deriving Show
164instance (ArbitraryField a) => Arbitrary (SqWC a) where
165 arbitrary = do
166 Sq m <- arbitrary
167 let (u,_,v) = svd m
168 n = rows m
169 sv' <- replicateM n (choose (1,100))
170 let s = diag (fromList sv')
171 return $ SqWC (u <> real s <> trans v)
172
173#if MIN_VERSION_QuickCheck(2,0,0)
174#else
175 coarbitrary = undefined
176#endif
177
178
179-- a positive definite square matrix (the eigenvalues are between 0 and 100)
180newtype (PosDef a) = PosDef (Matrix a) deriving Show
181instance (ArbitraryField a, Num (Vector a))
182 => Arbitrary (PosDef a) where
183 arbitrary = do
184 Her m <- arbitrary
185 let (_,v) = eigSH m
186 n = rows m
187 l <- replicateM n (choose (0,100))
188 let s = diag (fromList l)
189 p = v <> real s <> ctrans v
190 return $ PosDef (0.5 * p + 0.5 * ctrans p)
191
192#if MIN_VERSION_QuickCheck(2,0,0)
193#else
194 coarbitrary = undefined
195#endif
196
197
198-- a pair of matrices that can be multiplied
199newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show
200instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where
201 arbitrary = do
202 n <- chooseDim
203 k <- chooseDim
204 m <- chooseDim
205 la <- vector (n*k)
206 lb <- vector (k*m)
207 return $ Consistent ((n><k) la, (k><m) lb)
208
209#if MIN_VERSION_QuickCheck(2,0,0)
210 shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ]
211#else
212 coarbitrary = undefined
213#endif
214
215
216
217type RM = Matrix Double
218type CM = Matrix (Complex Double)
219type FM = Matrix Float
220type ZM = Matrix (Complex Float)
221
222
223rM m = m :: RM
224cM m = m :: CM
225fM m = m :: FM
226zM m = m :: ZM
227
228
229rHer (Her m) = m :: RM
230cHer (Her m) = m :: CM
231
232rRot (Rot m) = m :: RM
233cRot (Rot m) = m :: CM
234
235rSq (Sq m) = m :: RM
236cSq (Sq m) = m :: CM
237
238rWC (WC m) = m :: RM
239cWC (WC m) = m :: CM
240
241rSqWC (SqWC m) = m :: RM
242cSqWC (SqWC m) = m :: CM
243
244rPosDef (PosDef m) = m :: RM
245cPosDef (PosDef m) = m :: CM
246
247rConsist (Consistent (a,b)) = (a,b::RM)
248cConsist (Consistent (a,b)) = (a,b::CM)
249