{-# LANGUAGE NoImplicitPrelude #-}
{- |
Copyright : (c) Henning Thielemann 2006
Maintainer : numericprelude@henning-thielemann.de
Stability : provisional
Portability :
Permutation represented by an array of the images.
-}
module MathObj.Permutation.Table where
import qualified MathObj.Permutation as Perm
import Data.Set(Set)
import qualified Data.Set as Set
import Data.Array(Array,(!),(//),Ix)
import qualified Data.Array as Array
import Data.List ((\\), nub, unfoldr, )
import Data.Tuple.HT (swap, )
import Data.Maybe.HT (toMaybe, )
-- import NumericPrelude (Integer)
import PreludeBase hiding (cycle)
type T i = Array i i
fromFunction :: (Ix i) =>
(i, i) -> (i -> i) -> T i
fromFunction rng f =
Array.listArray rng (map f (Array.range rng))
toFunction :: (Ix i) => T i -> (i -> i)
toFunction = (!)
{-
Create a permutation in table form
from any other permutation representation.
-}
fromPermutation :: (Ix i, Perm.C p) => p i -> T i
fromPermutation x =
let rng = Perm.domain x
in Array.listArray rng (map (Perm.apply x) (Array.range rng))
fromCycles :: (Ix i) => (i, i) -> [[i]] -> T i
fromCycles rng = foldl (flip cycle) (identity rng)
identity :: (Ix i) => (i, i) -> T i
identity rng = Array.listArray rng (Array.range rng)
cycle :: (Ix i) => [i] -> T i -> T i
cycle cyc p =
p // zipWith (\i j -> (j,p!i)) cyc (tail (cyc++cyc))
inverse :: (Ix i) => T i -> T i
inverse p =
let rng = Array.bounds p
in Array.array rng (map swap (Array.assocs p))
compose :: (Ix i) => T i -> T i -> T i
compose p q =
let pRng = Array.bounds p
qRng = Array.bounds q
in if pRng==qRng
then fmap (p!) q
else error "compose: ranges differ"
-- ++ show pRng ++ " /= " ++ show qRng)
{- |
Extremely naïve algorithm
to generate a list of all elements in a group.
Should be replaced by a Schreier-Sims system
if this code is ever used for anything bigger than .. say ..
groups of order 512 or so.
-}
{-
Alternative to Data.Set.minView in GHC-6.6.
-}
choose :: Set a -> Maybe (a, Set a)
choose set =
toMaybe (not (Set.null set)) (Set.deleteFindMin set)
closure :: (Ix i) => [T i] -> [T i]
closure [] = []
closure generators@(gen:_) =
let genSet = Set.fromList generators
idSet = Set.singleton (identity (Array.bounds gen))
generate (registered, candidates) =
do (cand, remCands) <- choose candidates
let newCands =
flip Set.difference registered $
Set.map (compose cand) genSet
return (cand, (Set.union registered newCands,
Set.union remCands newCands))
in unfoldr generate (idSet, idSet)
closureSlow :: (Ix i) => [T i] -> [T i]
closureSlow [] = []
closureSlow generators@(gen:_) =
let addElts grp [] = grp
addElts grp cands@(cand:remCands) =
let group' = grp ++ [cand]
newCands = map (compose cand) generators
cands' = nub (remCands ++ newCands) \\ (grp ++ cands)
in addElts group' cands'
in addElts [] [identity (Array.bounds gen)]