行列計算のサンプル

Matrix.hs

module Data.Matrix where

newtype Matrix a = Matrix {
      toList :: [[a]]
} deriving(Eq)

fromList = Matrix

instance Show a => Show (Matrix a) where
    show (Matrix []) = ""
    show (Matrix rs) = show' rs
      where
        show' (r:[]) = show r
        show' (r:rs) = show r ++ "\n" ++ show' rs

instance Functor Matrix where
    fmap f (Matrix rs) = Matrix $ map (\r -> map f r) rs

tr :: Matrix a -> Matrix a
tr (Matrix []) = Matrix []
tr (Matrix xs) = Matrix $ tr' xs
  where
    tr' ([]:_) = []
    tr' xs     = (map head xs) : (tr' (map tail xs))

row :: Matrix a -> Int -> Matrix a
row (Matrix rs) n = Matrix [rs !! n]
    
col :: Matrix a -> Int -> Matrix a
col (Matrix rs) n = Matrix $ map (\r -> [r !! n]) rs

areSameType :: Matrix a -> Matrix a -> Bool
areSameType l r = (numOfRow l == numOfRow r) && (numOfCol l == numOfCol r)

add :: (Num a) => Matrix a -> Matrix a -> Matrix a
add l@(Matrix lm) r@(Matrix rm) | areSameType l r = Matrix . map (\(lr, rr) -> zipWith (+) lr rr) $ zip lm rm

numOfCol :: Matrix a -> Int
numOfCol (Matrix (r:rs)) = length r

numOfRow :: Matrix a -> Int
numOfRow (Matrix rs) = length rs

mul :: (Num a) => Matrix a -> Matrix a -> Matrix a
mul lm rm | areMultipliable = fmap p idxs
  where
    areMultipliable = numOfCol lm == numOfRow rm
    idxs = indices (numOfRow lm) (numOfCol rm) 
    p (r, c) = mulVec (row lm r) (col rm c)

mulVec :: Num a => Matrix a -> Matrix a -> a
mulVec rowVec colVec = sum $ zipWith (*) (concat . toList $ rowVec) (concat . toList . tr $ colVec)

indices :: Int -> Int -> Matrix (Int, Int)
indices nr nc = Matrix [[(r, c)| c <- [0..nc-1]] | r <- [0 .. nr-1]]

instance Num a => Num (Matrix a) where
    (+)         = add
    (*)         = mul
    negate      = scale (-1)
    abs         = undefined
    signum      = undefined
    fromInteger = undefined

scale :: Num a => a -> Matrix a -> Matrix a
scale a m = fmap (* a) m