-- |
-- Copyright   : Anders Claesson 2013
-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
--
-- Sum, skew sum, etc
-- 

module Sym.Perm.Constructions
    (
      (/+/)
    , (\-\)
    , directSum
    , skewSum
    , inflate
    ) where

import Foreign
import System.IO.Unsafe
import Control.Monad
import Sym.Perm
import qualified Sym.Permgram as G
import qualified Sym.Perm.D8 as D8

infixl 6 /+/
infixl 6 \-\

-- | The /direct sum/ of two permutations.
(/+/) :: Perm -> Perm -> Perm
/+/ :: Perm -> Perm -> Perm
(/+/) Perm
u Perm
v =
   let k :: Int
k  = Perm -> Int
forall a. Size a => a -> Int
size Perm
u
       l :: Int
l  = Perm -> Int
forall a. Size a => a -> Int
size Perm
v
       v' :: Perm
v' = (Int -> CLong -> CLong) -> Perm -> Perm
imap (\Int
_ CLong
x -> CLong
x CLong -> CLong -> CLong
forall a. Num a => a -> a -> a
+ Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) Perm
v
   in IO Perm -> Perm
forall a. IO a -> a
unsafePerformIO (IO Perm -> Perm)
-> ((Ptr CLong -> IO ()) -> IO Perm)
-> (Ptr CLong -> IO ())
-> Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Ptr CLong -> IO ()) -> IO Perm
unsafeNew (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) ((Ptr CLong -> IO ()) -> Perm) -> (Ptr CLong -> IO ()) -> Perm
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
p ->
       let q :: Ptr CLong
q = Ptr CLong -> Int -> Ptr CLong
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr CLong
p Int
k
       in Perm -> (Ptr CLong -> IO ()) -> IO ()
forall a. Perm -> (Ptr CLong -> IO a) -> IO a
unsafeWith Perm
u  ((Ptr CLong -> IO ()) -> IO ()) -> (Ptr CLong -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
uPtr ->
          Perm -> (Ptr CLong -> IO ()) -> IO ()
forall a. Perm -> (Ptr CLong -> IO a) -> IO a
unsafeWith Perm
v' ((Ptr CLong -> IO ()) -> IO ()) -> (Ptr CLong -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
vPtr -> do
              Ptr CLong -> Ptr CLong -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr CLong
p Ptr CLong
uPtr Int
k
              Ptr CLong -> Ptr CLong -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr CLong
q Ptr CLong
vPtr Int
l

-- | The direct sum of a list of permutations.
directSum :: [Perm] -> Perm
directSum :: [Perm] -> Perm
directSum = (Perm -> Perm -> Perm) -> Perm -> [Perm] -> Perm
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Perm -> Perm -> Perm
(/+/) Perm
emptyperm

-- | The /skew sum/ of two permutations.
(\-\) :: Perm -> Perm -> Perm
\-\ :: Perm -> Perm -> Perm
(\-\) Perm
u Perm
v = Perm -> Perm
D8.complement (Perm -> Perm) -> Perm -> Perm
forall a b. (a -> b) -> a -> b
$ Perm -> Perm
D8.complement Perm
u Perm -> Perm -> Perm
/+/ Perm -> Perm
D8.complement Perm
v

-- | The skew sum of a list of permutations.
skewSum :: [Perm] -> Perm
skewSum :: [Perm] -> Perm
skewSum = (Perm -> Perm -> Perm) -> Perm -> [Perm] -> Perm
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Perm -> Perm -> Perm
(\-\) Perm
emptyperm

-- | @inflate w vs@ is the /inflation/ of @w@ by @vs@. It is the
-- permutation of length @sum (map size vs)@ obtained by replacing
-- each entry @w!i@ by an interval that is order isomorphic to @vs!i@
-- in such a way that the intervals are order isomorphic to @w@. In
-- particular,
-- 
-- > u /+/ v == inflate (mkPerm "12") [u,v]
-- > u \-\ v == inflate (mkPerm "21") [u,v]
-- 
inflate :: Perm -> [Perm] -> Perm
inflate :: Perm -> [Perm] -> Perm
inflate Perm
w = Permgram () -> Perm
forall a. Permgram a -> Perm
G.perm (Permgram () -> Perm) -> ([Perm] -> Permgram ()) -> [Perm] -> Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permgram (Permgram ()) -> Permgram ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Permgram (Permgram ()) -> Permgram ())
-> ([Perm] -> Permgram (Permgram ())) -> [Perm] -> Permgram ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perm -> [Permgram ()] -> Permgram (Permgram ())
forall a. Perm -> [a] -> Permgram a
G.permgram Perm
w ([Permgram ()] -> Permgram (Permgram ()))
-> ([Perm] -> [Permgram ()]) -> [Perm] -> Permgram (Permgram ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Perm -> Permgram ()) -> [Perm] -> [Permgram ()]
forall a b. (a -> b) -> [a] -> [b]
map (Perm -> [()] -> Permgram ()
forall a. Perm -> [a] -> Permgram a
`G.permgram` [()])