1 -- Glasgow Haskell 0.403 : BLAS ( Basic Linear Algebra System ) 2 -- ********************************************************************** 3 -- * * 4 -- * FILE NAME : matrix.hs DATE : 5-3-1991 * 5 -- * * 6 -- * CONTENTS : Matrix datatype and operations implemented by using * 7 -- * vector datatype(grounded as Haskell Array type). * 8 -- * Matrices are index from 1, ie the row numbers are from * 9 -- * 1 to nr and column numbers are from 1 to nc. Where nr * 10 -- * and nc are the number of rows and columns respectively. * 11 -- ********************************************************************** 12 13 module Matrix(Mat, makemat, boundmat, matsub, incrmat, updmat, 14 mmatvec, mmatmat, row, col, intchrow, intchcol, interchmat, 15 displaymat) where 16 17 import Ix 18 import Basics 19 20 import Vector 21 22 data Mat a = MAT (Int,Int) (Vec a) 23 24 makemat :: (Int, Int) -> ( (Int,Int) -> a) -> Mat a 25 26 boundmat :: Mat a -> (Int,Int) 27 28 incrmat :: (Num a) => Mat a -> [((Int,Int),a)] -> Mat a 29 30 updmat :: Mat a -> [((Int,Int),a)] -> Mat a 31 32 matsub :: Mat a -> (Int,Int) -> a 33 34 mmatvec :: (Num a) => Mat a -> Vec a -> Vec a 35 36 mmatmat :: (Num a) => Mat a -> Mat a -> Mat a 37 38 row :: Mat a -> Int -> Vec a 39 40 col :: Mat a -> Int -> Vec a 41 42 intchrow :: Int -> Int -> Mat a -> Mat a 43 44 intchcol :: Int -> Int -> Mat a -> Mat a 45 46 interchmat :: (Int,Int) -> (Int,Int) -> Mat a -> Mat a 47 48 displaymat :: (Show a) => Mat a -> [Char] 49 50 makemat (nr,nc) g = 51 MAT (nr,nc) 52 (makevec (nr*nc) 53 (\i -> (map g (range ((1,1),(nr,nc)) )) !! (i-1) ) 54 ) 55 56 boundmat (MAT (nr,nc) elements) = (nr,nc) 57 58 updmat m s = 59 MAT (nr,nc) new_elements 60 where 61 MAT (nr,nc) elements = m 62 new_elements = updvec elements new_s 63 new_s = map (\( ((i,j),x) ) -> ( ((i-1)*nc+j,x) ) ) s 64 65 incrmat m s = 66 MAT (nr,nc) new_elements 67 where 68 MAT (nr,nc) elements = m 69 new_elements = incrvec elements new_s 70 new_s = map (\( ((i,j),x) ) -> ( ((i-1)*nc+j,x) ) ) s 71 72 matsub m (i,j) = 73 vecsub elements ((i-1)*nc+j) 74 where 75 MAT (nr,nc) elements = m 76 77 mmatvec m v = 78 makevec nr ( \ i -> sum [ (matsub m (i,j)) * (vecsub v j) 79 | j <- [1..nc] ] ) 80 where 81 (nr,nc) = boundmat m 82 83 mmatmat m1 m2 = 84 if (t1 == t2) then 85 makemat (l,n) 86 ( \ (i,j) -> sum [ (matsub m1 (i,k)) * 87 (matsub m2 (k,j)) | k <-[1..t1] ] ) 88 else error "Dimension error" 89 where 90 (l,t1) = boundmat m1 91 (t2,n) = boundmat m2 92 93 row m i = 94 makevec n ( \ j -> matsub m (i,j) ) 95 where 96 (_,n) = boundmat m 97 98 col m j = 99 makevec n ( \ i -> matsub m (i,j) ) 100 where 101 (n,_) = boundmat m 102 103 intchrow i j m = 104 makemat (boundmat m) 105 (\ (r,c) -> if (r==i) then matsub m (j,c) 106 else if (r==j) then matsub m (i,c) 107 else matsub m (r,c) ) 108 109 intchcol i j m = 110 makemat (boundmat m) 111 (\ (r,c) -> if (c==i) then matsub m (r,j) 112 else if (c==j) then matsub m (r,i) 113 else matsub m (r,c) ) 114 115 interchmat (i1,j1) (i2,j2) m = 116 makemat (boundmat m) 117 (\ (i,j) -> if (i,j)==(i1,j1) then matsub m (i2,j2) 118 else if (i,j)==(i2,j2) then matsub m (i1,j1) 119 else matsub m (i,j) ) 120 121 displaymat m = 122 "<\n" ++ 123 concat [displayvec (row m i) | i<-[1..nr] ] ++ 124 ">\n" 125 where 126 (nr,_) = boundmat m 127