{-| Module      :  Data.Graph.Permutation
    Copyright   :  (c) Jean-Philippe Bernardy 2003
    License     :  GPL

    Maintainer  :  JeanPhilippe.Bernardy@gmail.com
    Stability   :  proposal
    Portability :  GHC


This modules manages permutations between nodes of a graph. Permutations are represented as arrays.

-}


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)

-- | A permutations maps a range of Vertices to itself.
type Permutation = Array Vertex Vertex

-- | Fixed vertices of a given permutation
fixed :: Permutation -> [Vertex]
fixed :: Permutation -> [Vertex]
fixed Permutation
perm = [Vertex
i | Vertex
i <- (Vertex, Vertex) -> [Vertex]
forall a. Ix a => (a, a) -> [a]
range ((Vertex, Vertex) -> [Vertex]) -> (Vertex, Vertex) -> [Vertex]
forall a b. (a -> b) -> a -> b
$ Permutation -> (Vertex, Vertex)
forall i e. Array i e -> (i, i)
bounds Permutation
perm, Permutation
permPermutation -> Vertex -> Vertex
forall i e. Ix i => Array i e -> i -> e
!Vertex
i Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
i]


-- | Builds the permutation taking l1 on l2.
permBetween :: Bounds -> [Vertex] -> [Vertex] -> Permutation
permBetween :: (Vertex, Vertex) -> [Vertex] -> [Vertex] -> Permutation
permBetween (Vertex, Vertex)
bnds [Vertex]
l1 [Vertex]
l2 = (Vertex, Vertex) -> [(Vertex, Vertex)] -> Permutation
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Vertex, Vertex)
bnds ([Vertex] -> [Vertex] -> [(Vertex, Vertex)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex]
l1 [Vertex]
l2)

-- | Relabel a graph using a permutation
applyPerm :: Permutation -> Graph -> Graph
applyPerm :: Permutation -> Graph -> Graph
applyPerm Permutation
perm Graph
gr = (Vertex, Vertex) -> [(Vertex, [Vertex])] -> Graph
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Vertex, Vertex)
bnds [(Permutation
permPermutation -> Vertex -> Vertex
forall i e. Ix i => Array i e -> i -> e
!Vertex
x, [Vertex] -> [Vertex]
forall a. Ord a => [a] -> [a]
sort ([Vertex] -> [Vertex]) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ (Vertex -> Vertex) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (Permutation
permPermutation -> Vertex -> Vertex
forall i e. Ix i => Array i e -> i -> e
!) (Graph
grGraph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
!Vertex
x)) | Vertex
x <- (Vertex, Vertex) -> [Vertex]
forall a. Ix a => (a, a) -> [a]
range (Vertex, Vertex)
bnds]
    where bnds :: (Vertex, Vertex)
bnds = Graph -> (Vertex, Vertex)
forall i e. Array i e -> (i, i)
bounds Graph
gr


-- | Returns the graph of the permutation
permAsGraph :: Permutation -> Graph
permAsGraph :: Permutation -> Graph
permAsGraph = (Vertex -> [Vertex]) -> Permutation -> Graph
forall a b. (a -> b) -> Array Vertex a -> Array Vertex b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vertex -> [Vertex]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Returns the orbits of a permutation, as a partition
orbitsFromPerm :: Permutation -> Partition
orbitsFromPerm :: Permutation -> Partition
orbitsFromPerm = (Tree Vertex -> [Vertex]) -> [Tree Vertex] -> Partition
forall a b. (a -> b) -> [a] -> [b]
map Tree Vertex -> [Vertex]
forall a. Tree a -> [a]
flatten ([Tree Vertex] -> Partition)
-> (Permutation -> [Tree Vertex]) -> Permutation -> Partition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Tree Vertex]
dff (Graph -> [Tree Vertex])
-> (Permutation -> Graph) -> Permutation -> [Tree Vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permutation -> Graph
permAsGraph

-- | Returns a permutation whose orbits are given.
permFromOrbits :: Bounds -> Partition -> Permutation
permFromOrbits :: (Vertex, Vertex) -> Partition -> Permutation
permFromOrbits (Vertex, Vertex)
bnds Partition
orbits = (Vertex, Vertex) -> [(Vertex, Vertex)] -> Permutation
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Vertex, Vertex)
bnds ([(Vertex, Vertex)] -> Permutation)
-> [(Vertex, Vertex)] -> Permutation
forall a b. (a -> b) -> a -> b
$ ([Vertex] -> [(Vertex, Vertex)]) -> Partition -> [(Vertex, Vertex)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Vertex] -> [(Vertex, Vertex)]
forall {a}. [a] -> [(a, a)]
cycleOf Partition
orbits
    where cycleOf' :: a -> [a] -> [(a, a)]
cycleOf' a
first (a
v1:a
v2:[a]
vs) = (a
v1, a
v2) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: a -> [a] -> [(a, a)]
cycleOf' a
first (a
v2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
vs)
          cycleOf' a
first [a
v] = [(a
v, a
first)]
          cycleOf' a
_ [a]
_ = []
          cycleOf :: [a] -> [(a, a)]
cycleOf orbit :: [a]
orbit@(a
v:[a]
_) = a -> [a] -> [(a, a)]
forall {a}. a -> [a] -> [(a, a)]
cycleOf' a
v [a]
orbit
          cycleOf [a]
_ = []

-- | Merge the orbits of two permutations
mergePerms :: Permutation -> Permutation -> Permutation
mergePerms :: Permutation -> Permutation -> Permutation
mergePerms Permutation
p1 Permutation
p2 = (Vertex, Vertex) -> Partition -> Permutation
permFromOrbits (Permutation -> (Vertex, Vertex)
forall i e. Array i e -> (i, i)
bounds Permutation
p1) (Partition -> Permutation) -> Partition -> Permutation
forall a b. (a -> b) -> a -> b
$
                   (Tree Vertex -> [Vertex]) -> [Tree Vertex] -> Partition
forall a b. (a -> b) -> [a] -> [b]
map Tree Vertex -> [Vertex]
forall a. Tree a -> [a]
flatten ([Tree Vertex] -> Partition) -> [Tree Vertex] -> Partition
forall a b. (a -> b) -> a -> b
$
                   Graph -> [Tree Vertex]
dff (Graph -> [Tree Vertex]) -> Graph -> [Tree Vertex]
forall a b. (a -> b) -> a -> b
$
                   (Vertex, Vertex) -> Partition -> Graph
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Permutation -> (Vertex, Vertex)
forall i e. Array i e -> (i, i)
bounds Permutation
p1) ((Vertex -> Vertex -> [Vertex]) -> [Vertex] -> [Vertex] -> Partition
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Vertex
v1 Vertex
v2->[Vertex
v1, Vertex
v2]) (Permutation -> [Vertex]
forall i e. Array i e -> [e]
elems Permutation
p1) (Permutation -> [Vertex]
forall i e. Array i e -> [e]
elems Permutation
p2))