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