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