The Analogical Engine

 
 
import MyPermutations
import Data.List
 
type Matrix = [[Int]]
 
matTranspose :: Matrix -> Matrix
matTranspose ([]:xs) = []
matTranspose xs = (map head xs):(matTranspose (map tail xs))
 
matProduct :: Matrix -> Matrix -> Matrix
matProduct m1 m2 = matProduct' m1 (matTranspose m2)
 
matProduct' :: Matrix -> Matrix -> Matrix
matProduct' [] m = []
matProduct' (r:rs) m = (findRow' r m):(matProduct' rs m)
 
findRow' :: [Int] -> Matrix -> [Int]
findRow' r m = map (foldr (+) 0) (map (zipWith (*) r) m)
 
determinant :: Matrix -> Int
determinant m = foldr (+) 0 (map (detTerm m) (allPermutedLists (length m)))
 
sign :: PermutedList -> Int
sign [] = 0
sign (x:xs) = (inversions' x xs) + (sign xs)
 
inversions' :: Int -> [Int] -> Int
inversions' k xs = length $ filter (\x -> (x < k)) xs
 
detTerm :: Matrix -> PermutedList -> Int
detTerm m p = (-1)^(sign p) * (detTerm' m p)
 
detTerm' :: Matrix -> PermutedList -> Int
detTerm' _ [] = 1
detTerm' (m:ms) (p:ps) = m!!(p-1) * (detTerm' ms ps)
 
minor :: Matrix -> [Int] -> [Int] -> Matrix
minor m rows cols = [ [ (m!!(i-1))!!(j-1) | j <- cols ] | i <- rows ] 
 
almostMatInverse :: Matrix -> Matrix
almostMatInverse m =   [ [ determinant $ minor m (foo n i) (foo n j) |
                                                   i <- [1..n] ] | j <- [1..n]]
	where n = length m
 
foo :: Int -> Int -> [Int]
foo n k = delete k [1..n]
 
.