summaryrefslogtreecommitdiff
path: root/lib/Data
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data')
-rw-r--r--lib/Data/Packed/Internal/Common.hs8
-rw-r--r--lib/Data/Packed/Internal/Matrix.hs25
-rw-r--r--lib/Data/Packed/Internal/auxi.c26
-rw-r--r--lib/Data/Packed/Internal/auxi.h3
-rw-r--r--lib/Data/Packed/Matrix.hs11
5 files changed, 10 insertions, 63 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs
index bce9922..1b63dd8 100644
--- a/lib/Data/Packed/Internal/Common.hs
+++ b/lib/Data/Packed/Internal/Common.hs
@@ -101,9 +101,6 @@ check msg f = do
101foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar) 101foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar)
102 102
103--------------------------------------------------- 103---------------------------------------------------
104-- ugly, but my haddock version doesn't understand
105-- yet infix type constructors
106---------------------------------------------------
107---------- signatures of the C functions --------- 104---------- signatures of the C functions ---------
108-------------------------------------------------- 105--------------------------------------------------
109type PD = Ptr Double -- 106type PD = Ptr Double --
@@ -141,8 +138,3 @@ type TCVM = CInt -> PC -> TM --
141type TMCVM = CInt -> CInt -> PD -> TCVM -- 138type TMCVM = CInt -> CInt -> PD -> TCVM --
142type TMMCVM = CInt -> CInt -> PD -> TMCVM -- 139type TMMCVM = CInt -> CInt -> PD -> TMCVM --
143-------------------------------------------------- 140--------------------------------------------------
144
145type TauxMul a = CInt -> CInt -> CInt -> Ptr a
146 -> CInt -> CInt -> CInt -> Ptr a
147 -> CInt -> CInt -> Ptr a
148 -> IO CInt
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs
index 63f0a8d..51fb6f8 100644
--- a/lib/Data/Packed/Internal/Matrix.hs
+++ b/lib/Data/Packed/Internal/Matrix.hs
@@ -213,19 +213,16 @@ class (Storable a, Floating a) => Element a where
213 subMatrixD :: (Int,Int) -- ^ (r0,c0) starting position 213 subMatrixD :: (Int,Int) -- ^ (r0,c0) starting position
214 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix 214 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix
215 -> Matrix a -> Matrix a 215 -> Matrix a -> Matrix a
216 diagD :: Vector a -> Matrix a
217 216
218instance Element Double where 217instance Element Double where
219 constantD = constantR 218 constantD = constantR
220 transdata = transdataR 219 transdata = transdataR
221 subMatrixD = subMatrixR 220 subMatrixD = subMatrixR
222 diagD = diagR
223 221
224instance Element (Complex Double) where 222instance Element (Complex Double) where
225 constantD = constantC 223 constantD = constantC
226 transdata = transdataC 224 transdata = transdataC
227 subMatrixD = subMatrixC 225 subMatrixD = subMatrixC
228 diagD = diagC
229 226
230------------------------------------------------------------------ 227------------------------------------------------------------------
231 228
@@ -287,28 +284,6 @@ subMatrix :: Element a
287 -> Matrix a -- ^ result 284 -> Matrix a -- ^ result
288subMatrix = subMatrixD 285subMatrix = subMatrixD
289 286
290
291---------------------------------------------------------------------
292
293diagAux fun msg (v@V {dim = n}) = unsafePerformIO $ do
294 m <- createMatrix RowMajor n n
295 app2 fun vec v mat m msg
296 return m
297
298-- | diagonal matrix from a real vector
299diagR :: Vector Double -> Matrix Double
300diagR = diagAux c_diagR "diagR"
301foreign import ccall "auxi.h diagR" c_diagR :: TVM
302
303-- | diagonal matrix from a real vector
304diagC :: Vector (Complex Double) -> Matrix (Complex Double)
305diagC = diagAux c_diagC "diagC"
306foreign import ccall "auxi.h diagC" c_diagC :: TCVCM
307
308-- | creates a square matrix with the given diagonal
309diag :: Element a => Vector a -> Matrix a
310diag = diagD
311
312------------------------------------------------------------------------ 287------------------------------------------------------------------------
313 288
314constantAux fun x n = unsafePerformIO $ do 289constantAux fun x n = unsafePerformIO $ do
diff --git a/lib/Data/Packed/Internal/auxi.c b/lib/Data/Packed/Internal/auxi.c
index bbb8cd4..c449b9a 100644
--- a/lib/Data/Packed/Internal/auxi.c
+++ b/lib/Data/Packed/Internal/auxi.c
@@ -113,32 +113,6 @@ int constantC(gsl_complex* pval, CVEC(r)) {
113} 113}
114 114
115 115
116int diagR(KRVEC(d),RMAT(r)) {
117 REQUIRES(dn==rr && rr==rc,BAD_SIZE);
118 DEBUGMSG("diagR");
119 int i,j;
120 for (i=0;i<rr;i++) {
121 for(j=0;j<rc;j++) {
122 rp[i*rc+j] = i==j?dp[i]:0.;
123 }
124 }
125 OK
126}
127
128int diagC(KCVEC(d),CMAT(r)) {
129 REQUIRES(dn==rr && rr==rc,BAD_SIZE);
130 DEBUGMSG("diagC");
131 int i,j;
132 gsl_complex zero;
133 GSL_SET_COMPLEX(&zero,0.,0.);
134 for (i=0;i<rr;i++) {
135 for(j=0;j<rc;j++) {
136 rp[i*rc+j] = i==j?dp[i]:zero;
137 }
138 }
139 OK
140}
141
142int conjugate(KCVEC(x),CVEC(t)) { 116int conjugate(KCVEC(x),CVEC(t)) {
143 REQUIRES(xn==tn,BAD_SIZE); 117 REQUIRES(xn==tn,BAD_SIZE);
144 DEBUGMSG("conjugate"); 118 DEBUGMSG("conjugate");
diff --git a/lib/Data/Packed/Internal/auxi.h b/lib/Data/Packed/Internal/auxi.h
index 507a30d..b57fdaf 100644
--- a/lib/Data/Packed/Internal/auxi.h
+++ b/lib/Data/Packed/Internal/auxi.h
@@ -18,9 +18,6 @@ int constantC(gsl_complex *val, CVEC(r));
18 18
19int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)); 19int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r));
20 20
21int diagR(KRVEC(d),RMAT(r));
22int diagC(KCVEC(d),CMAT(r));
23
24const char * gsl_strerror (const int gsl_errno); 21const char * gsl_strerror (const int gsl_errno);
25 22
26int matrix_fscanf(char*filename, RMAT(a)); 23int matrix_fscanf(char*filename, RMAT(a));
diff --git a/lib/Data/Packed/Matrix.hs b/lib/Data/Packed/Matrix.hs
index 7d2c564..c56bf3d 100644
--- a/lib/Data/Packed/Matrix.hs
+++ b/lib/Data/Packed/Matrix.hs
@@ -33,6 +33,7 @@ module Data.Packed.Matrix (
33) where 33) where
34 34
35import Data.Packed.Internal 35import Data.Packed.Internal
36import qualified Data.Packed.ST as ST
36import Data.Packed.Vector 37import Data.Packed.Vector
37import Data.List(transpose,intersperse) 38import Data.List(transpose,intersperse)
38import Data.Array 39import Data.Array
@@ -73,6 +74,14 @@ fliprl m = fromColumns . reverse . toColumns $ m
73 74
74------------------------------------------------------------ 75------------------------------------------------------------
75 76
77-- | Creates a square matrix with a given diagonal.
78diag :: Element a => Vector a -> Matrix a
79diag v = ST.runSTMatrix $ do
80 let d = dim v
81 m <- ST.newMatrix 0 d d
82 mapM_ (\k -> ST.writeMatrix m k k (v@>k)) [0..d-1]
83 return m
84
76{- | creates a rectangular diagonal matrix 85{- | creates a rectangular diagonal matrix
77 86
78@> diagRect (constant 5 3) 3 4 87@> diagRect (constant 5 3) 3 4
@@ -87,7 +96,7 @@ diagRect s r c
87 | r == c = diag s 96 | r == c = diag s
88 | r < c = trans $ diagRect s c r 97 | r < c = trans $ diagRect s c r
89 | otherwise = joinVert [diag s , zeros (r-c,c)] 98 | otherwise = joinVert [diag s , zeros (r-c,c)]
90 where zeros (r',c') = reshape c' $ constantD 0 (r'*c') 99 where zeros (r',c') = reshape c' $ constant 0 (r'*c')
91 100
92-- | extracts the diagonal from a rectangular matrix 101-- | extracts the diagonal from a rectangular matrix
93takeDiag :: (Element t) => Matrix t -> Vector t 102takeDiag :: (Element t) => Matrix t -> Vector t