{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

-- |
-- Copyright   : Anders Claesson 2013
-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
--

module Sym
    (
      Permutation(..)
    , perms
    , lift
    , lift2
    ) where

import Data.Ord
import Sym.Perm.SSYT (SSYTPair (..))
import qualified Sym.Perm.SSYT as Y
import Data.List
import Sym.Perm.Meta (Perm)
import qualified Sym.Perm.Meta as P
import qualified Sym.Perm.D8 as D8


-- The permutation typeclass
-- -------------------------

-- | The class of permutations. Minimal complete definition: 'st',
-- 'act' and 'idperm'. The default implementation of 'size' can be
-- somewhat slow, so you may want to implement it as well.
class Permutation a where

    -- | The standardization map. If there is an underlying linear
    -- order on @a@ then @st@ is determined by the unique order
    -- preserving map from @[0..]@ to that order. In any case, the
    -- standardization map should be equivariant with respect to the
    -- group action defined below; i.e., it should hold that
    -- 
    -- > st (u `act` v) == u `act` st v
    -- 
    st :: a -> Perm

    -- | A (left) /group action/ of 'Perm' on @a@. As for any group
    -- action it should hold that
    -- 
    -- > (u `act` v) `act` w == u `act` (v `act` w)   &&   idperm n `act` v == v
    -- 
    -- where @v,w::a@ and @u::Perm@ are of size @n@.
    act :: Perm -> a -> a

    -- | The size of a permutation. The default implementation derived from
    -- 
    -- > size == size . st
    -- 
    -- This is not a circular definition as 'size' on 'Perm' is
    -- implemented independently. If the implementation of 'st' is
    -- slow, then it can be worth while to override the standard
    -- definiton; any implementation should, however, satisfy the
    -- identity above.
    {-# INLINE size #-}
    size :: a -> Int
    size = Perm -> Int
forall a. Size a => a -> Int
P.size (Perm -> Int) -> (a -> Perm) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Perm
forall a. Permutation a => a -> Perm
st

    -- | The identity permutation of the given size.
    idperm :: Int -> a

    -- | The group theoretical inverse. It should hold that
    -- 
    -- > inverse == unst . inverse . st
    -- 
    -- and this is the default implementation.
    {-# INLINE inverse #-}
    inverse :: a -> a
    inverse = Perm -> a
forall a. Permutation a => Perm -> a
unst (Perm -> a) -> (a -> Perm) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perm -> Perm
D8.inverse (Perm -> Perm) -> (a -> Perm) -> a -> Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Perm
forall a. Permutation a => a -> Perm
st

    -- | Predicate determining if two permutations are
    -- order-isomorphic. The default implementation uses
    -- 
    -- > u `ordiso` v  ==  u == st v
    -- 
    -- Equivalently, one could use
    -- 
    -- > u `ordiso` v  ==  inverse u `act` v == idperm (size u)
    -- 
    {-# INLINE ordiso #-}
    ordiso :: Perm -> a -> Bool
    ordiso Perm
u a
v = Perm
u Perm -> Perm -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Perm
forall a. Permutation a => a -> Perm
st a
v

    -- | The inverse of 'st'. It should hold that
    -- 
    -- > unst w == w `act` idperm (P.size w)
    -- 
    -- and this is the default implementation.
    unst :: Perm -> a
    unst Perm
w = Perm
w Perm -> a -> a
forall a. Permutation a => Perm -> a -> a
`act` Int -> a
forall a. Permutation a => Int -> a
idperm (Perm -> Int
forall a. Size a => a -> Int
P.size Perm
w)

instance Permutation Perm where
    st :: Perm -> Perm
st       = Perm -> Perm
forall a. a -> a
id
    act :: Perm -> Perm -> Perm
act      = Perm -> Perm -> Perm
P.act
    idperm :: Int -> Perm
idperm   = Int -> Perm
P.idperm
    inverse :: Perm -> Perm
inverse  = Perm -> Perm
D8.inverse
    ordiso :: Perm -> Perm -> Bool
ordiso   = Perm -> Perm -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    unst :: Perm -> Perm
unst     = Perm -> Perm
forall a. a -> a
id

-- | A String viewed as a permutation of its characters. The alphabet
-- is ordered as
-- 
-- > ['1'..'9'] ++ ['A'..'Z'] ++ ['a'..]
-- 
instance Permutation String where
    st :: String -> Perm
st       = String -> Perm
forall a. Ord a => [a] -> Perm
P.mkPerm
    act :: Perm -> String -> String
act Perm
v    = ((Int, Char) -> Char) -> [(Int, Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int, Char) -> Char
forall a b. (a, b) -> b
snd ([(Int, Char)] -> String)
-> (String -> [(Int, Char)]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Char) -> (Int, Char) -> Ordering)
-> [(Int, Char)] -> [(Int, Char)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, Char) -> Int) -> (Int, Char) -> (Int, Char) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, Char) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Char)] -> [(Int, Char)])
-> (String -> [(Int, Char)]) -> String -> [(Int, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Perm -> [Int]
P.toList (Perm -> Perm
D8.inverse Perm
v))
    size :: String -> Int
size     = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
    idperm :: Int -> String
idperm Int
n = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [Char
'1'..Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a'..]

instance Permutation SSYTPair where
    st :: SSYTPair -> Perm
st = SSYTPair -> Perm
Y.toPerm
    unst :: Perm -> SSYTPair
unst = Perm -> SSYTPair
Y.fromPerm
    Perm
u act :: Perm -> SSYTPair -> SSYTPair
`act` SSYTPair
v = Perm -> SSYTPair
forall a. Permutation a => Perm -> a
unst (Perm -> SSYTPair) -> Perm -> SSYTPair
forall a b. (a -> b) -> a -> b
$ Perm
u Perm -> Perm -> Perm
forall a. Permutation a => Perm -> a -> a
`act` SSYTPair -> Perm
forall a. Permutation a => a -> Perm
st SSYTPair
v
    size :: SSYTPair -> Int
size (SSYTPair SSYT
p SSYT
_) = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Int] -> Int) -> SSYT -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SSYT
p
    idperm :: Int -> SSYTPair
idperm Int
n = SSYT -> SSYT -> SSYTPair
SSYTPair SSYT
p SSYT
p where p :: SSYT
p = [[Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
    inverse :: SSYTPair -> SSYTPair
inverse (SSYTPair SSYT
p SSYT
q) = SSYT -> SSYT -> SSYTPair
SSYTPair SSYT
q SSYT
p

-- | The list of all permutations of the given size.
perms :: Permutation a => Int -> [a]
perms :: forall a. Permutation a => Int -> [a]
perms = (Perm -> a) -> [Perm] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> a
forall a. Permutation a => Perm -> a
unst ([Perm] -> [a]) -> (Int -> [Perm]) -> Int -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
P.perms

-- | Lifts a function on 'Perm's to one on any permutations.
lift :: (Permutation a) => (Perm -> Perm) -> a -> a
lift :: forall a. Permutation a => (Perm -> Perm) -> a -> a
lift Perm -> Perm
f = Perm -> a
forall a. Permutation a => Perm -> a
unst (Perm -> a) -> (a -> Perm) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perm -> Perm
f (Perm -> Perm) -> (a -> Perm) -> a -> Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Perm
forall a. Permutation a => a -> Perm
st

-- | Like 'lift' but for functions of two variables.
lift2 :: (Permutation a) => (Perm -> Perm -> Perm) -> a -> a -> a
lift2 :: forall a. Permutation a => (Perm -> Perm -> Perm) -> a -> a -> a
lift2 Perm -> Perm -> Perm
f a
u a
v = Perm -> a
forall a. Permutation a => Perm -> a
unst (Perm -> a) -> Perm -> a
forall a b. (a -> b) -> a -> b
$ Perm -> Perm -> Perm
f (a -> Perm
forall a. Permutation a => a -> Perm
st a
u) (a -> Perm
forall a. Permutation a => a -> Perm
st a
v)