60 lines
1.4 KiB
Haskell
60 lines
1.4 KiB
Haskell
sPermutations :: [a] -> [([a], Int)]
|
|
sPermutations = flip zip (cycle [1, -1]) . foldl aux [[]]
|
|
where
|
|
aux items x = do
|
|
(f, item) <- zip (cycle [reverse, id]) items
|
|
f (insertEv x item)
|
|
insertEv x [] = [[x]]
|
|
insertEv x l@(y:ys) = (x : l) : ((y :) <$>) (insertEv x ys)
|
|
|
|
elemPos :: [[a]] -> Int -> Int -> a
|
|
elemPos ms i j = (ms !! i) !! j
|
|
|
|
prod
|
|
:: Num a
|
|
=> ([[a]] -> Int -> Int -> a) -> [[a]] -> [Int] -> a
|
|
prod f ms = product . zipWith (f ms) [0 ..]
|
|
|
|
sDeterminant
|
|
:: Num a
|
|
=> ([[a]] -> Int -> Int -> a) -> [[a]] -> [([Int], Int)] -> a
|
|
sDeterminant f ms = sum . fmap (\(is, s) -> fromIntegral s * prod f ms is)
|
|
|
|
determinant
|
|
:: Num a
|
|
=> [[a]] -> a
|
|
determinant ms =
|
|
sDeterminant elemPos ms . sPermutations $ [0 .. pred . length $ ms]
|
|
|
|
permanent
|
|
:: Num a
|
|
=> [[a]] -> a
|
|
permanent ms =
|
|
sum . fmap (prod elemPos ms . fst) . sPermutations $ [0 .. pred . length $ ms]
|
|
|
|
-- TEST -----------------------------------------------------------------------
|
|
result
|
|
:: (Num a, Show a)
|
|
=> [[a]] -> String
|
|
result ms =
|
|
unlines
|
|
[ "Matrix:"
|
|
, unlines (show <$> ms)
|
|
, "Determinant:"
|
|
, show (determinant ms)
|
|
, "Permanent:"
|
|
, show (permanent ms)
|
|
]
|
|
|
|
main :: IO ()
|
|
main =
|
|
mapM_
|
|
(putStrLn . result)
|
|
[ [[5]]
|
|
, [[1, 0, 0], [0, 1, 0], [0, 0, 1]]
|
|
, [[0, 0, 1], [0, 1, 0], [1, 0, 0]]
|
|
, [[4, 3], [2, 5]]
|
|
, [[2, 5], [4, 3]]
|
|
, [[4, 4], [2, 2]]
|
|
]
|