module HomologyZ2 (Homology, Complex, homology, example1, example2) where
import Data.List
import qualified Data.Vector as IV (unsafeIndex, unsafeFreeze, unsafeThaw, fromList, cons, head, tail, reverse, unsafeUpd, length, Vector, toList)
import qualified Data.Vector.Mutable as MIV (unsafeWrite, unsafeRead, clear, set, unsafeNew)
import Control.Monad.ST
import Control.Monad
import Data.STRef
import qualified Data.Set as Set
type Complex = IV.Vector ([Int], [Int], Bool)
type Homology = [Int]
homology :: Complex -> Homology
homology cr = let v = runST $ do
vec <- IV.unsafeThaw cr
forM_ [0..IV.length cr 1] $ \x -> do
(dx, d'1x, xAlive) <- MIV.unsafeRead vec x
when ((not $ null dx) && (xAlive)) $ do
(dy, d'1y, yAlive) <- MIV.unsafeRead vec (head dx)
forM_ d'1y $ \z -> do
(dz, d'1z, zAlive) <- MIV.unsafeRead vec z
when (zAlive && (z/=x)) $ MIV.unsafeWrite vec z (symmDiffList dz dx, d'1z, zAlive)
forM_ dx $ \w -> do
(dw, d'1w, wAlive) <- MIV.unsafeRead vec w
when wAlive $ MIV.unsafeWrite vec w (dw, symmDiffList d'1y d'1w, wAlive)
forM_ d'1x $ \z -> do
(dz, d'1z, zAlive) <- MIV.unsafeRead vec z
when zAlive $ MIV.unsafeWrite vec z (delete x dz, d'1z, zAlive)
forM_ dy $ \w -> do
(dw, d'1w, wAlive) <- MIV.unsafeRead vec w
when wAlive $ MIV.unsafeWrite vec w (dw, delete (head dx) d'1w, wAlive)
MIV.unsafeWrite vec x ([], [], False)
MIV.unsafeWrite vec (head dx) ([], [], False)
IV.unsafeFreeze vec
in [x | x <- [0..IV.length v 1], triple3 (IV.unsafeIndex v x) ]
triple1 (x, y, z) = x
triple2 (x, y, z) = y
triple3 (x, y, z) = z
symmDiffList :: (Eq a) => [a] -> [a] -> [a]
symmDiffList x y = (x `union` y) \\ (x `intersect` y)
example1 :: Complex
example1 = IV.fromList [([], [3], True), ([], [3], True), ([], [], True), ([0, 1, 2], [], True), ([], [3], True)]
example2 :: Complex
example2 = IV.fromList [([1,4],[],True),
([],[5,2,0],True),
([4,1],[],True),
([],[],True),
([],[5,2,0],True),
([1,4],[],True)]