1 -- Glasgow Haskell 0.403 : BLAS ( Basic Linear Algebra System )
    2 -- **********************************************************************
    3 -- *                                                                    *
    4 -- * FILE NAME : vbmatrix.hs       DATE : 5-3-1991                 *
    5 -- *                                                                    *
    6 -- * CONTENTS : Variable bandwidth matrix data type and operations      *
    7 -- *            implemented by using one-dimension array type.          *
    8 -- **********************************************************************
    9 
   10 module VBmatrix(Vbm, defvbmat, makevbmat, incrvbmat, updvbmat, 
   11                 vbmatsub, boundvbmat, addrvbmat, lengrvbmat, fstclvbmat, 
   12                 diagadrvbm, displayvbmati, displayvbmatr) where
   13 
   14 import Basics
   15 import Vector
   16 
   17 data Vbm a = VBMAT Int (Vec Int) (Vec a)
   18 
   19 defvbmat   :: Int -> Vec Int -> Vec a -> Vbm a
   20 
   21 makevbmat  :: Int -> Vec Int -> ( (Int,Int) -> a ) -> Vbm a
   22         -- make a variable bandwidth matrix, by giving the diagonal
   23         -- element address vector and a element value generator.
   24 
   25 updvbmat   :: Vbm a -> [((Int,Int),a)] -> Vbm a
   26         -- update matrix with the given index-value association list
   27 
   28 incrvbmat  :: (Num a) => Vbm a -> [((Int,Int),a)] -> Vbm a
   29         -- increase matrix by the given index-value association list
   30 
   31 vbmatsub   :: Vbm a -> (Int,Int) -> a
   32         -- Access to the given matrix element value
   33 
   34 boundvbmat :: Vbm a -> Int
   35         -- Return the bounds of the variable bandwidth matrix
   36 
   37 addrvbmat  :: Vbm a -> (Int,Int) -> Int
   38         -- Return the address of element [i,j]
   39 
   40 lengrvbmat :: Vbm a -> Int -> Int
   41         -- Return the length (the number of non-zero elements) of row i
   42 
   43 fstclvbmat :: Vbm a -> Int -> Int
   44         -- Return the first non-zero element's  coulmn number on at row i
   45 
   46 diagadrvbm :: Vbm a -> Vec Int
   47         -- Return the diagonal element address vector
   48 
   49 displayvbmati  ::  Vbm Int -> [Char]
   50 
   51 displayvbmatr  ::  Vbm Float -> [Char]
   52 
   53 lengrvbmat (VBMAT n addiag elems) i =
   54         if (i==1) then 1 
   55         else (vecsub addiag i) - (vecsub addiag (i-1))
   56 
   57 fstclvbmat (VBMAT n addiag elems) i =
   58         if (i==1) then 1
   59         else i - ( lengrvbmat (VBMAT n addiag elems) i ) + 1
   60 
   61 addrvbmat vbm  (i,j) =
   62         vecsub addiag i + j -  i
   63         where
   64         (VBMAT n addiag elementlist) = vbm
   65 
   66 boundvbmat (VBMAT bounds addiag elementlist) = bounds
   67 
   68 diagadrvbm (VBMAT bounds addiag elementlist) = addiag
   69 
   70 defvbmat bounds addiag elementlist =
   71         VBMAT bounds addiag elementlist
   72 
   73 makevbmat n addiag generator =
   74         VBMAT n addiag (makevec (vecsub addiag n) f)
   75         where 
   76         f i    = elemts !! (i - 1)
   77         elemts = foldl  irow []  [1..n] 
   78         irow ls i = ls ++ [ generator (i,j) | j<- [(fstcl i)..i] ]
   79         fstcl i   = if (i==1) then 1
   80                     else i - vecsub addiag i + vecsub addiag (i-1) + 1
   81 
   82 incrvbmat vbm updates =
   83         VBMAT n addiag new_elements
   84         where
   85         (VBMAT n addiag elements) = vbm
   86         new_elements = incrvec elements new_s
   87         new_s = map (\((i,j),x) -> (addrvbmat vbm (i,j),x) ) updates
   88 
   89 updvbmat vbm updates =
   90         VBMAT n addiag new_elements
   91         where
   92         VBMAT n addiag elements = vbm
   93         new_elements = updvec elements new_s
   94         new_s = map (\((i,j),x) -> (addrvbmat vbm (i,j),x) ) updates
   95 
   96 vbmatsub vbm (i,j) =
   97         vecsub elements (addrvbmat vbm (i,j))
   98         where
   99         VBMAT n addiag elements = vbm
  100 
  101 displayvbmati vbm =
  102         "<  \n" ++
  103         concat (map displayvec rows) ++
  104         "> \n"
  105         where
  106         rows = [rowi vbm i | i <- [1..n]]
  107         n = boundvbmat vbm
  108 
  109 displayvbmatr vbm =
  110         "<  \n" ++
  111         concat (map displayvec rows) ++
  112         "> \n"
  113         where
  114         rows = [rowr vbm i | i <- [1..n]]
  115         n = boundvbmat vbm
  116 
  117 rowi vbm i =
  118         makevec n f
  119         where
  120         n = boundvbmat vbm
  121         f j = if ( (j >= (fstclvbmat vbm i)) && (j <= i) ) then
  122                 vbmatsub vbm (i,j)
  123               else 0
  124 
  125 rowr vbm i =
  126         makevec n f
  127         where
  128         n = boundvbmat vbm
  129         f j = if ( (j >= (fstclvbmat vbm i)) && (j <= i) ) then
  130                 vbmatsub vbm (i,j)
  131               else 0.0