module Data.Graph.Partition(Cell, Partition, refine, isSingleton,
unitPartition, isDiscrete, mcr,
Indicator, lambda, lambda_, fixedInOrbits) where
import Data.Graph
import Data.List
import Data.Array((!), range, bounds)
import Data.Int
import Data.Bits
import qualified Data.Map as Map
type Cell = [Vertex]
type Partition = [Cell]
isSingleton :: [a] -> Bool
isSingleton [_] = True
isSingleton _ = False
unitPartition :: (Vertex, Vertex) -> Partition
unitPartition bnds = [range bnds]
isDiscrete :: Partition -> Bool
isDiscrete = all isSingleton
refine :: Graph -> Partition -> Partition -> Partition
refine _ p [] = p
refine gr p (w:ws) = refine gr p' alpha
where (p', alpha) = refineCells p ws
refineCells [] q = ([], q)
refineCells (c:cs) q = (rc ++ rcs, xxq)
where (rc, xq) = refineCell c q
(rcs, xxq) = refineCells cs xq
refineCell :: Cell -> [Cell] -> (Partition, [Cell])
refineCell [v] alph = ([[v]], alph)
refineCell c alph
| isSingleton xs = ([c], alph)
| otherwise = (xs, alph' ++ smallXs)
where
xs = refineCellByOneCell c w
alph' = replace (c ==) largeXt alph
(largeXt, smallXs) = extractLargest xs
refineCellByOneCell :: Cell -> Cell -> Partition
refineCellByOneCell refinedCell referenceCell =
groupSortBy (degreeCellVertex gr referenceCell) refinedCell
replace :: (a->Bool) -> a -> [a] -> [a]
replace _ _ [] = []
replace f rep (l:ls)
| f l = rep:ls
| otherwise = l:replace f rep ls
extractLargest :: [[a]] -> ([a], [[a]])
extractLargest list = (largest, before ++ after)
where (before, (largest:after)) = break hasMaxLength list
hasMaxLength el = length el == maxLength
maxLength = maximum $ map length $ list
groupSortBy :: Ord k => (a -> k) -> [a] -> [[a]]
groupSortBy f list = map snd $ Map.toList $ Map.fromListWith (\x y -> y ++ x) [(f v, [v]) | v <- list]
mcr :: Partition -> [Vertex]
mcr = map head
fixedInOrbits :: Partition -> [Vertex]
fixedInOrbits part = map head $ filter isSingleton $ part
isNeighbour :: Graph -> Vertex -> Vertex -> Bool
isNeighbour gr n1 n2 = n2 `elem` (gr!n1)
degreeCellVertex :: Graph -> Cell -> Vertex -> Int
degreeCellVertex gr cell vertex = count (isNeighbour gr vertex) cell
where count p = foldr (\v->if p v then (+1) else id) 0
type Indicator = Int32
oih :: [Indicator] -> Indicator
oih = foldr xor 0
osh :: [Indicator] -> Indicator
osh = foldl' (\x y -> 97 * y + x + 1230497) 1
lambda :: Graph -> Partition -> Indicator
lambda gr nu
= osh [oih $ map fromIntegral $ map (degreeCellVertex gr c) (range $ bounds $ gr) | c <- nu]
lambda_ :: Graph -> [Partition] -> [Indicator]
lambda_ gr = map (lambda gr)