progress on smith

src/LinearAlgebra/matrices.hs

@@ -0,0 +1,77 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+import Data.List
+import qualified Data.Matrix as M (prettyMatrix, Matrix, fromLists)
+
+-- | type synomyms
+type Matrix a = [[a]]
+type Vector a =  [a]
+
+-- | doesn't seem to want to display stuff properly
+instance {-# OVERLAPPING #-} Show a => Show (Matrix a) where
+    show = M.prettyMatrix . M.fromLists
+
+-- e.g. [[1,2,3],[4,5,6],[7,8,9]]
+--     | 1 2 3 |
+--   = | 4 5 6 |
+--     | 7 8 9 |
+
+--[arbitrary matrices]------------------------------------------------------------
+
+ass :: Matrix Int
+ass = [[1,2,3],[4,5,6],[7,8,9]]
+
+--[Vector operations]-----------------------------------------------------------
+
+-- | vector addition, component-wise
+vectAdd   :: Num a => Vector a -> Vector a -> Vector a
+vectAdd = zipWith (+)
+
+-- | scalar multiplication, component-wise.
+vectScale :: Num a => a -> Vector a -> Vector a
+vectScale c = map (* c)
+
+--[Matrix properties]-----------------------------------------------------------
+
+rows :: Matrix a -> Int
+rows = length
+
+cols :: Matrix a -> Int
+cols mss = length (mss !! 0)
+
+row :: Matrix a -> Int -> Vector a
+row mss i = mss !! (i - 1)
+
+--[EROs and ECOs]---------------------------------------------------------------
+
+-- | type 1 ERO, swaps row i with row j in matrix mss.
+swapRows    :: Int -> Int -> Matrix a -> Matrix a
+swapRows i j mss = [get k | k <- [1..rows mss]] where
+    get k | k == i     = mss !! (j - 1)
+          | k == j     = mss !! (i - 1)
+          | otherwise  = mss !! (k - 1)
+
+-- | type 2 ERO, scales row i by scalar c in matrix mss
+scaleRow    :: Num a => a -> Int -> Matrix a -> Matrix a
+scaleRow c i mss = [get k | k <- [1..rows mss]] where
+    get k | k == i     = vectScale c (mss !! (i - 1))
+          | otherwise  = (mss !! (k - 1))
+
+-- | type 3 ERO, adds c times row j to row i in matrix mss
+combineRows :: Num a => Int -> a -> Int -> Matrix a -> Matrix a
+combineRows i c j mss = [get k | k <- [1..rows mss]] where
+    get k | k == i     = vectAdd (mss !! (i - 1)) (vectScale c (mss !! (j - 1)))
+          | otherwise  = (mss !! (k - 1))
+
+-- | type 1 ECO
+swapCols    :: Int -> Int -> Matrix a -> Matrix a
+swapCols i j = transpose . (swapCols i j) . transpose
+
+-- | type 2 ECO
+scaleCol    :: Num a => a -> Int -> Matrix a -> Matrix a
+scaleCol c i = transpose . (scaleCol c i) . transpose
+
+-- | type 3 ECO
+combineCols :: Num a => Int -> a -> Int -> Matrix a -> Matrix a
+combineCols i c j = transpose . (combineRows i c j) . transpose

src/Main.hs

@@ -0,0 +1,37 @@
+module Main where
+
+import Text.Yoda
+import Data.Matrix
+import LinearAlgebra.MatrixParser
+import LinearAlgebra.Smith
+import System.Environment
+import System.Exit
+
+
+-- TODO change getLine to getArgs and concatenate all args into one, the rest is the same
+
+main = do l <- getLine
+          let m = parseMatrix l
+          output m
+          let s = m >>= maybeSmith
+          output s
+
+output :: (Show a) =>  Maybe a -> IO ()
+output Nothing  = invalidArgs
+output (Just a) = print a
+
+parseMatrix :: String -> Maybe (Matrix Integer)
+parseMatrix [] = Nothing
+parseMatrix xs = let m = parse intMatrix xs in
+                 case m of
+                   []         -> Nothing
+                   ((m,s):xs) -> Just m
+
+maybeSmith :: Matrix Integer -> Maybe (Matrix Integer)
+maybeSmith m = return $ smith m
+
+
+invalidArgs = putStrLn msg >> exit where
+    msg = "Invalid arguments" -- TODO, write this up properly for usability
+
+exit    = exitWith ExitSuccess