1 2 3 4 5 6 7 8 9 10 11 12 module Matrix 13 (Matrix, Vector, Block , Vec , 14 Block_list , Row_pos, Col_pos, 15 mmult, mvmult, svmult, 16 madd, msub, 17 vadd, vsub, 18 vdot, vouter, 19 mneg, vneg, 20 norm, 21 mkmatrix, 22 mkvector, 23 mergevectors, 24 mupdate, vupdate, 25 msubscript, vsubscript, 26 getrow, 27 getcol, 28 numrows, 29 msize, vsize, 30 showmatrix, showvector) where 31 32 33 import AbsDensematrix 34 import Utils 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 mmult :: Matrix -> Matrix -> Matrix 71 madd :: Matrix -> Matrix -> Matrix 72 msub :: Matrix -> Matrix -> Matrix 73 mvmult :: Matrix -> Vector -> Vector 74 vadd :: Vector -> Vector -> Vector 75 vsub :: Vector -> Vector -> Vector 76 vdot :: Vector -> Vector -> Scalar 77 vouter :: Vector -> Vector -> Matrix 78 norm :: Vector -> Scalar 79 mneg :: Matrix -> Matrix 80 vneg :: Vector -> Vector 81 svmult :: Scalar -> Vector -> Vector 82 83 mupdate :: Matrix -> (Int,Int) -> Block -> Matrix 84 vupdate :: Vector -> Int -> Vec -> Vector 85 86 msubscript :: Int -> Int -> Matrix -> Block 87 msubscript' :: Int -> Int -> Matrix -> [Block] 88 vsubscript :: Int -> Vector -> Vec 89 getrow :: Int -> Matrix -> [Block_tuple] 90 getcol :: Int -> Matrix -> [Block_tuple] 91 numrows :: Matrix -> Int 92 msize :: Matrix -> (Int,Int) 93 vsize :: Vector -> Int 94 95 mkmatrix :: [[(Int,Int,Block)]] -> Matrix 96 mkvector :: [Vec] -> Vector 97 mergevectors :: Vector -> Vector -> Vector 98 99 showmatrix :: Matrix -> [Char] 100 showvector :: Vector -> [Char] 101 102 type Row_pos = Int 103 type Col_pos = Int 104 type Block_tuple = (Row_pos, Col_pos, Block) 105 type Block_list = [Block_tuple] 106 107 type Matrix = Matrix_type 108 type Vector = Vector_type 109 110 type Matrix_type = [Block_list] 111 type Vector_type = [Vec] 112 113 type Scalar = Float 114 sadd = (+) 115 116 mmult m1 m2 = error "unsupported matrix operation" 117 118 madd m1 m2 = error "unsupported matrix operation" 119 120 msub m1 m2 = error "unsupported matrix operation" 121 122 123 mneg m = map (map negtuple) m 124 where 125 negtuple (r, c, b) = (r, c, bneg b) 126 127 128 vadd v1 v2 = map2 vecadd v1 v2 129 130 vsub v1 v2 = map2 vecsub v1 v2 131 132 vdot v1 v2 = foldl1 sadd (map2 vecdot v1 v2) 133 134 vouter v1 v2 = error "unsupported vector operation" 135 136 norm v = foldl1 sadd (map vecnorm v) 137 138 vneg v = map vecneg v 139 140 svmult s v = map (svecmult s) v 141 142 mupdate m (i,j) val 143 = [getrow k m |k <- [0..i-1]] ++ [(f(m!!i))] 144 ++ [getrow l m | l <- [(i+1) .. (numrows m)-1]] 145 where 146 f xs = (take j xs) ++ [(i, (j+1), val)] ++ (drop (j+1) xs) 147 148 149 vupdate v i vc = (take i v) ++ [vc] ++ (drop (i+1) v) 150 151 152 showmatrix m 153 = concat [ (showrow i)++"\n" | i<-[0..length(m)-1] ] 154 where 155 showrow i = concat [status i j | j<-[0..length(m)-1]] 156 status i j 157 = if exist i j then "#" 158 else "." 159 exist i j = j `elem` (row i) 160 row i = [ col | (r,col,b) <- (m!!i) ] 161 162 showvector vs = concat (map showvec vs) 163 164 165 166 mkmatrix = id 167 168 169 mkvector = id 170 171 mergevectors = (++) 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 mvmult rows v 194 = if ok then [ rvdot row v | row <- rows ] 195 else error "Incompatible operands to large mvmult" 196 where 197 ok = (length rows) == (length v) 198 199 rvdot row v 200 = foldl1 vecadd [bvecmult b (vsubscript c v) | (r,c,b) <- row] 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 okindex :: Int -> [a] -> Bool 228 okindex n m = (0<=n) && (n<=((length m) - 1)) -- testing (irm) 229 230 231 iscol :: Int -> Block_tuple -> Bool 232 iscol k (r,c,b) = (k==c) 233 234 235 msubscript' r c m 236 = map strip_block (filter (iscol c) (getrow r m)) 237 238 msubscript r c m 239 = if thingee /= [] then (head thingee) 240 else zero_block r c m 241 where 242 thingee = msubscript' r c m 243 244 245 getrow n m 246 = if okindex n m then m !! n 247 else error "getrow: index out of bounds" 248 249 250 251 getcol n m 252 = concat [ filter (iscol n) row | row <- m ] 253 254 255 numrows m = length m 256 257 msize m = (length m,length (head m)) 258 259 vsize v = length v 260 261 262 263 strip_block :: Block_tuple -> Block 264 strip_block (r,c,b) = b 265 266 267 vsubscript n v 268 = if okindex n v then v!!n 269 else error "vsubscript in matrix" 270 271 272 273 274 275 276 277 zero_block :: Int -> Int -> Matrix -> Block 278 zero_block i j m 279 = mkblock (rep nrows (rep ncols 0)) 280 where 281 (nrows,junk1) = block_size (head (getrow i m)) 282 (junk2,ncols) = block_size (head (getcol j m)) 283 block_size (r,c,b) = bsize b 284 285