home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / hugs_1 / demos_hs_Matrix < prev    next >
Encoding:
Text File  |  1996-08-12  |  3.4 KB  |  96 lines

  1. -- Some simple Hugs programs for manipulating matrices.
  2. --
  3.  
  4. import List
  5.  
  6. type Matrix k = [Row k]          -- matrix represented by a list of its rows
  7. type Row k    = [k]              -- a row represented by a list of literals
  8.  
  9. -- General utility functions:
  10.  
  11. shapeMat    :: Matrix k -> (Int, Int)
  12. shapeMat mat = (rows mat, cols mat)
  13.  
  14. rows        :: Matrix k -> Int
  15. rows mat     = length mat
  16.  
  17. cols        :: Matrix k -> Int
  18. cols mat     = length (head mat)
  19.  
  20. idMat       :: Int -> Matrix Int
  21. idMat 0      = []
  22. idMat (n+1)  = [1:replicate n 0] ++ map (0:) (idMat n)
  23.  
  24. -- Matrix multiplication:
  25.  
  26. multiplyMat                     :: Matrix Int -> Matrix Int -> Matrix Int
  27. multiplyMat a b | cols a==rows b = [[row `dot` col | col<-b'] | row<-a]
  28.                 | otherwise      = error "incompatible matrices"
  29.                  where v `dot` w = sum (zipWith (*) v w)
  30.                        b'        = transpose b
  31.  
  32. -- An attempt to implement the standard algorithm for converting a matrix
  33. -- to echelon form...
  34.  
  35. echelon   :: Matrix Int -> Matrix Int
  36. echelon rs
  37.     | null rs || null (head rs) = rs
  38.     | null rs2                  = map (0:) (echelon (map tail rs))
  39.     | otherwise                 = piv : map (0:) (echelon rs')
  40.       where rs'            = map (adjust piv) (rs1++rs3)
  41.             (rs1,rs2)      = span leadZero rs
  42.             leadZero (n:_) = n==0
  43.             (piv:rs3)      = rs2
  44.  
  45. -- To find the echelon form of a matrix represented by a list of rows rs:
  46. -- 
  47. -- {first line in definition of echelon}:
  48. --  If either the number of rows or the number of columns in the matrix
  49. --  is zero (i.e. if null rs || null (head rs)), then the matrix is
  50. --  already in echelon form.
  51. -- 
  52. -- {definition of rs1, rs2, leadZero in where clause}:
  53. --  Otherwise, split the matrix into two submatrices rs1 and rs2 such that
  54. --  rs1 ++ rs2 == rs  and all of the rows in rs1 begin with a zero.
  55. --
  56. -- {second line in definition of echelon}:
  57. --  If rs2 is empty (i.e. if null rs2) then every row begins with a zero
  58. --  and the echelon form of rs can be found by adding a zero on to the
  59. --  front of each row in the echelon form of (map tail rs).
  60. --
  61. -- {Third line in definition of echelon, and definition of piv, rs3}:
  62. --  Otherwise, the first row of rs2 (denoted piv) contains a non-zero
  63. --  leading coefficient.  After moving this row to the top of the matrix
  64. --  the original matrix becomes  piv:(rs1++rs3).
  65. --  By subtracting suitable multiples of piv from (suitable multiples of)
  66. --  each row in (rs1++rs3) {see definition of adjust below}, we obtain a
  67. --  matrix of the form:
  68. --
  69. --          <----- piv ------>
  70. --          __________________
  71. --          0  |
  72. --          .  |
  73. --          .  |      rs'        where rs' = map (adjust piv) (rs1++rs3)
  74. --          .  |
  75. --          0  |
  76. --
  77. --  whose echelon form is  piv : map (0:) (echelon rs').
  78. --
  79.  
  80. adjust              :: Num a => Row a -> Row a -> Row a
  81. adjust (m:ms) (n:ns) = zipWith (-) (map (n*) ms) (map (m*) ns)
  82.  
  83. -- A more specialised version of this, for matrices of integers, uses the
  84. -- greatest common divisor function gcd in an attempt to try and avoid
  85. -- result matrices with very large coefficients:
  86. --
  87. -- (I'm not sure this is really worth the trouble!)
  88.  
  89. adjust'              :: Row Int -> Row Int -> Row Int
  90. adjust' (m:ms) (n:ns) = if g==0 then ns
  91.                                 else zipWith (\x y -> b*y - a*x) ms ns
  92.                         where g = gcd m n
  93.                               a = n `div` g
  94.                               b = m `div` g
  95. -- end!!
  96.