{-# LANGUAGE ForeignFunctionInterface #-}

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

module Sym.Perm.Pattern
    (
      Pattern
    , SubSeq
    , ordiso
    , choose
    , copiesOf
    , contains
    , avoids
    , avoidsAll
    , avoiders
    , minima
    , maxima
    , coeff
    ) where

import Sym.Perm (Perm, perms)
import Sym.Internal.SubSeq
import Sym.Internal.Util (nubSort)
import Foreign
import Foreign.C.Types
import System.IO.Unsafe

-- | Pattern is just an alias for permutation.
type Pattern = Perm

foreign import ccall unsafe "ordiso.h ordiso" c_ordiso
    :: Ptr CLong -> Ptr CLong -> Ptr CLong -> CLong -> CInt

-- | @ordiso u v m@ determines whether the subword in @v@ specified by
-- @m@ is order isomorphic to @u@.
ordiso :: Pattern -> Perm -> SubSeq -> Bool
ordiso :: Perm -> Perm -> Perm -> Bool
ordiso Perm
u Perm
v Perm
m =
    let k :: CLong
k = Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Perm -> Int
forall a. Size a => a -> Int
size Perm
u)
    in IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
       Perm -> (Ptr CLong -> IO Bool) -> IO Bool
forall a. Perm -> (Ptr CLong -> IO a) -> IO a
unsafeWith Perm
u ((Ptr CLong -> IO Bool) -> IO Bool)
-> (Ptr CLong -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
u' ->
       Perm -> (Ptr CLong -> IO Bool) -> IO Bool
forall a. Perm -> (Ptr CLong -> IO a) -> IO a
unsafeWith Perm
v ((Ptr CLong -> IO Bool) -> IO Bool)
-> (Ptr CLong -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
v' ->
       Perm -> (Ptr CLong -> IO Bool) -> IO Bool
forall a. Perm -> (Ptr CLong -> IO a) -> IO a
unsafeWith Perm
m ((Ptr CLong -> IO Bool) -> IO Bool)
-> (Ptr CLong -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
m' ->
           Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> (CInt -> Bool) -> CInt -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CInt -> IO Bool) -> CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr CLong -> Ptr CLong -> Ptr CLong -> CLong -> CInt
c_ordiso Ptr CLong
u' Ptr CLong
v' Ptr CLong
m' CLong
k
{-# INLINE ordiso #-}

-- | @copiesOf p w@ is the list of sets that represent copies of @p@ in @w@.
copiesOf :: Pattern -> Perm -> [SubSeq]
copiesOf :: Perm -> Perm -> [Perm]
copiesOf Perm
p Perm
w = (Perm -> Bool) -> [Perm] -> [Perm]
forall a. (a -> Bool) -> [a] -> [a]
filter (Perm -> Perm -> Perm -> Bool
ordiso Perm
p Perm
w) ([Perm] -> [Perm]) -> [Perm] -> [Perm]
forall a b. (a -> b) -> a -> b
$ Perm -> Int
forall a. Size a => a -> Int
size Perm
w Int -> Int -> [Perm]
`choose` Perm -> Int
forall a. Size a => a -> Int
size Perm
p
{-# INLINE copiesOf #-}

-- | @w `contains` p@ is a predicate determining if @w@ contains the pattern @p@.
contains :: Perm -> Pattern -> Bool
Perm
w contains :: Perm -> Perm -> Bool
`contains` Perm
p = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Perm
w Perm -> Perm -> Bool
`avoids` Perm
p

-- | @w `avoids` p@ is a predicate determining if @w@ avoids the pattern @p@.
avoids :: Perm -> Pattern -> Bool
Perm
w avoids :: Perm -> Perm -> Bool
`avoids` Perm
p = [Perm] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Perm] -> Bool) -> [Perm] -> Bool
forall a b. (a -> b) -> a -> b
$ Perm -> Perm -> [Perm]
copiesOf Perm
p Perm
w

-- | @w `avoidsAll` ps@ is a predicate determining if @w@ avoids the patterns @ps@.
avoidsAll :: Perm -> [Pattern] -> Bool
Perm
w avoidsAll :: Perm -> [Perm] -> Bool
`avoidsAll` [Perm]
ps = (Perm -> Bool) -> [Perm] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Perm
w Perm -> Perm -> Bool
`avoids`) [Perm]
ps

-- | @avoiders ps ws@ is the list of permutations in @ws@ avoiding the
-- patterns in @ps@.
avoiders :: [Pattern] -> [Perm] -> [Perm]
avoiders :: [Perm] -> [Perm] -> [Perm]
avoiders [Perm]
ps [Perm]
ws = ([Perm] -> Perm -> [Perm]) -> [Perm] -> [Perm] -> [Perm]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Perm -> [Perm] -> [Perm]) -> [Perm] -> Perm -> [Perm]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Perm -> [Perm] -> [Perm]
avoiders1) [Perm]
ws [Perm]
ps

-- @avoiders1 p ws@ is the list of permutations in @ws@ avoiding the
-- pattern @p@.
avoiders1 :: Pattern -> [Perm] -> [Perm]
avoiders1 :: Perm -> [Perm] -> [Perm]
avoiders1 Perm
_ [] = []
avoiders1 Perm
q vs :: [Perm]
vs@(Perm
v:[Perm]
_) = (Perm -> Bool) -> [Perm] -> [Perm]
forall a. (a -> Bool) -> [a] -> [a]
filter Perm -> Bool
avoids_q [Perm]
us [Perm] -> [Perm] -> [Perm]
forall a. [a] -> [a] -> [a]
++ (Perm -> Bool) -> [Perm] -> [Perm]
forall a. (a -> Bool) -> [a] -> [a]
filter (Perm -> Perm -> Bool
`avoids` Perm
q) [Perm]
ws
    where
      n :: Int
n = Perm -> Int
forall a. Size a => a -> Int
size Perm
v
      k :: Int
k = Perm -> Int
forall a. Size a => a -> Int
size Perm
q
      ([Perm]
us, [Perm]
ws) = (Perm -> Bool) -> [Perm] -> ([Perm], [Perm])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Perm
u -> Perm -> Int
forall a. Size a => a -> Int
size Perm
u Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) [Perm]
vs
      xs :: [Perm]
xs = Int
n Int -> Int -> [Perm]
`choose` Int
k
      avoids_q :: Perm -> Bool
avoids_q Perm
u = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Perm -> Bool) -> [Perm] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Perm -> Perm -> Perm -> Bool
ordiso Perm
q Perm
u) [Perm]
xs

-- | The set of minimal elements with respect to containment.  FIX: Poor
-- implementation
minima :: [Pattern] -> [Pattern]
minima :: [Perm] -> [Perm]
minima [Perm]
ws =
    case [Perm] -> [Perm]
forall a. Ord a => [a] -> [a]
nubSort [Perm]
ws of
      [] -> []
      (Perm
v:[Perm]
vs) -> Perm
v Perm -> [Perm] -> [Perm]
forall a. a -> [a] -> [a]
: [Perm] -> [Perm]
minima ([Perm] -> [Perm] -> [Perm]
avoiders [Perm
v] [Perm]
vs)

-- | The set of maximal elements with respect to containment. FIX: Poor
-- implementation
maxima :: [Pattern] -> [Pattern]
maxima :: [Perm] -> [Perm]
maxima [Perm]
ws =
    case [Perm] -> [Perm]
forall a. [a] -> [a]
reverse ([Perm] -> [Perm]
forall a. Ord a => [a] -> [a]
nubSort [Perm]
ws) of
      [] -> []
      (Perm
v:[Perm]
vs) -> Perm
v Perm -> [Perm] -> [Perm]
forall a. a -> [a] -> [a]
: [Perm] -> [Perm]
maxima ((Perm -> Bool) -> [Perm] -> [Perm]
forall a. (a -> Bool) -> [a] -> [a]
filter (Perm -> Perm -> Bool
avoids Perm
v) [Perm]
vs)

-- | @coeff f v@ is the coefficient of @v@ when expanding the
-- permutation statistic @f@ as a sum of permutations/patterns. See
-- Petter Brändén and Anders Claesson: Mesh patterns and the expansion
-- of permutation statistics as sums of permutation patterns, The
-- Electronic Journal of Combinatorics 18(2) (2011),
-- <http://www.combinatorics.org/ojs/index.php/eljc/article/view/v18i2p5>.
coeff :: (Pattern -> Int) -> Pattern -> Int
coeff :: (Perm -> Int) -> Perm -> Int
coeff Perm -> Int
f Perm
v = Perm -> Int
f Perm
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ (-Int
1)Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Perm -> Int
f Perm
u |
                        Int
j <- [Int
0 .. Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
                      , Perm
u <- Int -> [Perm]
perms Int
j
                      , let c :: Int
c = [Perm] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Perm] -> Int) -> [Perm] -> Int
forall a b. (a -> b) -> a -> b
$ Perm -> Perm -> [Perm]
copiesOf Perm
u Perm
v
                      , Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                      ] where k :: Int
k = Perm -> Int
forall a. Size a => a -> Int
size Perm
v