{-# LANGUAGE TemplateHaskell, RankNTypes #-}
module GroupPresentation (
GeneratorsDescr,
GroupPresentation,
groupPresentation,
relations,
generatorsDescr,
GPGetter,
generators,
allGenerators,
strGenerators,
module GroupPresentation.Relation,
module Containers,
module Lens,
) where
import GroupPresentation.Relation
import Containers
import Lens
type GeneratorsDescr = IsoMap Generator String
data GroupPresentation = GP
{ GroupPresentation -> Relations
_relations :: Relations
, GroupPresentation -> GeneratorsDescr
_generatorsDescr :: GeneratorsDescr
}
groupPresentation :: Relations -> GeneratorsDescr -> GroupPresentation
groupPresentation :: Relations -> GeneratorsDescr -> GroupPresentation
groupPresentation = Relations -> GeneratorsDescr -> GroupPresentation
GP
makeLenses ''GroupPresentation
instance Show GroupPresentation where
show :: GroupPresentation -> String
show GroupPresentation
gp =
((Pair [Signed Generator] -> String)
-> [Pair [Signed Generator]] -> String)
-> [Pair [Signed Generator]]
-> (Pair [Signed Generator] -> String)
-> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Pair [Signed Generator] -> String)
-> [Pair [Signed Generator]] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GroupPresentation
gpGroupPresentation
-> Getting
[Pair [Signed Generator]]
GroupPresentation
[Pair [Signed Generator]]
-> [Pair [Signed Generator]]
forall s a. s -> Getting a s a -> a
^.(Relations -> Const [Pair [Signed Generator]] Relations)
-> GroupPresentation
-> Const [Pair [Signed Generator]] GroupPresentation
Lens' GroupPresentation Relations
relations((Relations -> Const [Pair [Signed Generator]] Relations)
-> GroupPresentation
-> Const [Pair [Signed Generator]] GroupPresentation)
-> (([Pair [Signed Generator]]
-> Const [Pair [Signed Generator]] [Pair [Signed Generator]])
-> Relations -> Const [Pair [Signed Generator]] Relations)
-> Getting
[Pair [Signed Generator]]
GroupPresentation
[Pair [Signed Generator]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Relations -> [Pair [Signed Generator]])
-> ([Pair [Signed Generator]]
-> Const [Pair [Signed Generator]] [Pair [Signed Generator]])
-> Relations
-> Const [Pair [Signed Generator]] Relations
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Relations -> [Pair [Signed Generator]]
forall c v. Listable c v => c -> [v]
toList) ((Pair [Signed Generator] -> String) -> String)
-> (Pair [Signed Generator] -> String) -> String
forall a b. (a -> b) -> a -> b
$
\(Pair ([Signed Generator]
ew1, [Signed Generator]
ew2)) ->
let showElem :: Signed Generator -> String
showElem Signed Generator
e =
let g :: Generator
g = Signed Generator -> Generator
getGenerator Signed Generator
e
s :: String
s = if Signed Generator -> Bool
forall a. Signed a -> Bool
isPositive Signed Generator
e then String
"" else String
"^-1"
in String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"???" (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) (GroupPresentation
gpGroupPresentation
-> Getting (Maybe String) GroupPresentation (Maybe String)
-> Maybe String
forall s a. s -> Getting a s a -> a
^.(GeneratorsDescr -> Const (Maybe String) GeneratorsDescr)
-> GroupPresentation -> Const (Maybe String) GroupPresentation
Lens' GroupPresentation GeneratorsDescr
generatorsDescr((GeneratorsDescr -> Const (Maybe String) GeneratorsDescr)
-> GroupPresentation -> Const (Maybe String) GroupPresentation)
-> Generator
-> Getting (Maybe String) GroupPresentation (Maybe String)
forall c k v (m :: * -> *) x y.
(Indexable c k v, MonadFail m) =>
Getting x y c -> k -> Getting x y (m v)
.@Generator
g)
in
[String] -> String
unwords ((Signed Generator -> String) -> [Signed Generator] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Signed Generator -> String
showElem [Signed Generator]
ew1) String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++
[String] -> String
unwords ((Signed Generator -> String) -> [Signed Generator] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Signed Generator -> String
showElem [Signed Generator]
ew2) String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n"
type GPGetter a = Getter GroupPresentation a
generators :: GPGetter (Set Generator)
generators :: (Set Generator -> f (Set Generator))
-> GroupPresentation -> f GroupPresentation
generators = (GeneratorsDescr -> f GeneratorsDescr)
-> GroupPresentation -> f GroupPresentation
Lens' GroupPresentation GeneratorsDescr
generatorsDescr ((GeneratorsDescr -> f GeneratorsDescr)
-> GroupPresentation -> f GroupPresentation)
-> ((Set Generator -> f (Set Generator))
-> GeneratorsDescr -> f GeneratorsDescr)
-> (Set Generator -> f (Set Generator))
-> GroupPresentation
-> f GroupPresentation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneratorsDescr -> Set Generator)
-> (Set Generator -> f (Set Generator))
-> GeneratorsDescr
-> f GeneratorsDescr
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GeneratorsDescr -> Set Generator
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet
allGenerators :: GPGetter (Set Generator)
allGenerators :: (Set Generator -> f (Set Generator))
-> GroupPresentation -> f GroupPresentation
allGenerators = (GroupPresentation -> Set Generator)
-> (Set Generator -> f (Set Generator))
-> GroupPresentation
-> f GroupPresentation
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((GroupPresentation -> Set Generator)
-> (Set Generator -> f (Set Generator))
-> GroupPresentation
-> f GroupPresentation)
-> (GroupPresentation -> Set Generator)
-> (Set Generator -> f (Set Generator))
-> GroupPresentation
-> f GroupPresentation
forall a b. (a -> b) -> a -> b
$ do
Relations
rs <- Getting Relations GroupPresentation Relations
-> GroupPresentation -> Relations
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Relations GroupPresentation Relations
Lens' GroupPresentation Relations
relations
GeneratorsDescr
gd <- Getting GeneratorsDescr GroupPresentation GeneratorsDescr
-> GroupPresentation -> GeneratorsDescr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting GeneratorsDescr GroupPresentation GeneratorsDescr
Lens' GroupPresentation GeneratorsDescr
generatorsDescr
let generatorsFromGD :: Set Generator
generatorsFromGD = GeneratorsDescr -> Set Generator
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet GeneratorsDescr
gd
generatorsFromR :: Pair [Signed Generator] -> Set Generator
generatorsFromR = [Generator] -> Set Generator
forall c v. UnsafeListable c v => [v] -> c
fromList ([Generator] -> Set Generator)
-> (Pair [Signed Generator] -> [Generator])
-> Pair [Signed Generator]
-> Set Generator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Signed Generator -> Generator)
-> [Signed Generator] -> [Generator]
forall a b. (a -> b) -> [a] -> [b]
map Signed Generator -> Generator
forall a. Signed a -> a
unSigned ([Signed Generator] -> [Generator])
-> (Pair [Signed Generator] -> [Signed Generator])
-> Pair [Signed Generator]
-> [Generator]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
[Signed Generator]
([Signed Generator], [Signed Generator])
[Signed Generator]
-> ([Signed Generator], [Signed Generator]) -> [Signed Generator]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
[Signed Generator]
([Signed Generator], [Signed Generator])
[Signed Generator]
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (([Signed Generator], [Signed Generator]) -> [Signed Generator])
-> (Pair [Signed Generator]
-> ([Signed Generator], [Signed Generator]))
-> Pair [Signed Generator]
-> [Signed Generator]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair [Signed Generator] -> ([Signed Generator], [Signed Generator])
forall a. Pair a -> (a, a)
unPair
Set Generator -> GroupPresentation -> Set Generator
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Generator -> GroupPresentation -> Set Generator)
-> Set Generator -> GroupPresentation -> Set Generator
forall a b. (a -> b) -> a -> b
$ (Set Generator -> Set Generator -> Set Generator)
-> Set Generator -> [Set Generator] -> Set Generator
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set Generator -> Set Generator -> Set Generator
forall c. Operable c => c -> c -> c
(\/) Set Generator
generatorsFromGD ([Set Generator] -> Set Generator)
-> [Set Generator] -> Set Generator
forall a b. (a -> b) -> a -> b
$ Pair [Signed Generator] -> Set Generator
generatorsFromR (Pair [Signed Generator] -> Set Generator)
-> [Pair [Signed Generator]] -> [Set Generator]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relations -> [Pair [Signed Generator]]
forall c v. Listable c v => c -> [v]
toList Relations
rs
strGenerators :: GPGetter (Set String)
strGenerators :: (Set String -> f (Set String))
-> GroupPresentation -> f GroupPresentation
strGenerators = (GeneratorsDescr -> f GeneratorsDescr)
-> GroupPresentation -> f GroupPresentation
Lens' GroupPresentation GeneratorsDescr
generatorsDescr ((GeneratorsDescr -> f GeneratorsDescr)
-> GroupPresentation -> f GroupPresentation)
-> ((Set String -> f (Set String))
-> GeneratorsDescr -> f GeneratorsDescr)
-> (Set String -> f (Set String))
-> GroupPresentation
-> f GroupPresentation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneratorsDescr -> Set String)
-> (Set String -> f (Set String))
-> GeneratorsDescr
-> f GeneratorsDescr
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GeneratorsDescr -> Set String
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet