module Algebra.Matrix
( Vector(Vec)
, unVec, lengthVec
, Matrix(M)
, matrix
, matrixToVector, vectorToMatrix, unMVec, unM
, identity, mulM, addM, transpose, isSquareMatrix, dimension
) where
import qualified Data.List as L
import Control.Monad (liftM)
import Test.QuickCheck
import Algebra.Structures.IntegralDomain
data Vector r = Vec [r] deriving (Eq)
instance Show r => Show (Vector r) where
show (Vec vs) = show vs
instance (Ring r, Arbitrary r, Eq r) => Arbitrary (Vector r) where
arbitrary = do n <- choose (1,10) :: Gen Int
liftM Vec $ gen n
where
gen 0 = return []
gen n = do x <- arbitrary
xs <- gen (n1)
if x == zero then return (one:xs) else return (x:xs)
unVec :: Vector r -> [r]
unVec (Vec vs) = vs
lengthVec :: Vector r -> Int
lengthVec = length . unVec
data Matrix r = M [Vector r]
deriving (Eq)
instance Show r => Show (Matrix r) where
show (M xs) = case unlines $ map show xs of
[] -> "[]"
xs -> init xs
instance (Eq r, Arbitrary r, Ring r) => Arbitrary (Matrix r) where
arbitrary = do n <- choose (1,10) :: Gen Int
m <- choose (1,10) :: Gen Int
xs <- sequence [ liftM Vec (gen n) | _ <- [1..m]]
return (M xs)
where
gen 0 = return []
gen n = do x <- arbitrary
xs <- gen (n1)
if x == zero then return (one:xs) else return (x:xs)
matrix :: [[r]] -> Matrix r
matrix xs =
let m = fromIntegral $ length xs
n = fromIntegral $ length (head xs)
in if length (filter (\x -> fromIntegral (length x) == n) xs) == length xs
then M (map Vec xs)
else error "matrix: Bad dimensions"
unM :: Matrix r -> [Vector r]
unM (M xs) = xs
unMVec :: Matrix r -> [[r]]
unMVec = map unVec . unM
vectorToMatrix :: Vector r -> Matrix r
vectorToMatrix = matrix . (:[]) . unVec
matrixToVector :: Matrix r -> Vector r
matrixToVector m | fst (dimension m) == 1 = head (unM m)
| otherwise = error "matrixToVector: Bad dimension"
dimension :: Matrix r -> (Int, Int)
dimension (M xs) | null xs = (0,0)
| otherwise = (length xs, length (unVec (head xs)))
isSquareMatrix :: Matrix r -> Bool
isSquareMatrix (M xs) = all (== length xs) (map lengthVec xs)
transpose :: Matrix r -> Matrix r
transpose (M xs) = matrix (L.transpose (map unVec xs))
addM :: Ring r => Matrix r -> Matrix r -> Matrix r
addM (M xs) (M ys) | dimension (M xs) == dimension (M ys) = m
| otherwise = error "Bad dimensions in matrix addition"
where
m = matrix (zipWith (zipWith (<+>)) (map unVec xs) (map unVec ys))
mulM :: Ring r => Matrix r -> Matrix r -> Matrix r
mulM (M xs) (M ys)
| snd (dimension (M xs)) == fst (dimension (M ys)) = m
| otherwise = error "Bad dimensions in matrix multiplication"
where
m = matrix [ [ foldr1 (<+>) (zipWith (<*>) x y)
| y <- L.transpose (map unVec ys) ]
| x <- map unVec xs ]
identity :: IntegralDomain r => Int -> Matrix r
identity n = matrix (xs 0)
where
xs x | x == n = []
| otherwise = (replicate x zero ++ [one] ++
replicate (nx1) zero) : xs (x+1)
propLeftIdentity :: (IntegralDomain r, Eq r) => Matrix r -> Bool
propLeftIdentity a = a == identity n `mulM` a
where n = fst (dimension a)
propRightIdentity :: (IntegralDomain r, Eq r) => Matrix r -> Bool
propRightIdentity a = a == a `mulM` identity m
where m = snd (dimension a)