module GP2SR (
    gp2sr,
    gp2sr',
  ) where

import qualified GroupPresentation as GP
import GroupPresentation (
    GroupPresentation,
    relations,
    generatorsDescr,
    Signed (Positive, Negative)
  )
import qualified StringRewriting as SR
import StringRewriting.KnuthBendix (StringRewriting, Order, knuthBendixBy)
import Containers
import Lens

gen :: GP.Element -> SR.Generator
gen :: Element -> Generator
gen (Positive Generator
g) = Int -> Generator
SR.generator (Int -> Generator) -> Int -> Generator
forall a b. (a -> b) -> a -> b
$ Generator -> Int
GP.numGenerator Generator
g Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
gen (Negative Generator
g) = Int -> Generator
SR.generator (Int -> Generator) -> Int -> Generator
forall a b. (a -> b) -> a -> b
$ Generator -> Int
GP.numGenerator Generator
g Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

genOrder :: Order GP.Element -> Order SR.Generator
genOrder :: Order Element -> Order Generator
genOrder = (Order Element -> (Generator -> Element) -> Order Generator
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on`
    (\Int
n ->
        if Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Generator -> Element
forall a. a -> Signed a
Positive (Generator -> Element) -> Generator -> Element
forall a b. (a -> b) -> a -> b
$ Int -> Generator
GP.generator (Int -> Generator) -> Int -> Generator
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        else Generator -> Element
forall a. a -> Signed a
Negative (Generator -> Element) -> Generator -> Element
forall a b. (a -> b) -> a -> b
$ Int -> Generator
GP.generator (Int -> Generator) -> Int -> Generator
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
      ) (Int -> Element) -> (Generator -> Int) -> Generator -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Generator -> Int
SR.numGenerator
  )

gd :: GP.GeneratorsDescr -> SR.GeneratorsDescr
gd :: GeneratorsDescr -> GeneratorsDescr
gd GeneratorsDescr
gdIni = [(Generator, [Char])] -> GeneratorsDescr
forall c v. UnsafeListable c v => [v] -> c
fromList ([(Generator, [Char])] -> GeneratorsDescr)
-> [(Generator, [Char])] -> GeneratorsDescr
forall a b. (a -> b) -> a -> b
$
    (((Generator -> Identity Generator)
-> (Generator, [Char]) -> Identity (Generator, [Char])
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Generator -> Identity Generator)
 -> (Generator, [Char]) -> Identity (Generator, [Char]))
-> (Generator -> Generator)
-> (Generator, [Char])
-> (Generator, [Char])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Element -> Generator
gen(Element -> Generator)
-> (Generator -> Element) -> Generator -> Generator
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Generator -> Element
forall a. a -> Signed a
Positive)) ((Generator, [Char]) -> (Generator, [Char]))
-> [(Generator, [Char])] -> [(Generator, [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GeneratorsDescr -> [(Generator, [Char])]
forall c v. Listable c v => c -> [v]
toList GeneratorsDescr
gdIni) [(Generator, [Char])]
-> [(Generator, [Char])] -> [(Generator, [Char])]
forall a. [a] -> [a] -> [a]
++
    (((Generator -> Identity Generator)
-> (Generator, [Char]) -> Identity (Generator, [Char])
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Generator -> Identity Generator)
 -> (Generator, [Char]) -> Identity (Generator, [Char]))
-> (Generator -> Generator)
-> (Generator, [Char])
-> (Generator, [Char])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Element -> Generator
gen(Element -> Generator)
-> (Generator -> Element) -> Generator -> Generator
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Generator -> Element
forall a. a -> Signed a
Negative)) ((Generator, [Char]) -> (Generator, [Char]))
-> ((Generator, [Char]) -> (Generator, [Char]))
-> (Generator, [Char])
-> (Generator, [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Char] -> Identity [Char])
-> (Generator, [Char]) -> Identity (Generator, [Char])
forall s t a b. Field2 s t a b => Lens s t a b
_2 (([Char] -> Identity [Char])
 -> (Generator, [Char]) -> Identity (Generator, [Char]))
-> ([Char] -> [Char]) -> (Generator, [Char]) -> (Generator, [Char])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"^-1")) ((Generator, [Char]) -> (Generator, [Char]))
-> [(Generator, [Char])] -> [(Generator, [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GeneratorsDescr -> [(Generator, [Char])]
forall c v. Listable c v => c -> [v]
toList GeneratorsDescr
gdIni)

gp2sr ::
    MonadFail m =>
    Order GP.Element ->
    GroupPresentation ->
    m StringRewriting
gp2sr :: Order Element -> GroupPresentation -> m StringRewriting
gp2sr Order Element
eo GroupPresentation
gp = StringRewriting -> m StringRewriting
forall (m :: * -> *) a. Monad m => a -> m a
return (StringRewriting -> m StringRewriting)
-> StringRewriting -> m StringRewriting
forall a b. (a -> b) -> a -> b
$
    Order Generator
-> Set (Pair GWord) -> GeneratorsDescr -> StringRewriting
knuthBendixBy
        (Order Element -> Order Generator
genOrder Order Element
eo)
        (((Pair [Element] -> Pair GWord) -> Relations -> Set (Pair GWord)
forall c1 c2 v1 v2. Gunctor c1 c2 v1 v2 => (v1 -> v2) -> c1 -> c2
gmap((Pair [Element] -> Pair GWord) -> Relations -> Set (Pair GWord))
-> ((Element -> Generator) -> Pair [Element] -> Pair GWord)
-> (Element -> Generator)
-> Relations
-> Set (Pair GWord)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Element] -> GWord) -> Pair [Element] -> Pair GWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(([Element] -> GWord) -> Pair [Element] -> Pair GWord)
-> ((Element -> Generator) -> [Element] -> GWord)
-> (Element -> Generator)
-> Pair [Element]
-> Pair GWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Element -> Generator) -> [Element] -> GWord
forall a b. (a -> b) -> [a] -> [b]
map) Element -> Generator
gen (Relations -> Set (Pair GWord)) -> Relations -> Set (Pair GWord)
forall a b. (a -> b) -> a -> b
$ GroupPresentation
gpGroupPresentation
-> Getting Relations GroupPresentation Relations -> Relations
forall s a. s -> Getting a s a -> a
^.Getting Relations GroupPresentation Relations
Lens' GroupPresentation Relations
relations)
        (GeneratorsDescr -> GeneratorsDescr
gd (GroupPresentation
gpGroupPresentation
-> Getting GeneratorsDescr GroupPresentation GeneratorsDescr
-> GeneratorsDescr
forall s a. s -> Getting a s a -> a
^.Getting GeneratorsDescr GroupPresentation GeneratorsDescr
Lens' GroupPresentation GeneratorsDescr
generatorsDescr))

gp2sr' :: MonadFail m => GroupPresentation -> m StringRewriting
gp2sr' :: GroupPresentation -> m StringRewriting
gp2sr' = Order Element -> GroupPresentation -> m StringRewriting
forall (m :: * -> *).
MonadFail m =>
Order Element -> GroupPresentation -> m StringRewriting
gp2sr Order Element
forall a. Ord a => a -> a -> Ordering
compare