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

module Sym.Perm.Class
    (
      inc
    , dec
    , av1
    , av12
    , av21
    , av123
    , av132
    , av213
    , av231
    , av312
    , av321
    , av1243
    , av1324
    , av2134
    , av
    , vee
    , caret
    , gt
    , lt
    , wedges
    , separables
    , kLayered
    , layered
    , kFibonacci
    , fibonacci
    ) where

import Sym.Internal.Util
import Sym.Perm
import Sym.Perm.Bijection
import Sym.Perm.Constructions
import Sym.Perm.Pattern
import qualified Sym.Perm.D8 as D8

-- | The class of increasing permutations.
inc :: Int -> [Perm]
inc :: Int -> [Perm]
inc = Int -> [Perm]
av21

-- | The class of decreasing permutations.
dec :: Int -> [Perm]
dec :: Int -> [Perm]
dec = Int -> [Perm]
av12

-- | Av(1)
av1 :: Int -> [Perm]
av1 :: Int -> [Perm]
av1 Int
0 = [Perm
emptyperm]
av1 Int
_ = []

-- | Av(12)
av12 :: Int -> [Perm]
av12 :: Int -> [Perm]
av12 Int
n = [Int -> Perm
ebb Int
n]

-- | Av(21)
av21 :: Int -> [Perm]
av21 :: Int -> [Perm]
av21 Int
n = [Int -> Perm
idperm Int
n]

-- | Av(123)
av123 :: Int -> [Perm]
av123 :: Int -> [Perm]
av123 = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
simionSchmidt' ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
av132

-- | Av(132)
av132 :: Int -> [Perm]
av132 :: Int -> [Perm]
av132 = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.reverse ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
av231

-- | Av(213)
av213 :: Int -> [Perm]
av213 :: Int -> [Perm]
av213 = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.complement ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
av231

-- | Av(231); also know as the stack sortable permutations.
av231 :: Int -> [Perm]
av231 :: Int -> [Perm]
av231 Int
0 = [Perm
emptyperm]
av231 Int
n = do
  Int
k <- [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  Perm
s <- [[Perm]]
streamAv231 [[Perm]] -> Int -> [Perm]
forall a. HasCallStack => [a] -> Int -> a
!! Int
k
  Perm
t <- [[Perm]]
streamAv231 [[Perm]] -> Int -> [Perm]
forall a. HasCallStack => [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  Perm -> [Perm]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Perm -> [Perm]) -> Perm -> [Perm]
forall a b. (a -> b) -> a -> b
$ Perm
s Perm -> Perm -> Perm
/+/ (Perm
one Perm -> Perm -> Perm
\-\ Perm
t)

streamAv231 :: [[Perm]]
streamAv231 :: [[Perm]]
streamAv231 = (Int -> [Perm]) -> [Int] -> [[Perm]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Perm]
av231 [Int
0..]

-- | Av(312)
av312 :: Int -> [Perm]
av312 :: Int -> [Perm]
av312 = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.inverse ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
av231

-- | Av(321)
av321 :: Int -> [Perm]
av321 :: Int -> [Perm]
av321 = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.complement ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
av123

-- | Av(1243)
av1243 :: Int -> [Perm]
av1243 :: Int -> [Perm]
av1243 Int
n = [Perm] -> [Perm] -> [Perm]
avoiders [[Int] -> Perm
fromList [Int
0,Int
1,Int
3,Int
2]] (Int -> [Perm]
perms Int
n)

-- | Av(1324)
av1324 :: Int -> [Perm]
av1324 :: Int -> [Perm]
av1324 Int
n = [Perm] -> [Perm] -> [Perm]
avoiders [[Int] -> Perm
fromList [Int
0,Int
2,Int
1,Int
3]] (Int -> [Perm]
perms Int
n)

-- | Av(2134)
av2134 :: Int -> [Perm]
av2134 :: Int -> [Perm]
av2134 Int
n = [Perm] -> [Perm] -> [Perm]
avoiders [[Int] -> Perm
fromList [Int
1,Int
0,Int
2,Int
3]] (Int -> [Perm]
perms Int
n)

-- | Av(s) where s is a string of one or more patterns, using space as a
-- seperator.
av :: String -> Int -> [Perm]
av :: String -> Int -> [Perm]
av String
s = [Perm] -> [Perm] -> [Perm]
avoiders ((String -> Perm) -> [String] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map String -> Perm
forall a. Ord a => [a] -> Perm
mkPerm (String -> [String]
words String
s)) ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
perms

-- | The V-class is Av(132, 231). It is so named because the diagram of
-- a typical permutation in this class is shaped like a V.
vee :: Int -> [Perm]
vee :: Int -> [Perm]
vee = ([[Perm]]
streamVee [[Perm]] -> Int -> [Perm]
forall a. HasCallStack => [a] -> Int -> a
!!)

streamVee :: [[Perm]]
streamVee :: [[Perm]]
streamVee = [Perm
emptyperm] [Perm] -> [[Perm]] -> [[Perm]]
forall a. a -> [a] -> [a]
: [Perm
one] [Perm] -> [[Perm]] -> [[Perm]]
forall a. a -> [a] -> [a]
: ([Perm] -> [Perm] -> [Perm]) -> [[Perm]] -> [[Perm]] -> [[Perm]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Perm] -> [Perm] -> [Perm]
forall a. [a] -> [a] -> [a]
(++) [[Perm]]
vee_n [[Perm]]
n_vee
    where
      n_vee :: [[Perm]]
n_vee = (([Perm] -> [Perm]) -> [[Perm]] -> [[Perm]]
forall a b. (a -> b) -> [a] -> [b]
map(([Perm] -> [Perm]) -> [[Perm]] -> [[Perm]])
-> ((Perm -> Perm) -> [Perm] -> [Perm])
-> (Perm -> Perm)
-> [[Perm]]
-> [[Perm]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map) (Perm
one Perm -> Perm -> Perm
\-\) [[Perm]]
ws
      vee_n :: [[Perm]]
vee_n = (([Perm] -> [Perm]) -> [[Perm]] -> [[Perm]]
forall a b. (a -> b) -> [a] -> [b]
map(([Perm] -> [Perm]) -> [[Perm]] -> [[Perm]])
-> ((Perm -> Perm) -> [Perm] -> [Perm])
-> (Perm -> Perm)
-> [[Perm]]
-> [[Perm]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map) (Perm -> Perm -> Perm
/+/ Perm
one) [[Perm]]
ws
      ws :: [[Perm]]
ws    = [[Perm]] -> [[Perm]]
forall a. HasCallStack => [a] -> [a]
tail [[Perm]]
streamVee

-- | The ∧-class is Av(213, 312). It is so named because the diagram of
-- a typical permutation in this class is shaped like a ∧.
caret :: Int -> [Perm]
caret :: Int -> [Perm]
caret = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.complement ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
vee

-- | The >-class is Av(132, 312). It is so named because the diagram of
-- a typical permutation in this class is shaped like a >.
gt :: Int -> [Perm]
gt :: Int -> [Perm]
gt = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.rotate ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
vee

-- | The <-class is Av(213, 231). It is so named because the diagram of
-- a typical permutation in this class is shaped like a <.
lt :: Int -> [Perm]
lt :: Int -> [Perm]
lt = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.reverse ([Perm] -> [Perm]) -> (Int -> [Perm]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Perm]
gt

union :: [Int -> [Perm]] -> Int -> [Perm]
union :: [Int -> [Perm]] -> Int -> [Perm]
union [Int -> [Perm]]
cs Int
n = [Perm] -> [Perm]
forall a. Ord a => [a] -> [a]
nubSort ([Perm] -> [Perm]) -> [Perm] -> [Perm]
forall a b. (a -> b) -> a -> b
$ [[Perm]] -> [Perm]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> [Perm]
c Int
n | Int -> [Perm]
c <- [Int -> [Perm]]
cs ]

-- | The union of 'vee', 'caret', 'gt' and 'lt'.
wedges :: Int -> [Perm]
wedges :: Int -> [Perm]
wedges = [Int -> [Perm]] -> Int -> [Perm]
union [Int -> [Perm]
vee, Int -> [Perm]
caret, Int -> [Perm]
gt, Int -> [Perm]
lt]

compositions :: Int -> Int -> [[Int]]
compositions :: Int -> Int -> [[Int]]
compositions Int
0 Int
0 = [[]]
compositions Int
0 Int
_ = []
compositions Int
_ Int
0 = []
compositions Int
k Int
n = [Int
1..Int
n] [Int] -> (Int -> [[Int]]) -> [[Int]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (Int -> Int -> [[Int]]
compositions (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))

boundedCompositions :: Int -> Int -> Int -> [[Int]]
boundedCompositions :: Int -> Int -> Int -> [[Int]]
boundedCompositions Int
_ Int
0 Int
0 = [[]]
boundedCompositions Int
_ Int
0 Int
_ = []
boundedCompositions Int
_ Int
_ Int
0 = []
boundedCompositions Int
b Int
k Int
n = [Int
1..Int
b] [Int] -> (Int -> [[Int]]) -> [[Int]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (Int -> Int -> Int -> [[Int]]
boundedCompositions Int
b (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))

-- | The class of separable permutations; it is identical to Av(2413,3142).
separables :: Int -> [Perm]
separables :: Int -> [Perm]
separables Int
0 = [Perm
emptyperm]
separables Int
1 = [Perm
one]
separables Int
n = Int -> [Perm]
pIndec Int
n [Perm] -> [Perm] -> [Perm]
forall a. [a] -> [a] -> [a]
++ Int -> [Perm]
mIndec Int
n
    where
      comps :: Int -> [[Int]]
comps  Int
m = [Int
2..Int
m] [Int] -> (Int -> [[Int]]) -> [[Int]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
k -> Int -> Int -> [[Int]]
compositions Int
k Int
m
      pIndec :: Int -> [Perm]
pIndec Int
0 = []
      pIndec Int
1 = [Perm
one]
      pIndec Int
m = Int -> [[Int]]
comps Int
m [[Int]] -> ([Int] -> [Perm]) -> [Perm]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Perm] -> Perm) -> [[Perm]] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map [Perm] -> Perm
skewSum ([[Perm]] -> [Perm]) -> ([Int] -> [[Perm]]) -> [Int] -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Perm]) -> [Int] -> [[Perm]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([[Perm]]
streamMIndec [[Perm]] -> Int -> [Perm]
forall a. HasCallStack => [a] -> Int -> a
!!)
      mIndec :: Int -> [Perm]
mIndec Int
m = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.complement ([Perm] -> [Perm]) -> [Perm] -> [Perm]
forall a b. (a -> b) -> a -> b
$ Int -> [Perm]
pIndec Int
m
      streamMIndec :: [[Perm]]
streamMIndec = (Int -> [Perm]) -> [Int] -> [[Perm]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Perm]
mIndec [Int
0..]

-- | The class of layered permutations with /k/ layers.
kLayered :: Int -> Int -> [Perm]
kLayered :: Int -> Int -> [Perm]
kLayered Int
k = ([Int] -> Perm) -> [[Int]] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map ([Perm] -> Perm
directSum ([Perm] -> Perm) -> ([Int] -> [Perm]) -> [Int] -> Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Perm) -> [Int] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Perm
ebb) ([[Int]] -> [Perm]) -> (Int -> [[Int]]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [[Int]]
compositions Int
k

-- | The class of layered permutations.
layered :: Int -> [Perm]
layered :: Int -> [Perm]
layered Int
n = [Int
1..Int
n] [Int] -> (Int -> [Perm]) -> [Perm]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Int -> [Perm]) -> Int -> Int -> [Perm]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> [Perm]
kLayered Int
n

-- | The class of Fibonacci permutations with /k/ layers. A /Fibonacci permutation/
-- is a layered permutation whose layers are all of size 1 or 2.
kFibonacci :: Int -> Int -> [Perm]
kFibonacci :: Int -> Int -> [Perm]
kFibonacci Int
k = ([Int] -> Perm) -> [[Int]] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map ([Perm] -> Perm
directSum ([Perm] -> Perm) -> ([Int] -> [Perm]) -> [Int] -> Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Perm) -> [Int] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Perm
ebb) ([[Int]] -> [Perm]) -> (Int -> [[Int]]) -> Int -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int -> [[Int]]
boundedCompositions Int
2 Int
k

-- | The class of Fibonacci permutations. A /Fibonacci permutation/ is a
-- layered permutation whose layers are all of size 1 or 2.
fibonacci :: Int -> [Perm]
fibonacci :: Int -> [Perm]
fibonacci Int
n = [Int
1..Int
n] [Int] -> (Int -> [Perm]) -> [Perm]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Int -> [Perm]) -> Int -> Int -> [Perm]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> [Perm]
kFibonacci Int
n