2 of 3 edited body; edited tags; edited title

# Type safe, easy to understand matrix multiplication

I always hated matrices (as they are taught in those linear algebra course books that I have browsed), because it's an obscure way of saying "a tuple of linear functions of same arity". It is very hard to remember which matrices you can multiply, what side the input is, what side the output, what transpositions should be done. Now, (square) matrices are a major example of a group, and matrices as an encoding of linear transformations are indispensable in differential geometry of any kind − for just two examples; so I had to stand up to it and design the matrices I would be able to like.

Now, one straightforward way of representing matrices in Haskell would be a nested list. Unfortunately, dealing in nested lists has proven to multiply my hate, rather than my matrices. I had to come up with a safer approach. What will follow is a take on it.

I post this code because it is actually above my head: I don't understand dependent typing at all, and half the language extensions I had to use I switched on because GHC told me to, not because I understand why they are indispensable here. I'd like to know if I'm on the right track − whether this code is sensible or not. I am happy about it now; I'd like to become less happy.

### Data.Nat

module Data.Nat where

data Nat = Z | S Nat


### Data.Vector

{-# LANGUAGE
DataKinds
, KindSignatures
, FlexibleInstances
, ScopedTypeVariables
, MultiParamTypeClasses
, FunctionalDependencies
, UndecidableInstances
#-}

module Data.Vector where

import Data.Nat

newtype Vector (n :: Nat) a = Vector { unVector :: [a] } deriving Show

-- vector is thanks to HTNV @ stackoverflow.com/a/49120144/2108477
class MkVector n a n' r | r -> n a n' where
mkVector :: (Vector n a -> Vector n' a) -> r

instance MkVector Z a n (Vector n a) where
mkVector f = f $Vector [] instance (MkVector n a n' r) => MkVector (S n) a n' (a -> r) where mkVector f x = mkVector$ \(Vector xs) -> f $Vector$ x:xs

vector :: MkVector n a n r => r
vector = mkVector id

v0 :: Vector Z a
v0 = Vector [ ]

put :: a -> Vector n a -> Vector (S n) a
put x (Vector xs) = Vector (x:xs)

instance Functor (Vector n) where
fmap f (Vector xs) = Vector (fmap f xs)

instance Foldable (Vector n) where
foldMap f (Vector xs) = foldMap f xs

instance Repeat (Vector n) => Applicative (Vector n) where
pure x = rep x
(Vector fs) <*> (Vector xs) = Vector (zipWith ($) fs xs) class Repeat a where rep :: forall x. x -> a x instance Repeat (Vector Z) where rep _ = v0 instance Repeat (Vector n) => Repeat (Vector (S n)) where rep (x :: x) = Vector$ x: unVector (rep x :: Vector n x)


### Data.Matrix

{-# LANGUAGE
DataKinds
, KindSignatures
, FlexibleInstances
, FlexibleContexts
, UndecidableInstances
, ExistentialQuantification
, StandaloneDeriving
, DeriveFunctor
#-}

module Data.Matrix where

import Data.Nat
import Data.Vector
import Data.List (foldl1')

-- | A linear function of n variables.
newtype LinearFunction (n :: Nat) a = LinearFunction (Vector n a)
deriving (Show, Functor)

instance Repeat (Vector n) => Applicative (LinearFunction n) where
pure x = LinearFunction $pure x (LinearFunction fs) <*> (LinearFunction xs) = LinearFunction$ fs <*> xs

-- | A few functions of the same arity.
data Matrix inp outp a = Matrix (Vector outp (LinearFunction inp a))
| forall inter. Sequence (Matrix inp inter a) (Matrix inter outp a)

deriving instance Show a => Show (Matrix inp outp a)

v1 = vector 1 2
v2 = vector 3 5
m1 :: Matrix (S (S Z)) (S (S Z)) Integer
m1 = Matrix (vector (LinearFunction v1) (LinearFunction v2))

-- |
--
-- λ apply v1 (Sequence m1 (Sequence m1 m1))
-- Vector [191,493]
--
apply :: Num a => Vector inp a -> Matrix inp outp a -> Vector outp a
apply v (Matrix (Vector fs)) = Vector $applyFunction v <$> fs
apply v (Sequence m1 m2) = v apply m1 apply m2

-- |
--
-- λ applyFunction v1 (LinearFunction v2)
-- 13
--
applyFunction :: Num a => Vector n a -> LinearFunction n a -> a
applyFunction (Vector xs) (LinearFunction (Vector qs)) = sum $zipWith (*) xs qs compose_trivial, compose :: (Num a, Repeat (Vector inter), Repeat (Vector inp)) => Matrix inp inter a -> Matrix inter outp a -> Matrix inp outp a compose_trivial = Sequence -- | -- -- λ v1 apply (m1 compose m1 compose m1) -- Vector {unVector = [191,493]} -- compose (Matrix fs) (Matrix gs) = Matrix$ fmap (createRow fs) gs
where
createRow fs (LinearFunction qs)
= let (Vector xs) = (\q -> fmap (* q)) <$> qs <*> fs in foldl1' (\xs ys -> (+) <$> xs <*> ys) xs
compose m1 m2@Sequence{} = Sequence m1 m2
compose m1@Sequence{} m2 = Sequence m1 m2