module Data.Graph.Permutation (Permutation, fixed, permBetween, applyPerm, orbitsFromPerm, mergePerms) where
import Data.Array
import Data.List
import Data.Graph
import Data.Graph.Partition
import Data.Tree (flatten)
type Permutation = Array Vertex Vertex
fixed :: Permutation -> [Vertex]
fixed perm = [i | i <- range $ bounds perm, perm!i == i]
permBetween :: Bounds -> [Vertex] -> [Vertex] -> Permutation
permBetween bnds l1 l2 = array bnds (zip l1 l2)
applyPerm :: Permutation -> Graph -> Graph
applyPerm perm gr = array bnds [(perm!x, sort $ map (perm!) (gr!x)) | x <- range bnds]
where bnds = bounds gr
permAsGraph :: Permutation -> Graph
permAsGraph = fmap return
orbitsFromPerm :: Permutation -> Partition
orbitsFromPerm = map flatten . dff . permAsGraph
permFromOrbits :: Bounds -> Partition -> Permutation
permFromOrbits bnds orbits = array bnds $ concat $ map cycleOf $ orbits
where cycleOf' first (v1:v2:vs) = (v1, v2) : cycleOf' first (v2:vs)
cycleOf' first (v:[]) = [(v, first)]
cycleOf' _ _ = []
cycleOf orbit@(v:_) = cycleOf' v orbit
cycleOf _ = []
mergePerms :: Permutation -> Permutation -> Permutation
mergePerms p1 p2 = permFromOrbits (bounds p1) $
map flatten $
dff $
listArray (bounds p1) (zipWith (\v1 v2->[v1, v2]) (elems p1) (elems p2))