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