{-# language Unsafe #-}
-- |
-- Module       : Data.Group.Free.Internal
-- Copyright    : (c) 2020-2021 Reed Mullanix, Emily Pillmore, Koji Miyazato
-- License      : BSD-style
--
-- Maintainer   : Reed Mullanix <reedmullanix@gmail.com>,
--                Emily Pillmore <emilypi@cohomolo.gy>
--
-- Stability    : stable
-- Portability  : non-portable
--
-- This module exposes internals of 'FreeAbelianGroup'.
--
module Data.Group.Free.Internal
( -- * Free abelian groups
  FreeAbelianGroup(..)
) where


import Data.Map (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Map.Merge.Strict as Map

import Data.Semigroup(Semigroup(..))
import Data.Group
import Data.Group.Order


-- $setup
--
-- >>> import qualified Prelude
-- >>> import Data.Group
-- >>> import Data.Monoid
-- >>> import Data.Semigroup
-- >>> import Data.Word
-- >>> :set -XTypeApplications
-- >>> :set -XFlexibleContexts

-- | A representation of a free abelian group over an alphabet @a@.
--
-- The intuition here is group elements correspond with their positive
-- or negative multiplicities, and as such are simplified by construction.
--
-- === __Examples__:
--
-- >>> let single a = MkFreeAbelianGroup $ Map.singleton a 1
-- >>> a = single 'a'
-- >>> b = single 'b'
-- >>> a
-- FreeAbelianGroup $ fromList [('a',1)]
-- >>> a <> b
-- FreeAbelianGroup $ fromList [('a',1),('b',1)]
-- >>> a <> b == b <> a
-- True
-- >>> invert a
-- FreeAbelianGroup $ fromList [('a',-1)]
-- >>> a <> b <> invert a
-- FreeAbelianGroup $ fromList [('b',1)]
-- >>> gtimes 5 (a <> b)
-- FreeAbelianGroup $ fromList [('a',5),('b',5)]
--
newtype FreeAbelianGroup a =
  MkFreeAbelianGroup (Map a Integer)
    -- ^ Unsafe "raw" constructor, which does not do normalization work.
    -- Please use 'Data.Group.Free.mkFreeAbelianGroup' as it normalizes.
    --
  deriving (FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
(FreeAbelianGroup a -> FreeAbelianGroup a -> Bool)
-> (FreeAbelianGroup a -> FreeAbelianGroup a -> Bool)
-> Eq (FreeAbelianGroup a)
forall a. Eq a => FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
$c/= :: forall a. Eq a => FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
== :: FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
$c== :: forall a. Eq a => FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
Eq, Eq (FreeAbelianGroup a)
Eq (FreeAbelianGroup a)
-> (FreeAbelianGroup a -> FreeAbelianGroup a -> Ordering)
-> (FreeAbelianGroup a -> FreeAbelianGroup a -> Bool)
-> (FreeAbelianGroup a -> FreeAbelianGroup a -> Bool)
-> (FreeAbelianGroup a -> FreeAbelianGroup a -> Bool)
-> (FreeAbelianGroup a -> FreeAbelianGroup a -> Bool)
-> (FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a)
-> (FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a)
-> Ord (FreeAbelianGroup a)
FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
FreeAbelianGroup a -> FreeAbelianGroup a -> Ordering
FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (FreeAbelianGroup a)
forall a. Ord a => FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
forall a.
Ord a =>
FreeAbelianGroup a -> FreeAbelianGroup a -> Ordering
forall a.
Ord a =>
FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a
min :: FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a
$cmin :: forall a.
Ord a =>
FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a
max :: FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a
$cmax :: forall a.
Ord a =>
FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a
>= :: FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
$c>= :: forall a. Ord a => FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
> :: FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
$c> :: forall a. Ord a => FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
<= :: FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
$c<= :: forall a. Ord a => FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
< :: FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
$c< :: forall a. Ord a => FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
compare :: FreeAbelianGroup a -> FreeAbelianGroup a -> Ordering
$ccompare :: forall a.
Ord a =>
FreeAbelianGroup a -> FreeAbelianGroup a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (FreeAbelianGroup a)
Ord)

instance Show a => Show (FreeAbelianGroup a) where
    showsPrec :: Int -> FreeAbelianGroup a -> ShowS
showsPrec Int
p (MkFreeAbelianGroup Map a Integer
g) =
        Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String
"FreeAbelianGroup $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Integer -> ShowS
forall a. Show a => a -> ShowS
shows Map a Integer
g

instance (Ord a) => Semigroup (FreeAbelianGroup a) where
    (MkFreeAbelianGroup Map a Integer
g) <> :: FreeAbelianGroup a -> FreeAbelianGroup a -> FreeAbelianGroup a
<> (MkFreeAbelianGroup Map a Integer
g') =
      Map a Integer -> FreeAbelianGroup a
forall a. Map a Integer -> FreeAbelianGroup a
MkFreeAbelianGroup (Map a Integer -> FreeAbelianGroup a)
-> Map a Integer -> FreeAbelianGroup a
forall a b. (a -> b) -> a -> b
$ Map a Integer -> Map a Integer -> Map a Integer
mergeG Map a Integer
g Map a Integer
g'
      where
        mergeG :: Map a Integer -> Map a Integer -> Map a Integer
mergeG = SimpleWhenMissing a Integer Integer
-> SimpleWhenMissing a Integer Integer
-> SimpleWhenMatched a Integer Integer Integer
-> Map a Integer
-> Map a Integer
-> Map a Integer
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
          SimpleWhenMissing a Integer Integer
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
          SimpleWhenMissing a Integer Integer
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
          ((a -> Integer -> Integer -> Maybe Integer)
-> SimpleWhenMatched a Integer Integer Integer
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched ((a -> Integer -> Integer -> Maybe Integer)
 -> SimpleWhenMatched a Integer Integer Integer)
-> (a -> Integer -> Integer -> Maybe Integer)
-> SimpleWhenMatched a Integer Integer Integer
forall a b. (a -> b) -> a -> b
$ \a
_ Integer
m Integer
n -> Integer -> Maybe Integer
forall a. (Eq a, Num a) => a -> Maybe a
nonZero (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n)
        nonZero :: a -> Maybe a
nonZero a
n = if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
n

    stimes :: b -> FreeAbelianGroup a -> FreeAbelianGroup a
stimes = (FreeAbelianGroup a -> b -> FreeAbelianGroup a)
-> b -> FreeAbelianGroup a -> FreeAbelianGroup a
forall a b c. (a -> b -> c) -> b -> a -> c
flip FreeAbelianGroup a -> b -> FreeAbelianGroup a
forall m x. (Group m, Integral x) => m -> x -> m
pow

instance (Ord a) => Monoid (FreeAbelianGroup a) where
    mempty :: FreeAbelianGroup a
mempty = Map a Integer -> FreeAbelianGroup a
forall a. Map a Integer -> FreeAbelianGroup a
MkFreeAbelianGroup Map a Integer
forall k a. Map k a
Map.empty

instance (Ord a) => Group (FreeAbelianGroup a) where
    invert :: FreeAbelianGroup a -> FreeAbelianGroup a
invert (MkFreeAbelianGroup Map a Integer
g) = Map a Integer -> FreeAbelianGroup a
forall a. Map a Integer -> FreeAbelianGroup a
MkFreeAbelianGroup (Map a Integer -> FreeAbelianGroup a)
-> Map a Integer -> FreeAbelianGroup a
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Map a Integer -> Map a Integer
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Integer -> Integer
forall a. Num a => a -> a
negate Map a Integer
g

    pow :: FreeAbelianGroup a -> x -> FreeAbelianGroup a
pow FreeAbelianGroup a
_ x
0 = FreeAbelianGroup a
forall a. Monoid a => a
mempty
    pow (MkFreeAbelianGroup Map a Integer
g) x
n
      | x
n x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
0    = FreeAbelianGroup a
forall a. Monoid a => a
mempty
      | Bool
otherwise = Map a Integer -> FreeAbelianGroup a
forall a. Map a Integer -> FreeAbelianGroup a
MkFreeAbelianGroup (Map a Integer -> FreeAbelianGroup a)
-> Map a Integer -> FreeAbelianGroup a
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Map a Integer -> Map a Integer
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (x -> Integer
forall a. Integral a => a -> Integer
toInteger x
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*) Map a Integer
g

instance (Ord a) => Abelian (FreeAbelianGroup a)

instance (Ord a) => GroupOrder (FreeAbelianGroup a) where
    order :: FreeAbelianGroup a -> Order
order FreeAbelianGroup a
g | FreeAbelianGroup a
g FreeAbelianGroup a -> FreeAbelianGroup a -> Bool
forall a. Eq a => a -> a -> Bool
== FreeAbelianGroup a
forall a. Monoid a => a
mempty = Natural -> Order
Finite Natural
1
            | Bool
otherwise   = Order
Infinite