sym 0.8 → 0.9

raw patch · 42 files changed

+1844/−2582 lines, 42 filesdep +QuickCheckdep +arraydep +hashabledep −containersdep −randomdep −vectordep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, array, hashable

Dependencies removed: containers, random, vector

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/CLongArray.hs +155/−0
• Data/Perm.hs +85/−0
• Data/Perm/Internal.hs +89/−0
• Data/Permgram.hs +96/−0
• LICENSE +1/−1
• Math/Perm.hs +18/−0
• Math/Perm/Bijection.hs +39/−0
• Math/Perm/Class.hs +187/−0
• Math/Perm/Component.hs +76/−0
• Math/Perm/Constructions.hs +62/−0
• Math/Perm/D8.hs +156/−0
• Math/Perm/Group.hs +48/−0
• Math/Perm/Pattern.hs +107/−0
• Math/Perm/Simple.hs +25/−0
• Math/Perm/Sort.hs +40/−0
• Math/Perm/Stat.hs +275/−0
• Math/Sym.hs +43/−580
• Math/Sym/Bijection.hs +0/−24
• Math/Sym/Class.hs +0/−113
• Math/Sym/D8.hs +0/−144
• Math/Sym/Internal.hs +0/−662
• Math/Sym/Stat.hs +0/−195
• cbits/bij.c +54/−0
• cbits/bit.c +8/−6
• cbits/d8.c +33/−0
• cbits/group.c +40/−0
• cbits/ordiso.c +11/−14
• cbits/rank.c +66/−0
• cbits/simple.c +8/−12
• cbits/sortop.c +26/−15
• cbits/stat.c +23/−0
• include/bij.h +4/−0
• include/bit.h +2/−0
• include/d8.h +5/−0
• include/group.h +4/−0
• include/ordiso.h +2/−0
• include/rank.h +4/−0
• include/simple.h +2/−0
• include/sortop.h +4/−1
• include/stat.h +3/−0
• sym.cabal +43/−46
• tests/Properties.hs +0/−769

@@ -0,0 +1,155 @@+{-# LANGUAGE MagicHash, UnboxedTuples, ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--+-- Convenience functions for dealing with arrays of 'CLong's.++module Data.CLongArray+    (+    -- * Data type+    CLongArray++    -- * Conversions+    , fromList+    , toList+    , slice+    , unsafeSlice++    -- * Accessors+    , size+    , at+    , unsafeAt++    -- * Map+    , imap++    -- * Low level functions+    , unsafeNew+    , unsafeWith+    ) where++import Data.Ord+import Foreign+import Foreign.C.Types+import GHC.Base++infixl 9 `at`+infixl 9 `unsafeAt`++inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+{-# INLINE inlinePerformIO #-}+++-- Data type+-- ---------++-- | An array of 'CLong's+data CLongArray = CArr {-# UNPACK #-} !(ForeignPtr CLong) -- elements+                       {-# UNPACK #-} !Int                -- size++instance Show CLongArray where+    show w = "fromList " ++ show (toList w)++instance Eq CLongArray where+    u == v = toList u == toList v++instance Ord CLongArray where+    compare u v =+        case comparing size u v of+          EQ -> comparing toList u v+          x  -> x+++-- Conversions+-- -----------++-- | Construct an array from a list of elements.+fromList :: [Int] -> CLongArray+fromList xs = CArr p (length xs)+    where p = inlinePerformIO $ newForeignPtr finalizerFree =<< newArray (map fromIntegral xs)+{-# INLINE fromList #-}++-- | The list of elements.+toList :: CLongArray -> [Int]+toList w = map fromIntegral . inlinePerformIO . unsafeWith w $ peekArray (size w)+{-# INLINE toList #-}++-- | Slice a 'CLongArray' into contiguous segments of the given+-- sizes. Each segment size must be positive and they must sum to the+-- size of the array.+slice :: [Int] -> CLongArray -> [CLongArray]+slice ks w+    | any (<=0) ks     = error "Data.CLongArray.slice: zero or negative parts"+    | sum ks /= size w = error "Data.CLongArray.slice: parts doesn't sum to size of array"+    | otherwise        = unsafeSlice ks w++-- | Like 'slice' but without range checking.+unsafeSlice :: [Int] -> CLongArray -> [CLongArray]+unsafeSlice parts w = inlinePerformIO . unsafeWith w $ go parts+    where+      go []     _ = return []+      go (k:ks) p = do+        vs <- go ks (advancePtr p k)+        v  <- unsafeNew k $ \q -> copyArray q p k+        return (v:vs)+++-- Accessors+-- ---------++-- | The size/length of the given array.+size :: CLongArray -> Int+size (CArr _ n) = n+{-# INLINE size #-}++-- | @w \`at\` i@ is the value of @w@ at @i@, where @i@ is in @[0..size w-1]@.+at :: CLongArray -> Int -> Int+at w i =+    let n = size w+    in if (i < 0 || i >= n)+       then error $ "Data.CLongArray.at: " ++ show i ++ " not in [0.." ++ show (n-1) ++ "]"+       else unsafeAt w i+{-# INLINE at #-}++-- | Like 'at' but without range checking.+unsafeAt :: CLongArray -> Int -> Int+unsafeAt w = fromIntegral . inlinePerformIO . unsafeWith w . flip peekElemOff+{-# INLINE unsafeAt #-}+++-- Map+-- ---++-- | Apply a function to every element of an array and its index.+imap :: (Int -> CLong -> CLong) -> CLongArray -> CLongArray+imap f w = inlinePerformIO . unsafeWith w $ \p -> unsafeNew n (go 0 p)+    where+      n = size w+      go i p q+        | i >= n = return ()+        | otherwise = do+            x <- peek p+            poke q (f i x)+            go (i+1) (advancePtr p 1) (advancePtr q 1)+++-- Low level functions+-- -------------------++-- | Create a new array of the given size that is initialized through+-- an IO action.+unsafeNew :: Int -> (Ptr CLong -> IO ()) -> IO CLongArray+unsafeNew n act = do+  q <- newForeignPtr finalizerFree =<< mallocArray n+  withForeignPtr q act+  return $ CArr q n+{-# INLINE unsafeNew #-}++-- | Pass a pointer to the array to an IO action; the array may not be+-- modified through the pointer.+unsafeWith :: CLongArray -> (Ptr CLong -> IO a) -> IO a+unsafeWith (CArr p _) = withForeignPtr p+{-# INLINE unsafeWith #-}

@@ -0,0 +1,85 @@+{-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--+-- Generating permutations: rank and unrank++module Data.Perm+    (+      module Data.CLongArray+    , Perm+    , emptyperm+    , one+    , idperm+    , ebb+    , mkPerm+    , rank+    , unrank+    , perms+    ) where++import Data.List+import Data.CLongArray+import Foreign+import Foreign.C.Types+import System.IO.Unsafe++-- | A permutation is just a 'CLongArray'. By convention a permutation+-- of size @n@ is understood to be a permutation of @[0..n-1]@.+type Perm = CLongArray++-- | The unique permutation length zero.+emptyperm :: Perm+emptyperm = fromList []++-- | The unique permutation length one.+one :: Perm+one = fromList [0]++-- | The identity permutation.+idperm :: Int -> Perm+idperm n = fromList [0..n-1]++-- | The reverse of the identity permutation.+ebb :: Int -> Perm+ebb n = fromList [n-1,n-2..0]++-- | Construct a permutation from a list of elements. As opposed to+-- 'fromList' this is a safe function in the sense that the output of+-- @mkPerm xs@ is guaranteed to be a permutation of @[0..length xs-1]@.+-- E.g., @mkPerm \"baxa\" == fromList [2,0,3,1]@.+mkPerm :: Ord a => [a] -> Perm+mkPerm xs =+    let sti ys = map snd . sort $ zip ys [ 0::Int .. ]+    in fromList $ (sti . sti) xs++foreign import ccall unsafe "rank.h rank" c_rank+    :: Ptr CLong -> CLong -> IO CDouble++-- | The rank of the given permutation, where the rank is defined as+-- in [W. Myrvold and F. Ruskey, Ranking and Unranking Permutations in+-- Linear Time, Information Processing Letters, 79 (2001) 281-284].+rank :: Perm -> Integer+rank w =+    let n = fromIntegral (size w)+    in truncate . unsafeDupablePerformIO . unsafeWith w $ flip c_rank n+{-# INLINE rank #-}++foreign import ccall unsafe "rank.h unrank" c_unrank+    :: Ptr CLong -> CLong -> CDouble -> IO ()++-- | The permutation of size @n@ whose rank is @r@, where the rank+-- is defined as in [W. Myrvold and F. Ruskey, Ranking and Unranking+-- Permutations in Linear Time, Information Processing Letters, 79+-- (2001) 281-284].+unrank :: Int -> Integer -> Perm+unrank n r =+    unsafeDupablePerformIO . unsafeNew n $ \ptr ->+        c_unrank ptr (fromIntegral n) (fromIntegral r)+{-# INLINE unrank #-}++-- | All permutations of a given size.+perms :: Int -> [Perm]+perms n = map (unrank n) [0..nFac-1] where nFac = product [1..toInteger n]

@@ -0,0 +1,89 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--++module Data.Perm.Internal+    (+      Set+    , normalize+    , subsets+    ) where++import Data.List+import Data.CLongArray+import Foreign+import Foreign.C.Types+import System.IO.Unsafe+++-- | A set is represented by an increasing array of non-negative+-- integers.+type Set = CLongArray++-- Utils+-- -----++-- | Sort and remove duplicates.+normalize :: Ord a => [a] -> [a]+normalize = map head . group . sort+++-- Bitmasks+-- --------++-- A sub-class of 'Bits' used internally. Minimal complete definiton: 'next'.+class (Bits a, Integral a) => Bitmask a where+    -- | Lexicographically, the next bitmask with the same Hamming weight.+    next :: a -> a++    -- | @ones k m@ is the set of indices whose bits are set in+    -- @m@. Default implementation:+    -- +    -- > ones m = fromListN (popCount m) $ filter (testBit m) [0..]+    -- +    ones :: a -> CLongArray+    ones m = fromList . take (popCount m) $ filter (testBit m) [0..]++instance Bitmask CLong where+    next = nextCLong+    ones = onesCLong++instance Bitmask Integer where+    next = nextIntegral++-- @bitmasks n k@ is the list of bitmasks with Hamming weight @k@ and+-- size less than @2^n@.+bitmasks :: Bitmask a => Int -> Int -> [a]+bitmasks n k = take binomial (iterate next ((1 `shiftL` k) - 1))+    where+      n' = toInteger n+      k' = toInteger k+      binomial = fromIntegral $ product [n', n'-1 .. n'-k'+1] `div` product [1..k']++-- | @subsets n k@ is the list of subsets of @[0..n-1]@ with @k@+-- elements.+subsets :: Int -> Int -> [Set]+subsets n k+    | n <= 32   = map ones (bitmasks n k :: [CLong])+    | otherwise = map ones (bitmasks n k :: [Integer])++foreign import ccall unsafe "bit.h next" c_next :: CLong -> CLong++-- | Lexicographically, the next 'CLong' with the same Hamming weight.+nextCLong :: CLong -> CLong+nextCLong = c_next++foreign import ccall unsafe "bit.h ones" c_ones :: Ptr CLong -> CLong -> IO ()++-- | @onesCLong m@ gives the indices whose bits are set in @m@.+onesCLong :: CLong -> CLongArray+onesCLong m = unsafeDupablePerformIO . unsafeNew (popCount m) $ flip c_ones m++-- | Lexicographically, the next integral number with the same Hamming weight.+nextIntegral :: (Integral a, Bits a) => a -> a+nextIntegral a =+    let b = (a .|. (a - 1)) + 1+    in  b .|. ((((b .&. (-b)) `div` (a .&. (-a))) `shiftR` 1) - 1)

@@ -0,0 +1,96 @@+-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--+-- Permutation diagrams, or permutations as monads.++module Data.Permgram+    (+    -- * Data types+      Label+    , Permgram++    -- * Accessors+    , perm+    , label+    , size++    -- * Construct permgrams+    , permgram+    , inverse+    ) where++import Data.Ord+import Data.List+import Data.Perm (Perm)+import qualified Data.Perm as P+import Data.Array.Unboxed++-- | The purpose of this data type is to assign labels to the indices of+-- a given permutation.+type Label a = Array Int a++-- | A permgram consists of a permutation together with a label for each+-- index of the permutation.+data Permgram a = PGram {+      -- | The underlying permutation.+      perm  :: Perm+      -- | The assignment of labels to indices.+    , label :: Label a+    }++constituents :: Permgram a -> (Perm, [a])+constituents (PGram v f) = (v, elems f)++instance Show a => Show (Permgram a) where+    show w =+        let (v, ys) = constituents w+        in unwords ["permgram", "(" ++ show v ++ ")", show ys]++instance Eq a => Eq (Permgram a) where+    u == v = constituents u == constituents v++instance Ord a => Ord (Permgram a) where+    compare u v =+        case comparing size u v of+          EQ -> comparing constituents u v+          x  -> x++-- | Construct a permgram from an underlying permutation and a list of+-- labels.+permgram :: Perm -> [a] -> Permgram a+permgram v = PGram v . listArray (0, P.size v - 1) . cycle++-- | The inverse permgram. It's obtained by mirroring the permgram in+-- the /x=y/ diagonal.+inverse :: Permgram a -> Permgram a+inverse (PGram u f) = PGram (P.fromList v) (listArray (0,n-1) (map (f!) v))+    where+      v = map snd . sort $ zip (P.toList u) [0..] -- v = u^{-1}+      n = P.size u++-- | The size of a permgram is the size of the underlying permutation.+size :: Permgram a -> Int+size = P.size . perm++instance Functor Permgram where+    fmap f w = w { label = amap f (label w) }++instance Monad Permgram where+    return x = permgram (P.fromList [0]) [x]+    w >>= f  = joinPermgram $ fmap f w++joinPermgram :: Permgram (Permgram a) -> Permgram a+joinPermgram w@(PGram u f) = PGram (P.fromList xs) (listArray (0,m-1) ys)+    where+      len = amap size f+      m = sum $ elems len+      n = size w+      uInverse = map snd . sort $ zip (P.toList u) [0..]+      a :: UArray Int Int+      a = listArray (0,n-1) . scanl (+) 0 $ map (len!) uInverse+      (xs, ys) = unzip $ do+        i <- [0..n-1]+        let PGram v g = f!i+        let d = a ! (u `P.unsafeAt` i)+        [ (d + v `P.unsafeAt` j, g!j) | j <- [0..len!i-1] ]

@@ -1,4 +1,4 @@-Copyright (c)2012, Anders Claesson+Copyright (c)2012, 2013, Anders Claesson  All rights reserved. 

@@ -0,0 +1,18 @@+-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--+-- A meta module collecting all Perm-modules, except those that are best+-- imported \"qualified\".++module Math.Perm (module P) where++import Data.Perm                 as P+import Math.Perm.Class           as P+import Math.Perm.Component       as P+import Math.Perm.Constructions   as P+import Math.Perm.Bijection       as P+import Math.Perm.Group           as P+import Math.Perm.Pattern         as P+import Math.Perm.Simple          as P+import Math.Perm.Sort            as P

@@ -0,0 +1,39 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--++module Math.Perm.Bijection+    (+      simionSchmidt+    , simionSchmidt'+    ) where++import Data.Perm+import Foreign+import Foreign.C.Types+import System.IO.Unsafe++foreign import ccall unsafe "bij.h simion_schmidt" c_simion_schmidt+    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()++foreign import ccall unsafe "bij.h simion_schmidt_inverse" c_simion_schmidt'+    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()++marshal :: (Ptr CLong -> Ptr CLong -> CLong -> IO ()) -> Perm -> Perm+marshal bij w =+    unsafeDupablePerformIO . unsafeWith w $ \p -> do+      let n = size w+      unsafeNew n $ \q -> bij q p (fromIntegral n)+{-# INLINE marshal #-}++-- | The Simion-Schmidt bijection from Av(123) onto Av(132).+simionSchmidt :: Perm -> Perm+simionSchmidt = marshal c_simion_schmidt++-- | The inverse of the Simion-Schmidt bijection. It is a function+-- from Av(132) to Av(123).+simionSchmidt' :: Perm -> Perm+simionSchmidt' = marshal c_simion_schmidt'

@@ -0,0 +1,187 @@+-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--++module Math.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 Data.Perm+import Math.Perm.Bijection+import Math.Perm.Constructions+import Data.Perm.Internal+import Math.Perm.Pattern+import qualified Math.Perm.D8 as D8++-- | The class of increasing permutations.+inc :: Int -> [Perm]+inc = av21++-- | The class of decreasing permutations.+dec :: Int -> [Perm]+dec = av12++-- | Av(1)+av1 :: Int -> [Perm]+av1 0 = [emptyperm]+av1 _ = []++-- | Av(12)+av12 :: Int -> [Perm]+av12 n = [ebb n]++-- | Av(21)+av21 :: Int -> [Perm]+av21 n = [idperm n]++-- | Av(123)+av123 :: Int -> [Perm]+av123 = map simionSchmidt' . av132++-- | Av(132)+av132 :: Int -> [Perm]+av132 = map D8.reverse . av231++-- | Av(213)+av213 :: Int -> [Perm]+av213 = map D8.complement . av231++-- | Av(231); also know as the stack sortable permutations.+av231 :: Int -> [Perm]+av231 0 = [emptyperm]+av231 n = do+  k <- [0..n-1]+  s <- streamAv231 !! k+  t <- streamAv231 !! (n-k-1)+  return $ s /+/ (one \-\ t)++streamAv231 :: [[Perm]]+streamAv231 = map av231 [0..]++-- | Av(312)+av312 :: Int -> [Perm]+av312 = map D8.inverse . av231++-- | Av(321)+av321 :: Int -> [Perm]+av321 = map D8.complement . av123++-- | Av(1243)+av1243 :: Int -> [Perm]+av1243 n = avoiders [fromList [0,1,3,2]] (perms n)++-- | Av(1324)+av1324 :: Int -> [Perm]+av1324 n = avoiders [fromList [0,2,1,3]] (perms n)++-- | Av(2134)+av2134 :: Int -> [Perm]+av2134 n = avoiders [fromList [1,0,2,3]] (perms n)++-- | Av(s) where s is a string of one or more patterns, using space as a+-- seperator.+av :: String -> Int -> [Perm]+av s = avoiders (map mkPerm (words s)) . 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 = (streamVee !!)++streamVee :: [[Perm]]+streamVee = [emptyperm] : [one] : zipWith (++) vee_n n_vee+    where+      n_vee = (map.map) (one \-\) ws+      vee_n = (map.map) (/+/ one) ws+      ws    = tail 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 = map D8.complement . 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 = map D8.rotate . 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 = map D8.reverse . gt++union :: [Int -> [Perm]] -> Int -> [Perm]+union cs n = normalize $ concat [ c n | c <- cs ]++-- | The union of 'vee', 'caret', 'gt' and 'lt'.+wedges :: Int -> [Perm]+wedges = union [vee, caret, gt, lt]++compositions :: Int -> Int -> [[Int]]+compositions 0 0 = [[]]+compositions 0 _ = []+compositions _ 0 = []+compositions k n = [1..n] >>= \i -> map (i:) (compositions (k-1) (n-i))++boundedCompositions :: Int -> Int -> Int -> [[Int]]+boundedCompositions _ 0 0 = [[]]+boundedCompositions _ 0 _ = []+boundedCompositions _ _ 0 = []+boundedCompositions b k n = [1..b] >>= \i -> map (i:) (boundedCompositions b (k-1) (n-i))++-- | The class of separable permutations; it is identical to Av(2413,3142).+separables :: Int -> [Perm]+separables 0 = [emptyperm]+separables 1 = [one]+separables n = pIndec n ++ mIndec n+    where+      comps  m = [2..m] >>= \k -> compositions k m+      pIndec 0 = []+      pIndec 1 = [one]+      pIndec m = comps m >>= map skewSum . mapM (streamMIndec !!)+      mIndec m = map D8.complement $ pIndec m+      streamMIndec = map mIndec [0..]++-- | The class of layered permutations with /k/ layers.+kLayered :: Int -> Int -> [Perm]+kLayered k = map (directSum . map ebb) . compositions k++-- | The class of layered permutations.+layered :: Int -> [Perm]+layered n = [1..n] >>= flip kLayered 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 k = map (directSum . map ebb) . boundedCompositions 2 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 n = [1..n] >>= flip kFibonacci n

@@ -0,0 +1,76 @@+-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--+-- Components of permutations.+-- ++module Math.Perm.Component+    (+      components+    , skewComponents+    , leftMaxima+    , leftMinima+    , rightMaxima+    , rightMinima+    ) where++import Foreign+import System.IO.Unsafe+import Data.Perm+import qualified Math.Perm.D8 as D8++-- Positions /i/ such that /max{ w[j] : j <= i } = i/. These positions+-- mark the boundaries of components.+comps :: Perm -> [Int]+comps w = unsafeDupablePerformIO . unsafeWith w $ go [] 0 0+    where+      n = size w+      go ks m i p+        | i >= n = return (reverse ks)+        | otherwise =+            do y <- fromIntegral `fmap` peek p+               let p'  = advancePtr p 1+               let i'  = i+1+               let m'  = if y > m then y else m+               let ks' = if m' == i then i:ks else ks+               go ks' m' i' p'++-- | The list of (plus) components.+components :: Perm -> [Perm]+components w =+    let ds = 0 : map (+1) (comps w)+        ks = zipWith (-) (tail ds) ds+        ws = unsafeSlice ks w+    in zipWith (\d v -> imap (\_ x -> x - fromIntegral d) v) ds ws++-- | The list of skew components, also called minus components.+skewComponents :: Perm -> [Perm]+skewComponents = map D8.complement . components . D8.complement++records :: (a -> a -> Bool) -> [a] -> [a]+records _ []     = []+records f (x:xs) = recs [x] xs+    where+      recs rs@(r:_) (y:ys) = recs ((if f r y then y else r):rs) ys+      recs rs       _      = rs++-- | For each position, left-to-right, records the largest value seen+-- thus far.+leftMaxima :: Perm -> [Int]+leftMaxima w = reverse $ records (<) (toList w)++-- | For each position, left-to-right, records the smallest value seen+-- thus far.+leftMinima :: Perm -> [Int]+leftMinima w = reverse $ records (>) (toList w)++-- | For each position, /right-to-left/, records the largest value seen+-- thus far.+rightMaxima :: Perm -> [Int]+rightMaxima w = records (<) (reverse (toList w))++-- | For each position, /right-to-left/, records the smallest value seen+-- thus far.+rightMinima :: Perm -> [Int]+rightMinima w = records (>) (reverse (toList w))

@@ -0,0 +1,62 @@+-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--+-- Sum, skew sum, etc+-- ++module Math.Perm.Constructions+    (+      (/+/)+    , (\-\)+    , directSum+    , skewSum+    , inflate+    ) where++import Foreign+import System.IO.Unsafe+import Control.Monad+import Data.Perm+import qualified Data.Permgram as G+import qualified Math.Perm.D8 as D8++infixl 6 /+/+infixl 6 \-\++-- | The /direct sum/ of two permutations.+(/+/) :: Perm -> Perm -> Perm+(/+/) u v =+   let k  = size u+       l  = size v+       v' = imap (\_ x -> x + fromIntegral k) v+   in unsafeDupablePerformIO . unsafeNew (k+l) $ \p ->+       let q = advancePtr p k+       in unsafeWith u  $ \uPtr ->+          unsafeWith v' $ \vPtr -> do+              copyArray p uPtr k+              copyArray q vPtr l++-- | The direct sum of a list of permutations.+directSum :: [Perm] -> Perm+directSum = foldr (/+/) emptyperm++-- | The /skew sum/ of two permutations.+(\-\) :: Perm -> Perm -> Perm+(\-\) u v = D8.complement $ D8.complement u /+/ D8.complement v++-- | The skew sum of a list of permutations.+skewSum :: [Perm] -> Perm+skewSum = foldr (\-\) 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 w = G.perm . join . G.permgram w . map (`G.permgram` [()])

@@ -0,0 +1,156 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--++module Math.Perm.D8+    (+    -- * The group elements+      r0, r1, r2, r3+    , s0, s1, s2, s3++    -- * D8, the klein four-group, and orbits+    , d8+    , klein4+    , orbit+    , symmetryClasses+    , d8Classes+    , klein4Classes++    -- * Aliases+    , rotate+    , complement+    , reverse+    , inverse+    ) where++import Data.List hiding (reverse)+import Prelude hiding (reverse)+import Data.Perm+import Data.Perm.Internal+import Foreign hiding (complement, rotate)+import Foreign.C.Types+import System.IO.Unsafe+++-- The group elements+-- ------------------++-- | Ration by 0 degrees, i.e. the identity map.+r0 :: Perm -> Perm+r0 w = w++-- | Ration by 90 degrees clockwise.+r1 :: Perm -> Perm+r1 = s2 . s1++-- | Ration by 2*90 = 180 degrees clockwise.+r2 :: Perm -> Perm+r2 = r1 . r1++-- | Ration by 3*90 = 270 degrees clockwise.+r3 :: Perm -> Perm+r3 = r2 . r1++-- | Reflection through a horizontal axis (also called 'complement').+s0 :: Perm -> Perm+s0 = complement++-- | Reflection through a vertical axis (also called 'reverse').+s1 :: Perm -> Perm+s1 = reverse++-- | Reflection through the main diagonal (also called 'inverse').+s2 :: Perm -> Perm+s2 = inverse++-- | Reflection through the anti-diagonal.+s3 :: Perm -> Perm+s3 = s1 . r1+++-- D8, the klein four-group, and orbits+-- ------------------------------------++-- | The dihedral group of order 8 (the symmetries of a square); that is,+-- +-- > d8 = [r0, r1, r2, r3, s0, s1, s2, s3]+-- +d8 :: [Perm -> Perm]+d8 = [r0, r1, r2, r3, s0, s1, s2, s3]++-- | The Klein four-group (the symmetries of a non-equilateral+-- rectangle); that is,+-- +-- > klein4 = [r0, r2, s0, s1]+-- +klein4 :: [Perm -> Perm]+klein4 = [r0, r2, s0, s1]++-- | @orbit fs x@ is the orbit of @x@ under the /group/ of function @fs@. E.g.,+-- +-- > orbit klein4 "2314" == ["1423","2314","3241","4132"]+-- +orbit :: [Perm -> Perm] -> Perm -> [Perm]+orbit fs x = normalize [ f x | f <- fs ]++-- | @symmetryClasses fs xs@ is the list of equivalence classes under+-- the action of the /group/ of functions @fs@.+symmetryClasses :: [Perm -> Perm] -> [Perm] -> [[Perm]]+symmetryClasses _  [] = []+symmetryClasses fs xs@(x:xt) = insert orb $ symmetryClasses fs ys+    where+      orb = [ w | w <- orbit fs x, w `elem` xs ]+      ys  = [ y | y <- xt, y `notElem` orb ]++-- | Symmetry classes with respect to D8.+d8Classes :: [Perm] -> [[Perm]]+d8Classes = symmetryClasses d8++-- | Symmetry classes with respect to Klein4+klein4Classes :: [Perm] -> [[Perm]]+klein4Classes = symmetryClasses klein4+++-- Aliases+-- -------++marshal :: (Ptr CLong -> Ptr CLong -> CLong -> IO ()) -> Perm -> Perm+marshal op w =+    unsafeDupablePerformIO . unsafeWith w $ \p -> do+      let n = size w+      unsafeNew n $ \q -> op q p (fromIntegral n)+{-# INLINE marshal #-}++foreign import ccall unsafe "d8.h inverse" c_inverse+    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()++-- | The group theoretical inverse: if @v = inverse u@ then+-- @v \`at\` (u \`at\` i) = i@.+inverse :: Perm -> Perm+inverse = marshal c_inverse+{-# INLINE inverse #-}++foreign import ccall unsafe "d8.h reverse" c_reverse+    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()++-- | The reverse of the given permutation: if @v = reverse u@ then+-- @v \`at\` i = u \`at\` (n-1-i)@.+reverse :: Perm -> Perm+reverse = marshal c_reverse+{-# INLINE reverse #-}++foreign import ccall unsafe "d8.h complement" c_complement+    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()++-- | The complement of the given permutation: if @v = complement u@ then+-- @v \`at\` i = n - 1 - u \`at\` i@.+complement :: Perm -> Perm+complement = marshal c_complement+{-# INLINE complement #-}++-- | @rotate = r1 = inverse . reverse@+rotate :: Perm -> Perm+rotate = r1

@@ -0,0 +1,48 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--++module Math.Perm.Group+    (+      compose+    , act+    ) where++import Data.Perm+import Foreign+import Foreign.C.Types+import System.IO.Unsafe+++marshal :: (Ptr CLong -> Ptr CLong -> CLong -> Ptr CLong -> CLong -> IO ())+        -> Perm -> Perm -> Perm+marshal op u v =+    unsafeDupablePerformIO $+    unsafeWith u $ \u' ->+    unsafeWith v $ \v' -> do+      let k = size u+      let n = size v+      let m = max k n+      unsafeNew m $ \p -> op p u' (fromIntegral k) v' (fromIntegral n)+{-# INLINE marshal #-}++foreign import ccall unsafe "group.h compose" c_compose+    :: Ptr CLong -> Ptr CLong -> CLong -> Ptr CLong -> CLong -> IO ()++-- | The product/composition of @u@ and @v@: if @w = u `compose` v@+-- then @w `at ` i = v \`at\` (u \`at\` i)@.+compose :: Perm -> Perm -> Perm+compose = marshal c_compose+{-# INLINE compose #-}++foreign import ccall unsafe "group.h act" c_act+    :: Ptr CLong -> Ptr CLong -> CLong -> Ptr CLong -> CLong -> IO ()++-- | The (left) group action of Perm on itself: if @w = u `act` v@+-- then @w `at ` (u \`at\` i) = v \`at\` i@.+act :: Perm -> Perm -> Perm+act = marshal c_act+{-# INLINE act #-}

@@ -0,0 +1,107 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--++module Math.Perm.Pattern+    (+      Pattern+    , Set+    , ordiso+    , subsets+    , copiesOf+    , contains+    , avoids+    , avoidsAll+    , avoiders+    , minima+    , maxima+    , coeff+    ) where++import Data.Perm (Perm, perms)+import Data.Perm.Internal+import Data.CLongArray+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 :: Perm -> Perm -> Set -> Bool+ordiso u v m =+    let k = fromIntegral (size u)+    in unsafeDupablePerformIO $+       unsafeWith u $ \u' ->+       unsafeWith v $ \v' ->+       unsafeWith m $ \m' ->+           return . toBool $ c_ordiso u' v' m' k+{-# INLINE ordiso #-}++-- | @copies p w@ is the list of sets that represent copies of @p@ in @w@.+copiesOf :: Pattern -> Perm -> [Set]+copiesOf p w = filter (ordiso p w) $ subsets (size w) (size p)+{-# INLINE copiesOf #-}++-- | @w `contains` p@ is a predicate determining if @w@ contains the pattern @p@.+contains :: Perm -> Pattern -> Bool+w `contains` p = not $ w `avoids` p++-- | @w `avoids` p@ is a predicate determining if @w@ avoids the pattern @p@.+avoids :: Perm -> Pattern -> Bool+w `avoids` p = null $ copiesOf p w++-- | @w `avoidsAll` ps@ is a predicate determining if @w@ avoids the patterns @ps@.+avoidsAll :: Perm -> [Pattern] -> Bool+w `avoidsAll` ps = all (w `avoids`) ps++-- | @avoiders ps ws@ is the list of permutations in @ws@ avoiding the+-- patterns in @ps@.+avoiders :: [Pattern] -> [Perm] -> [Perm]+avoiders ps ws = foldl (flip avoiders1) ws ps++-- @avoiders1 p ws@ is the list of permutations in @ws@ avoiding the+-- pattern @p@.+avoiders1 :: Pattern -> [Perm] -> [Perm]+avoiders1 _ [] = []+avoiders1 q vs@(v:_) = filter avoids_q us ++ filter (`avoids` q) ws+    where+      n = size v+      k = size q+      (us, ws) = span (\u -> size u == n) vs+      xs = subsets n k+      avoids_q u = not $ any (ordiso q u) xs++-- | The set of minimal elements with respect to containment.+minima :: [Pattern] -> [Pattern]+minima [] = []+minima ws = let (v:vs) = normalize ws+            in v : minima (avoiders [v] vs)++-- | The set of maximal elements with respect to containment.+maxima :: [Pattern] -> [Pattern]+maxima [] = []+maxima ws = let (v:vs) = reverse $ normalize ws+            in v : maxima (filter (avoids v) 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 f v = f v + sum [ (-1)^(k - j) * c * f u |+                        j <- [0 .. k-1]+                      , u <- perms j+                      , let c = length $ copiesOf u v+                      , c > 0+                      ] where k = size v

@@ -0,0 +1,25 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--++module Math.Perm.Simple+    (+     simple+    ) where++import Data.Perm+import Foreign+import Foreign.C.Types+import System.IO.Unsafe++foreign import ccall unsafe "simple.h simple" c_simple+    :: Ptr CLong -> CLong -> CInt++-- | Is the permutation simple?+simple :: Perm -> Bool+simple w = toBool . unsafeDupablePerformIO $+    let n = fromIntegral (size w)+    in unsafeWith w $ \ptr -> return $ c_simple ptr n

@@ -0,0 +1,40 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--++module Math.Perm.Sort+    (+      stackSort+    , bubbleSort+    ) where++import Data.Perm+import Foreign+import Foreign.C.Types+import System.IO.Unsafe++foreign import ccall unsafe "sortop.h stacksort" c_stacksort+    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()++foreign import ccall unsafe "sortop.h bubblesort" c_bubblesort+    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()++marshal :: (Ptr CLong -> Ptr CLong -> CLong -> IO ()) -> Perm -> Perm+marshal op w =+    unsafeDupablePerformIO . unsafeWith w $ \p -> do+      let n = size w+      unsafeNew n $ \q -> op q p (fromIntegral n)+{-# INLINE marshal #-}++-- | One pass of stack-sort.+stackSort :: Perm -> Perm+stackSort = marshal c_stacksort+{-# INLINE stackSort #-}++-- | One pass of bubble-sort.+bubbleSort :: Perm -> Perm+bubbleSort = marshal c_bubblesort+{-# INLINE bubbleSort #-}

@@ -0,0 +1,275 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Copyright   : Anders Claesson 2013+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>+--+-- Common permutation statistics. To avoid name clashes this module is+-- best imported @qualified@; e.g.+-- +-- > import qualified Math.Perm.Stat as S+-- ++module Math.Perm.Stat +    (+      asc         -- ascents+    , des         -- descents+    , exc         -- excedances+    , fp          -- fixed points+    , sfp         -- strong fixed points+    , cyc         -- cycles+    , inv         -- inversions+    , maj         -- the major index+    , comaj       -- the co-major index+    , peak        -- peaks+    , vall        -- valleys+    , dasc        -- double ascents+    , ddes        -- double descents+    , lmin        -- left-to-right minima+    , lmax        -- left-to-right maxima+    , rmin        -- right-to-left minima+    , rmax        -- right-to-left maxima+    , head        -- the first element+    , last        -- the last element+    , lir         -- left-most increasing run+    , ldr         -- left-most decreasing run+    , rir         -- right-most increasing run+    , rdr         -- right-most decreasing run+    , comp        -- components+    , scomp       -- skew components+    , ep          -- rank a la Elizalde & Pak+    , dim         -- dimension+    , asc0        -- small ascents+    , des0        -- small descents+--    , shad        -- shadow+    ) where++import Prelude hiding (head, last)+import Data.Perm+import qualified Math.Perm.D8 as D8+import Foreign.Ptr+import Foreign.C.Types+import System.IO.Unsafe++marshal :: (Ptr CLong -> CLong -> CLong) -> Perm -> Int+marshal f w =+    fromIntegral . unsafeDupablePerformIO . unsafeWith w $ \p ->+        return $ f p (fromIntegral (size w))+{-# INLINE marshal #-}++foreign import ccall unsafe "stat.h asc" c_asc+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h des" c_des+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h exc" c_exc+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h fp" c_fp+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h sfp" c_sfp+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h cyc" c_cyc+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h inv" c_inv+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h maj" c_maj+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h comaj" c_comaj+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h peak" c_peak+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h vall" c_vall+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h dasc" c_dasc+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h ddes" c_ddes+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h lmin" c_lmin+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h lmax" c_lmax+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h lir" c_lir+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h ldr" c_ldr+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h comp" c_comp+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h ep" c_ep+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h dim" c_dim+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h asc0" c_asc0+    :: Ptr CLong -> CLong -> CLong++foreign import ccall unsafe "stat.h des0" c_des0+    :: Ptr CLong -> CLong -> CLong++-- | The number of ascents. An /ascent/ in @w@ is an index @i@ such+-- that @w[i] \< w[i+1]@.+asc :: Perm -> Int+asc = marshal c_asc++-- | The number of descents. A /descent/ in @w@ is an index @i@ such+-- that @w[i] > w[i+1]@.+des :: Perm -> Int+des = marshal c_des++-- | The number of /excedances/: positions @i@ such that @w[i] > i@.+exc :: Perm -> Int+exc = marshal c_exc++-- | The number of /fixed points/: positions @i@ such that @w[i] == i@.+fp :: Perm -> Int+fp = marshal c_fp++-- | The number of /strong fixed points/ (also called splitters):+-- positions @i@ such that @w[j] \< i@ for @j \< i@ and @w[j] \> i@ for @j \> i@.+sfp :: Perm -> Int+sfp = marshal c_sfp++-- | The number of /cycles/:+-- orbits of the permutation when viewed as a function.+cyc :: Perm -> Int+cyc = marshal c_cyc++-- | The number of /inversions/:+-- pairs @\(i,j\)@ such that @i \< j@ and @w[i] > w[j]@.+inv :: Perm -> Int+inv = marshal c_inv++-- | /The major index/ is the sum of descents.+maj :: Perm -> Int+maj = marshal c_maj++-- | /The co-major index/ is the sum of descents.+comaj :: Perm -> Int+comaj = marshal c_comaj++-- | The number of /peaks/:+-- positions @i@ such that @w[i-1] \< w[i]@ and @w[i] \> w[i+1]@.+peak :: Perm -> Int+peak = marshal c_peak++-- | The number of /valleys/:+-- positions @i@ such that @w[i-1] \> w[i]@ and @w[i] \< w[i+1]@.+vall :: Perm -> Int+vall = marshal c_vall++-- | The number of /double ascents/:+-- positions @i@ such that @w[i-1] \<  w[i] \< w[i+1]@.+dasc :: Perm -> Int+dasc = marshal c_dasc++-- | The number of /double descents/:+-- positions @i@ such that @w[i-1] \>  w[i] \> w[i+1]@.+ddes :: Perm -> Int+ddes = marshal c_ddes++-- | The number of /left-to-right minima/:+-- positions @i@ such that @w[i] \< w[j]@ for all @j \< i@.+lmin :: Perm -> Int+lmin = marshal c_lmin++-- | The number of /left-to-right maxima/:+-- positions @i@ such that @w[i] \> w[j]@ for all @j \< i@.+lmax :: Perm -> Int+lmax = marshal c_lmax++-- | The number of /right-to-left minima/:+-- positions @i@ such that @w[i] \< w[j]@ for all @j \> i@.+rmin :: Perm -> Int+rmin = lmin . D8.reverse++-- | The number of /right-to-left maxima/:+-- positions @i@ such that @w[i] \> w[j]@ for all @j \> i@.+rmax :: Perm -> Int+rmax = lmax . D8.reverse++-- | The first (left-most) element in the standardization. E.g.,+-- @head \"231\" = head (fromList [1,2,0]) = 1@.+head :: Perm -> Int+head w | size w > 0 = w `unsafeAt` 0+       | otherwise  = 0++-- | The last (right-most) element in the standardization. E.g.,+-- @last \"231\" = last (fromList [1,2,0]) = 0@.+last :: Perm -> Int+last w | size w > 0 = w `unsafeAt` (size w - 1)+       | otherwise  = 0++-- | Length of the left-most increasing run: largest @i@ such that+-- @w[0] \< w[1] \< ... \< w[i-1]@.+lir :: Perm -> Int+lir = marshal c_lir++-- | Length of the left-most decreasing run: largest @i@ such that+-- @w[0] \> w[1] \> ... \> w[i-1]@.+ldr :: Perm -> Int+ldr = marshal c_ldr++-- | Length of the right-most increasing run: largest @i@ such that+-- @w[n-i] \< ... \< w[n-2] \< w[n-1]@.+rir :: Perm -> Int+rir = ldr . D8.reverse++-- | Length of the right-most decreasing run: largest @i@ such that+-- @w[n-i] \> ... \> w[n-2] \> w[n-1]@.+rdr :: Perm -> Int+rdr = lir . D8.reverse++-- | The number of components. E.g., @[2,0,3,1,4,6,7,5]@ has three+-- components: @[2,0,3,1]@, @[4]@ and @[6,7,5]@.+comp :: Perm -> Int+comp = marshal c_comp++-- | The number of skew components. E.g., @[5,7,4,6,3,1,0,2]@ has three+-- skew components: @[5,7,4,6]@, @[3]@ and @[1,0,2]@.+scomp :: Perm -> Int+scomp = comp . D8.complement++-- | The rank as defined by Elizalde and Pak [Bijections for+-- refined restricted permutations, /J. Comb. Theory, Ser. A/, 2004]:+-- +-- > maximum [ k | k <- [0..n-1], w[i] >= k for all i < k ]+-- +ep :: Perm -> Int+ep = marshal c_ep++-- | The dimension of a permutation is defined as the largest+-- non-fixed-point, or zero if all points are fixed.+dim :: Perm -> Int+dim = marshal c_dim++-- | The number of small ascents. A /small ascent/ in @w@ is an index+-- @i@ such that @w[i] + 1 == w[i+1]@.+asc0 :: Perm -> Int+asc0 = marshal c_asc0++-- | The number of small descents. A /small descent/ in @w@ is an+-- index @i@ such that @w[i] == w[i+1] + 1@.+des0 :: Perm -> Int+des0 = marshal c_des0++-- | The size of the shadow of @w@. That is, the number of different+-- one point deletions of @w@.+-- shad :: Perm -> Int+-- shad = length . shadow . return . st

@@ -1,149 +1,23 @@-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}  -- |--- Module      : Math.Sym--- Copyright   : (c) Anders Claesson 2012, 2013--- License     : BSD-style+-- Copyright   : Anders Claesson 2013 -- Maintainer  : Anders Claesson <anders.claesson@gmail.com>--- --- Provides an efficient definition of standard permutations,--- 'StPerm', together with an abstract class, 'Perm', whose--- functionality is largely inherited from 'StPerm' using a group--- action and the standardization map.+--  module Math.Sym     (-    -- * Standard permutations-      StPerm-    , toList-    , fromList-    , sym--    -- * The permutation typeclass-    , Perm (..)-    , CharPerm (..)-    , IntPerm (..)--    -- * IntMaps as permutations-    , Perm2 (..)--    -- * Convenience functions-    , empty-    , one-    , toVector-    , fromVector-    , bijection+      Permutation(..)+    , perms     , lift     , lift2-    , normalize-    , cast--    -- * Constructions-    , (/+/)-    , dsum-    , (\-\)-    , ssum-    , inflate--    -- * Generating permutations-    , unrankPerm-    , randomPerm-    , perms--    -- * Sorting operators-    , stackSort-    , bubbleSort--    -- * Permutation patterns-    , Pattern (..)-    , stat-    , av-    , permClass--    -- * Poset functions-    , del-    , shadow-    , downset-    , ext-    , coshadow-    , minima-    , maxima-    , coeff--    -- * Left-to-right maxima and similar functions-    , lMaxima-    , lMinima-    , rMaxima-    , rMinima--    -- * Components and skew components-    , components-    , skewComponents--    -- * Simple permutations-    , simple--    -- * Subsets-    , Set-    , subsets     ) where -import Control.Monad (liftM)-import Data.Ord (comparing)-import Data.Char (ord)-import Data.String (IsString(..))-import Data.Monoid (Monoid(..),(<>))-import Data.Bits (Bits, bitSize, testBit, popCount, shiftL)-import Data.List (sort, sortBy, group)-import Data.Vector.Storable (Vector)-import Data.IntMap (IntMap, (!))-import qualified Data.IntMap as M-    ( empty, size, elems, fromDistinctAscList, insert-    )-import qualified Data.Vector.Storable as SV-    ( (!), toList, fromList, fromListN, empty, singleton-    , length, map, concat, splitAt-    )-import Math.Sym.Internal (Perm0)-import qualified Math.Sym.Internal as I-import Foreign.C.Types (CUInt(..))----- Standard permutations--- ------------------------- | By a /standard permutation/ we shall mean a permutations of--- @[0..k-1]@.-newtype StPerm = StPerm { perm0 :: Perm0 } deriving Eq--instance Ord StPerm where-    compare u v = case comparing size u v of-                    EQ -> compare (perm0 u) (perm0 v)-                    x  -> x--instance Show StPerm where-    show = show . toVector--instance Monoid StPerm where-    mempty = empty-    mappend = lift2 $ \u v -> SV.concat [u, SV.map ( + SV.length u) v]---- | Convert a standard permutation to a list.-toList :: StPerm -> [Int]-toList = SV.toList . toVector---- | Convert a list to a standard permutation. The list should a--- permutation of the elements @[0..k-1]@ for some positive @k@. No--- checks for this are done.-fromList :: [Int] -> StPerm-fromList = fromVector . SV.fromList---- | The list of standard permutations of the given size (the symmetric group). E.g.,--- --- > sym 2 == [fromList [0,1], fromList [1,0]]--- -sym :: Int -> [StPerm]-sym = perms+import Data.Ord+import Data.List+import Math.Perm (Perm)+import qualified Math.Perm as P+import qualified Math.Perm.D8 as D8   -- The permutation typeclass@@ -152,7 +26,7 @@ -- | 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 Ord a => Perm a where+class Ord a => Permutation a where      -- | The standardization map. If there is an underlying linear     -- order on @a@ then @st@ is determined by the unique order@@ -162,28 +36,28 @@     --      -- > st (u `act` v) == u `act` st v     -- -    st :: a -> StPerm+    st :: a -> Perm -    -- | A (left) /group action/ of 'StPerm' on @a@. As for any group+    -- | 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::StPerm@ are of size @n@.-    act :: StPerm -> a -> a+    -- 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 'StPerm' is+    -- 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 = size . st+    size = P.size . st      -- | The identity permutation of the given size.     idperm :: Int -> a@@ -195,7 +69,7 @@     -- and this is the default implementation.     {-# INLINE inverse #-}     inverse :: a -> a-    inverse = unst . inverse . st+    inverse = unst . D8.inverse . st      -- | Predicate determining if two permutations are     -- order-isomorphic. The default implementation uses@@ -207,456 +81,45 @@     -- > u `ordiso` v  ==  inverse u `act` v == idperm (size u)     --      {-# INLINE ordiso #-}-    ordiso :: StPerm -> a -> Bool+    ordiso :: Perm -> a -> Bool     ordiso u v = u == st v -    -- | The inverse of the standardization function. For efficiency-    -- reasons we make the size of the permutation an argument to this-    -- function. It should hold that-    -- -    -- > unst n w == w `act` idperm n-    -- -    -- and this is the default implementation. An un-standardization-    -- function without the size argument is given by 'unst' below.-    {-# INLINE unstn #-}-    unstn :: Int -> StPerm -> a-    unstn n w = w `act` idperm n-     -- | The inverse of 'st'. It should hold that     -- -    -- > unst w == unstn (size w) w+    -- > unst w == w `act` idperm (P.size w)     --      -- and this is the default implementation.-    unst :: Perm a => StPerm -> a-    unst w = unstn (size w) w--instance Perm StPerm where-    st         = id-    act        = lift2 I.act-    size       = I.size . toVector-    idperm     = fromVector . I.idperm-    inverse    = lift I.inverse-    ordiso     = (==)-    unstn _    = id---- Auxiliary function: @w = act' u v@ iff @w[u[i]] = v[i]@.--- Caveat: @act'@ is not a proper group action.-act' :: Ord a => [a] -> [b] -> [b]-act' u = map snd . sortBy (comparing fst) . zip u--actL :: StPerm -> [a] -> [a]-actL u = act' $ toList (inverse u)--stString :: String -> StPerm-stString = fromList . map f-    where-      f c | '1' <= c && c <= '9' = ord c - ord '1'-          | 'A' <= c && c <= 'Z' = ord c - ord 'A' + 9-          | otherwise            = ord c - ord 'a' + 35+    unst :: Permutation a => Perm -> a+    unst w = w `act` idperm (P.size w) -idpermString :: Int -> String-idpermString n = take n $ ['1'..'9'] ++ ['A'..'Z'] ++ ['a'..]+instance Permutation Perm where+    st       = id+    act      = P.act+    idperm   = P.idperm+    inverse  = D8.inverse+    ordiso   = (==)+    unst     = id  -- | A String viewed as a permutation of its characters. The alphabet -- is ordered as --  -- > ['1'..'9'] ++ ['A'..'Z'] ++ ['a'..] -- -newtype CharPerm = CharPerm { chars :: String } deriving Eq--instance Show CharPerm where-    show w = "CharPerm " ++ show (chars w)--instance Ord CharPerm where-    compare u v = compare (st u) (st v)--instance IsString CharPerm where-    fromString = CharPerm--instance Perm CharPerm where-    st         = stString . chars-    act v      = CharPerm . actL v . chars-    inverse v  = CharPerm $ act' (chars v) (idpermString (size v))-    size       = length . chars-    idperm     = CharPerm . idpermString---- For ghci convenience we also define a String instance of Perm-instance Perm String where-    st         = st . CharPerm-    act v      = chars . act v . CharPerm-    idperm     = chars . idperm---- | A list of integers viewed as a permutation.-newtype IntPerm = IntPerm { ints :: [Int] } deriving Eq--instance Show IntPerm where-    show w = "IntPerm " ++ show (ints w)--instance Ord IntPerm where-    compare u v = compare (st u) (st v)--instance Perm IntPerm where-    st         = fromList . map (+(-1)) . ints-    act v      = IntPerm . actL v . ints-    inverse v  = IntPerm $ act' (ints v) [1 .. size v]-    size       = length . ints-    idperm n   = IntPerm [1..n]----- IntMaps as permutations--- --------------------------- | Type alias for @IntMap Int@. This can be thought of as a--- permutations in two line notation.-newtype Perm2 = Perm2 { intmap :: IntMap Int } deriving Eq--instance Show Perm2 where-    show w = "Perm2 (" ++ show (intmap w) ++ ")"--instance Ord Perm2 where-    compare u v = compare (st u) (st v)--instance Perm Perm2 where-    st         = st . IntPerm . M.elems . intmap-    size       = M.size . intmap-    idperm n   = Perm2 $ M.fromDistinctAscList [ (i,i) | i <- [1..n] ]--    u `act` v  = Perm2 $ foldr (\i -> M.insert (1 + (SV.!) u' i) (v'!(i+1))) M.empty [0..n-1]-        where-          u' = toVector u-          v' = intmap v-          n  = SV.length u'----- Convenience functions--- ------------------------- | The empty permutation.-empty :: Perm a => a-empty = unst $ StPerm SV.empty---- | The one letter permutation.-one :: Perm a => a-one = unst . StPerm $ SV.singleton 0---- | Convert a permutation to a vector.-toVector :: Perm a => a -> Vector Int-toVector = perm0 . st---- | Convert a vector to a permutation. The vector should be a--- permutation of the elements @[0..k-1]@ for some positive @k@. No--- checks for this are done.-fromVector :: Perm a => Vector Int -> a-fromVector = unst . StPerm---- | The bijective function defined by a permutation.-bijection :: Perm a => a -> Int -> Int-bijection w = (SV.!) v where v = toVector w---- | Lift a function on 'Vector Int' to a function on any permutations:--- --- > lift f = fromVector . f . toVector--- -lift :: (Perm a, Perm b) => (Vector Int -> Vector Int) -> a -> b-lift f = fromVector . f . toVector---- | Like 'lift' but for functions of two variables-lift2 :: (Perm a, Perm b, Perm c) =>-         (Vector Int -> Vector Int -> Vector Int) -> a -> b -> c-lift2 f u v = fromVector $ f (toVector u) (toVector v)--generalize :: (Perm a, Perm b) => (StPerm -> StPerm) -> a -> b-generalize f = unst . f . st--generalize2 :: (Perm a, Perm b, Perm c) => (StPerm -> StPerm -> StPerm) -> a -> b -> c-generalize2 f u v = unst $ f (st u) (st v)---- | Sort a list of permutations with respect to the standardization--- and remove duplicates-normalize :: Perm a => [a] -> [a]-normalize = map (unst . head) . group . sort . map st---- | Cast a permutation of one type to another-cast :: (Perm a, Perm b) => a -> b-cast = generalize id----- Constructions--- ---------------infixl 6 /+/-infixl 6 \-\---- | The /direct sum/ of two permutations.-(/+/) :: Perm a => a -> a -> a-(/+/) = generalize2 (<>)---- | The direct sum of a list of permutations.-dsum :: Perm a => [a] -> a-dsum = foldr (/+/) empty---- | The /skew sum/ of two permutations.-(\-\) :: Perm a => a -> a -> a-(\-\) = lift2 $ \u v -> SV.concat [SV.map ( + SV.length v) u, v]---- | The skew sum of a list of permutations.-ssum :: Perm a => [a] -> a-ssum = foldr (\-\) empty---- | @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 "12" [u,v]--- > u \-\ v == inflate "21" [u,v]--- -inflate :: (Perm a, Perm b) => b -> [a] -> a-inflate w vs = lift (\v -> I.inflate v (map toVector vs)) w----- Generating permutations--- --------------------------- | @unrankPerm u rank@ is the @rank@-th (Myrvold & Ruskey)--- permutation of size @n@. E.g.,--- --- > unrankPerm 9 88888 == "561297843"--- -unrankPerm :: Perm a => Int -> Integer -> a-unrankPerm n = fromVector . I.unrankPerm n---- | @randomPerm n@ is a random permutation of size @n@.-randomPerm :: Perm a => Int -> IO a-randomPerm n = (fromVector . I.fromLehmercode) `liftM` I.randomLehmercode n---- | All permutations of a given size. E.g.,--- --- > perms 3 == ["123","213","321","132","231","312"]--- -perms :: Perm a => Int -> [a]-perms n = map (unrankPerm n) [0 .. product [1 .. toInteger n] - 1]----- Sorting operators--- --------------------- | One pass of stack-sort.-stackSort :: Perm a => a -> a-stackSort = lift I.stackSort---- | One pass of bubble-sort.-bubbleSort :: Perm a => a -> a-bubbleSort = lift I.bubbleSort----- Permutation patterns--- ------------------------ | All methods of the Pattern typeclass have default--- implementations. This is because any permutation can also be seen--- as a pattern. If you want to override the default implementation--- you should at least define 'copiesOf'.-class Perm a => Pattern a where-    -- | @copiesOf p w@ is the list of indices of copies of the pattern-    -- @p@ in the permutation @w@. E.g.,-    -- -    -- > copiesOf "21" "2431" == [fromList [1,2],fromList [0,3],fromList [1,3],fromList [2,3]]-    -- -    copiesOf :: Perm b => a -> b -> [Set]-    copiesOf p w = I.copies subsets (toVector p) (toVector w)--    -- | @w `contains` p@ is a predicate determining if @w@ contains the pattern @p@.-    contains :: Perm b => b -> a -> Bool-    w `contains` p = not $ w `avoids` p--    -- | @w `avoids` p@ is a predicate determining if @w@ avoids the pattern @p@.-    avoids :: Perm b => b -> a -> Bool-    w `avoids` p = null $ copiesOf p w--    -- | @w `avoidsAll` ps@ is a predicate determining if @w@ avoids the patterns @ps@.-    avoidsAll :: Perm b => b -> [a] -> Bool-    w `avoidsAll` ps = all (w `avoids`) ps--    -- | @avoiders ps vs@ is the list of permutations in @vs@ avoiding the-    -- patterns @ps@. The default definition is-    -- -    -- > avoiders ps = filter (`avoidsAll` ps)-    -- -    avoiders :: Perm b => [a] -> [b] -> [b]-    avoiders ps = filter (`avoidsAll` ps)--instance Pattern StPerm where-    avoiders ps = I.avoiders subsets toVector (map toVector ps)--instance Pattern String-instance Pattern CharPerm-instance Pattern IntPerm-instance Pattern Perm2----- | @stat p@ is the pattern @p@ when regarded as a statistic/function--- counting copies of itself:--- --- > stat p = length . copiesOf p--- -stat :: (Pattern a, Perm b) => a -> b -> Int-stat p = length . copiesOf p---- | @av ps n@ is the list of permutations of @[0..n-1]@ avoiding the--- patterns @ps@. E.g.,--- --- > map (length . av ["132","321"]) [1..8] == [1,2,4,7,11,16,22,29]--- -av :: Pattern a => [a] -> Int -> [StPerm]-av ps = avoiders ps . sym---- | Like 'av' but the return type is any set of permutations.-permClass :: (Pattern a, Perm b) => [a] -> Int -> [b]-permClass ps = avoiders ps . perms----- Poset functions--- ------------------- | Delete the element at a given position-del :: Perm a => Int -> a -> a-del i = lift $ I.del i---- | The list of all single point deletions-shadow :: Perm a => [a] -> [a]-shadow ws = normalize [ del i w | w <- ws, i <- [0 .. size w - 1] ]---- | The list of permutations that are contained in at least one of--- the given permutaions-downset :: Perm a => [a] -> [a]-downset = normalize . concat . downset'-    where-      downset' [] = []-      downset' ws = ws : downset' (shadow ws)---- | @ext i j w@ extends @w@ by inserting a new element of--- (relative) size @j@ at position @i@. It should hold that--- @0 <= i,j <= size w@.-ext :: Perm a => Int -> Int -> a -> a-ext i j = lift $ \w ->-          let (u,v) = SV.splitAt i w-              f x = if x < j then x else x+1-          in SV.concat [SV.map f u, SV.singleton j, SV.map f v]---- | The list of all single point extensions-coshadow :: Perm a => [a] -> [a]-coshadow ws = normalize [ ext i j w | w <- ws, let n = size w, i <- [0..n], j <- [0..n] ]---- | The set of minimal elements with respect to containment.-minima :: Pattern a => [a] -> [a]-minima [] = []-minima ws = v : minima (avoiders [v] vs)-    where-      (v:vs) = normalize ws---- | The set of maximal elements with respect to containment.-maxima :: Pattern a => [a] -> [a]-maxima [] = []-maxima ws = v : maxima [ u | u <- vs, v `avoids` u ]-    where-      (v:vs) = reverse $ normalize ws---- | @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 a => (a -> Int) -> a -> Int-coeff f v = f v + sum [ (-1)^(k - j) * c * f u |-                        j <- [0 .. k-1]-                      , u <- perms j-                      , let c = length $ copiesOf u v-                      , c > 0-                      ] where k = size v----- Left-to-right maxima and similar functions--- ---------------------------------------------- | The set of indices of left-to-right maxima.-lMaxima :: Perm a => a -> Set-lMaxima = I.lMaxima . toVector---- | The set of indices of left-to-right minima.-lMinima :: Perm a => a -> Set-lMinima = I.lMaxima . I.complement . toVector---- | The set of indices of right-to-left maxima.-rMaxima :: Perm a => a -> Set-rMaxima = I.rMaxima . toVector---- | The set of indices of right-to-left minima.-rMinima :: Perm a => a -> Set-rMinima = I.rMaxima . I.complement . toVector----- Components and skew components-------------------------------------- | The set of indices of components.-components :: Perm a => a -> Set-components = I.components . toVector---- | The set of indices of skew components.-skewComponents :: Perm a => a -> Set-skewComponents = I.components . I.complement . toVector----- Simple permutations--- ----------------------- | A predicate determining if a given permutation is simple.-simple :: Perm a => a -> Bool-simple = I.simple . toVector----- Subsets--- ----------- | A set is represented by an increasing vector of non-negative--- integers.-type Set = Vector Int---- A sub-class of 'Bits' used internally. Minimal complete definiton: 'next'.-class (Bits a, Integral a) => Bitmask a where-    -- | Lexicographically, the next bitmask with the same Hamming weight.-    next :: a -> a--    -- | @ones k m@ is the set of indices whose bits are set in-    -- @m@. Default implementation:-    -- -    -- > ones m = fromListN (popCount m) $ filter (testBit m) [0..]-    -- -    ones :: a -> Set-    ones m = SV.fromListN (popCount m) $ filter (testBit m) [0..]+instance Permutation String where+    st       = P.mkPerm+    act v    = map snd . sortBy (comparing fst) . zip (P.toList (D8.inverse v))+    size     = length+    idperm n = take n $ ['1'..'9'] ++ ['A'..'Z'] ++ ['a'..] -instance Bitmask CUInt where-    next = I.nextCUInt-    ones = I.onesCUInt+-- | The list of all permutations of the given size.+perms :: Permutation a => Int -> [a]+perms = map unst . P.perms -instance Bitmask Integer where-    next = I.nextIntegral+-- | Lifts a function on 'Perm's to one on any permutations.+lift :: (Permutation a) => (Perm -> Perm) -> a -> a+lift f = unst . f . st --- @bitmasks n k@ is the list of bitmasks with Hamming weight @k@ and--- size less than @2^n@.-bitmasks :: Bitmask a => Int -> Int -> [a]-bitmasks n k = take binomial (iterate next ((1 `shiftL` k) - 1))-    where-      n' = toInteger n-      k' = toInteger k-      binomial = fromIntegral $ product [n', n'-1 .. n'-k'+1] `div` product [1..k']+-- | Like 'lift' but for functions of two variables.+lift2 :: (Permutation a) => (Perm -> Perm -> Perm) -> a -> a -> a+lift2 f u v = unst $ f (st u) (st v) --- | @subsets n k@ is the list of subsets of @[0..n-1]@ with @k@--- elements.-subsets :: Int -> Int -> [Set]-subsets n k = if n <= bitSize (0 :: CUInt)-              then map ones (bitmasks n k :: [CUInt])-              else map ones (bitmasks n k :: [Integer])

@@ -1,24 +0,0 @@--- |--- Module      : Math.Sym.Bijection--- Copyright   : (c) Anders Claesson 2013--- License     : BSD-style--- Maintainer  : Anders Claesson <anders.claesson@gmail.com>--- --- Bijections--module Math.Sym.Bijection-    (-     simionSchmidt, simionSchmidt'-    ) where--import qualified Math.Sym.Internal as I (simionSchmidt, simionSchmidt')-import Math.Sym (Perm, lift)---- | The Simion-Schmidt bijection from Av(123) onto Av(132).-simionSchmidt :: Perm a => a -> a-simionSchmidt = lift I.simionSchmidt---- | The inverse of the Simion-Schmidt bijection. It is a function--- from Av(132) to Av(123).-simionSchmidt' :: Perm a => a -> a-simionSchmidt' = lift I.simionSchmidt'

@@ -1,113 +0,0 @@--- |--- Module      : Math.Sym.Class--- Copyright   : (c) Anders Claesson 2012, 2013--- License     : BSD-style--- Maintainer  : Anders Claesson <anders.claesson@gmail.com>--- --- A permutation class is a downset in the poset of permutations--- ordered by containment. This module provides definitions of some--- common classes.--module Math.Sym.Class-    (-      inc, dec-    , av123, av132, av213, av231, av312, av321-    , vee, caret, gt, lt, wedges, separables-    ) where--import Math.Sym (Perm, empty, one, idperm, (/+/), (\-\), ssum, normalize)-import Math.Sym.Bijection (simionSchmidt')-import qualified Math.Sym.D8 as D8---- | The class of increasing permutations.-inc :: Perm a => Int -> [a]-inc n = [idperm n]---- | The class of decreasing permutations.-dec :: Perm a => Int -> [a]-dec n = [D8.complement (idperm n)]---- | Av(123).-av123 :: Perm a => Int -> [a]-av123 = map simionSchmidt' . av132---- | Av(132).-av132 :: Perm a => Int -> [a]-av132 = map D8.reverse . av231---- | Av(213).-av213 :: Perm a => Int -> [a]-av213 = map D8.complement . av231---- | Av(231); also know as the stack sortable permutations.-av231 :: Perm a => Int -> [a]-av231 0 = [empty]-av231 n = do-  k <- [0..n-1]-  s <- streamAv231 !! k-  t <- streamAv231 !! (n-k-1)-  return $ s /+/ (one \-\ t)--streamAv231 :: Perm a => [[a]]-streamAv231 = map av231 [0..]---- | Av(312).-av312 :: Perm a => Int -> [a]-av312 = map D8.reverse . av213---- | Av(321).-av321 :: Perm a => Int -> [a]-av321 = map D8.complement . av123---- | 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 :: Perm a => Int -> [a]-vee = (streamVee !!)--streamVee :: Perm a => [[a]]-streamVee = [empty] : [one] : zipWith (++) vee_n n_vee-    where-      n_vee = (map.map) (one \-\) ws-      vee_n = (map.map) (/+/ one) ws-      ws    = tail 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 :: Perm a => Int -> [a]-caret = map D8.complement . 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 :: Perm a => Int -> [a]-gt = map D8.rotate . 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 :: Perm a => Int -> [a]-lt = map D8.reverse . gt--union :: Perm a => [Int -> [a]] -> Int -> [a]-union cs n = normalize $ concat [ c n | c <- cs ]---- | The union of 'vee', 'caret', 'gt' and 'lt'.-wedges :: Perm a => Int -> [a]-wedges = union [vee, caret, gt, lt]--compositions :: Int -> Int -> [[Int]]-compositions 0 0 = [[]]-compositions 0 _ = []-compositions _ 0 = []-compositions k n = [1..n] >>= \i -> map (i:) (compositions (k-1) (n-i))---- | The class of separable permutations; it is identical to Av(2413,3142).-separables :: Perm a => Int -> [a]-separables 0 = [empty]-separables 1 = [ one ]-separables n = pIndec n ++ mIndec n-    where-      comps  m = [2..m] >>= \k -> compositions k m-      pIndec 0 = []-      pIndec 1 = [one]-      pIndec m = comps m >>= map ssum . mapM (streamMIndec !!)-      mIndec m = map D8.complement $ pIndec m-      streamMIndec = map mIndec [0..]

@@ -1,144 +0,0 @@--- |--- Module      : Math.Sym.D8--- Copyright   : (c) Anders Claesson 2012, 2013--- License     : BSD-style--- Maintainer  : Anders Claesson <anders.claesson@gmail.com>--- --- The dihedral group of order 8 acting on permutations.--- --- To avoid name clashes this module is best imported @qualified@;--- e.g.--- --- > import qualified Math.Sym.D8 as D8--- --module Math.Sym.D8-    (-    -- * The group elements-      r0, r1, r2, r3-    , s0, s1, s2, s3--    -- * D8, the klein four-group, and orbits-    , d8-    , klein4-    , orbit-    , symmetryClasses-    , d8Classes-    , klein4Classes--    -- * Aliases-    , id-    , rotate-    , complement-    , reverse-    , inverse-    ) where--import Prelude hiding (reverse, id)-import Data.List (insert)-import Math.Sym (Perm (size), fromVector, act, normalize)-import qualified Math.Sym (inverse)-import Math.Sym.Internal (revIdperm)----- The group elements--- ---------------------- | Ration by 0 degrees, i.e. the identity map.-r0 :: Perm a => a -> a-r0 w = w---- | Ration by 90 degrees clockwise.-r1 :: Perm a => a -> a-r1 = s2 . s1---- | Ration by 2*90 = 180 degrees clockwise.-r2 :: Perm a => a -> a-r2 = r1 . r1---- | Ration by 3*90 = 270 degrees clockwise.-r3 :: Perm a => a -> a-r3 = r2 . r1---- | Reflection through a horizontal axis (also called 'complement').-s0 :: Perm a => a -> a-s0 = r1 . s2---- | Reflection through a vertical axis (also called 'reverse').-s1 :: Perm a => a -> a-s1 w = (fromVector . revIdperm . size) w `act` w---- | Reflection through the main diagonal (also called 'inverse').-s2 :: Perm a => a -> a-s2 = Math.Sym.inverse---- | Reflection through the anti-diagonal.-s3 :: Perm a => a -> a-s3 = s1 . r1----- D8, the klein four-group, and orbits--- ---------------------------------------- | The dihedral group of order 8 (the symmetries of a square); that is,--- --- > d8 = [r0, r1, r2, r3, s0, s1, s2, s3]--- -d8 :: Perm a => [a -> a]-d8 = [r0, r1, r2, r3, s0, s1, s2, s3]---- | The Klein four-group (the symmetries of a non-equilateral--- rectangle); that is,--- --- > klein4 = [r0, r2, s0, s1]--- -klein4 :: Perm a => [a -> a]-klein4 = [r0, r2, s0, s1]---- | @orbit fs x@ is the orbit of @x@ under the /group/ of function @fs@. E.g.,--- --- > orbit klein4 "2314" == ["1423","2314","3241","4132"]--- -orbit :: Perm a => [a -> a] -> a -> [a]-orbit fs x = normalize [ f x | f <- fs ]---- | @symmetryClasses fs xs@ is the list of equivalence classes under--- the action of the /group/ of functions @fs@.-symmetryClasses :: Perm a => [a -> a] -> [a] -> [[a]]-symmetryClasses _  [] = []-symmetryClasses fs xs@(x:xt) = insert orb $ symmetryClasses fs ys-    where-      orb = [ w | w <- orbit fs x, w `elem` xs ]-      ys  = [ y | y <- xt, y `notElem` orb ]---- | Symmetry classes with respect to D8.-d8Classes :: Perm a => [a] -> [[a]]-d8Classes = symmetryClasses d8---- | Symmetry classes with respect to Klein4-klein4Classes :: Perm a => [a] -> [[a]]-klein4Classes = symmetryClasses klein4----- Aliases--- ----------- | @id = r0@-id :: Perm a => a -> a-id = r0---- | @rotate = r1@-rotate :: Perm a => a -> a-rotate = r1---- | @complement = s0@-complement :: Perm a => a -> a-complement = s0---- | @reverse = s1@-reverse :: Perm a => a -> a-reverse = s1---- | @inverse = s2@-inverse :: Perm a => a -> a-inverse = s2

@@ -1,662 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}---- |--- Module      : Math.Sym.Internal--- Copyright   : (c) Anders Claesson 2012, 2013--- License     : BSD-style--- Maintainer  : Anders Claesson <anders.claesson@gmail.com>--- --- An internal module used by the sym package.--- --- A Lehmercode is a vector of integers @w@ such @w!i <= length w - 1 - i@--- for each @i@ in @[0..length w - 1]@; such a vector encodes a permutation.--- This module implements /O(n)/ algorithms for unranking Lehmercodes and--- permutations; the algorithms are due to W. Myrvold and F. Ruskey--- [Ranking and Unranking Permutations in Linear Time, Information Processing--- Letters, 79 (2001) 281-284].--- --- In addition, this module implements sorting operators, the--- symmetries in D8 acting on permutations, as well as most of the--- common permutation statistics.--module Math.Sym.Internal-    (-      Lehmercode-    , Perm0--    -- * Lehmercodes-    , unrankLehmercode-    , fromLehmercode-    , randomLehmercode-    , lehmercodes--    -- * Permutations-    , size-    , toList-    , fromList-    , act-    , inflate-    , unrankPerm-    , randomPerm-    , sym-    , idperm-    , revIdperm-    , sti-    , st-    , ordiso-    , simple-    , copies-    , avoiders--    -- * Permutation symmetries-    , reverse-    , complement-    , inverse-    , rotate--    -- * Permutation statistics-    , asc-    , des-    , exc-    , fp-    , cyc-    , inv-    , maj-    , comaj-    , peak-    , vall-    , dasc-    , ddes-    , lmin-    , lmax-    , rmin-    , rmax-    , head-    , last-    , lir-    , ldr-    , rir-    , rdr-    , comp-    , scomp-    , ep-    , dim-    , asc0-    , des0--    -- * Left-to-right maxima, etc-    , lMaxima-    , rMaxima--    -- * Components-    , components--    -- * Sorting operators-    , stackSort-    , bubbleSort--    -- * Single point deletions-    , del--    -- * Bijections-    , simionSchmidt-    , simionSchmidt'--    -- * Bitmasks-    , onesCUInt-    , nextCUInt-    , nextIntegral--    ) where--import Prelude hiding (reverse, head, last)-import qualified Prelude (head)-import System.Random (getStdRandom, randomR)-import Control.Monad (forM_, foldM, foldM_, liftM)-import Control.Monad.ST (runST)-import Data.List (group, sort)-import Data.Bits (Bits, shiftR, (.|.), (.&.), popCount)-import qualified Data.IntSet as Set-    ( empty, insert, delete, notMember, findMax, fromDistinctAscList-    )-import Data.Vector.Storable ((!))-import qualified Data.Vector.Storable as SV-    ( Vector, toList, fromList, length, thaw, concat-    , unsafeFreeze, unsafeWith, enumFromN, enumFromStepN-    , head, last, filter, maximum, minimum, null, reverse, map-    )-import qualified Data.Vector.Storable.Mutable as MV-    ( unsafeNew, unsafeWrite, unsafeWith, unsafeSlice, swap, replicate-    )-import Foreign (Ptr, castPtr)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.Types (CLong(..), CInt(..), CUInt(..))-import Foreign.Marshal.Utils (toBool)---- | A Lehmercode is a vector of integers @w@ such @w!i <= length w - 1 - i@--- for each @i@ in @[0..length w - 1]@.-type Lehmercode = SV.Vector Int---- | By convention, a member of @Perm0@ is a permutation of some--- finite subset of @[0..]@.-type Perm0 = SV.Vector Int----- Lehmercodes--- --------------- | @unrankLehmercode n rank@ is the @rank@-th Lehmercode of length @n@.-unrankLehmercode :: Int -> Integer -> Lehmercode-unrankLehmercode n rank = runST $ do-  v <- MV.unsafeNew n-  foldM_ iter (v, rank, toInteger n) [0..n-1]-  SV.unsafeFreeze v-    where-      {-# INLINE iter #-}-      iter (v,r,m) i = do-        let (r',j) = quotRem r m-        MV.unsafeWrite v i $ fromIntegral j-        return (v,r',m-1)---- | Build a permutation from its Lehmercode.-fromLehmercode :: Lehmercode -> Perm0-fromLehmercode code = runST $ do-  let n = SV.length code-  v <- MV.unsafeNew n-  forM_ [0..n-1] $ \i -> MV.unsafeWrite v i i-  forM_ [0..n-1] $ \i -> MV.swap v i (i + code ! i)-  SV.unsafeFreeze v---- | A random Lehmercode of the given length.-randomLehmercode :: Int -> IO Lehmercode-randomLehmercode n = unrankLehmercode n `liftM` getStdRandom (randomR (0, factorial n - 1))---- | The list of Lehmercodes of a given length.-lehmercodes :: Int -> [Lehmercode]-lehmercodes n = map (unrankLehmercode n) [0 .. factorial n - 1]----- Permutations--- ---------------- | The size of a permutation; the number of elements.-size :: Perm0 -> Int-size = SV.length---- | The list of images of a permutation.-toList :: Perm0 -> [Int]-toList = SV.toList---- | Make a permutation from a list of images.-fromList :: [Int] -> Perm0-fromList = SV.fromList---- | @u `act` v@ is the permutation /w/ defined by /w(u(i)) = v(i)/.-act :: Perm0 -> Perm0 -> Perm0-act u v = runST $ do-  let n = size u-  w <- MV.unsafeNew n-  forM_ [0..n-1] $ \i -> MV.unsafeWrite w i (v ! (u ! i))-  SV.unsafeFreeze w---- | @inflate w vs@ is the /inflation/ of @w@ by @vs@.-inflate :: Perm0 -> [Perm0] -> Perm0-inflate w vs = SV.concat . map snd . sort $ zipWith3 f w' cs us-    where-      f i c u = (i, SV.map (+c) u)-      (_, w', us) = unzip3 . sort $ zip3 (SV.toList w) [0 :: Int .. ] vs-      cs = scanl (\i u -> i + SV.length u) 0 us--factorial :: Integral a => a -> Integer-factorial = product . enumFromTo 1 . toInteger ---- | @unrankPerm n rank@ is the @rank@-th (Myrvold & Ruskey) permutation of length @n@.-unrankPerm :: Int -> Integer -> Perm0-unrankPerm n = fromLehmercode . unrankLehmercode n---- | A random permutation of the given length.-randomPerm :: Int -> IO Perm0-randomPerm n = fromLehmercode `liftM` randomLehmercode n---- | @sym n@ is the list of permutations of @[0..n-1]@ (the symmetric group).-sym :: Int -> [Perm0]-sym n = map (unrankPerm n) [0 .. factorial n - 1]---- | The identity permutation of the given length.-idperm :: Int -> Perm0-idperm = SV.enumFromN 0---- | The reverse of the identity permutation.-revIdperm :: Int -> Perm0-revIdperm n = SV.enumFromStepN (n-1) (-1) n---- | @sti w@ is the inverse of the standardization of @w@ (a--- permutation on @[0..length w-1]@). E.g., @sti \<4,9,2\> ==--- \<2,0,1\>@.-sti :: Perm0 -> Perm0-sti w = runST $ do-  let a = if SV.null w then 0 else SV.minimum w-  let b = if SV.null w then 0 else SV.maximum w-  let n = size w-  v <- MV.replicate (1 + b - a) (-1)-  forM_ [0..n-1] $ \i -> MV.unsafeWrite v (w ! i - a) i-  SV.filter (>=0) `liftM` SV.unsafeFreeze v---- | The standardization map.-st :: Perm0 -> Perm0-st = inverse . sti--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 :: Perm0 -> Perm0 -> SV.Vector Int -> Bool-ordiso u v m =-    let k = fromIntegral (size u)-    in  unsafePerformIO $-        SV.unsafeWith u $ \u' ->-        SV.unsafeWith v $ \v' ->-        SV.unsafeWith m $ \m' ->-        return . toBool $ c_ordiso (castPtr u') (castPtr v') (castPtr m') k--foreign import ccall unsafe "simple.h simple" c_simple-    :: Ptr CLong -> CLong -> CInt---- | @simple w@ determines whether @w@ is simple-simple :: Perm0 -> Bool-simple w =-    let n = fromIntegral (size w)-    in  unsafePerformIO $-        SV.unsafeWith w $ \w' ->-        return . toBool $ c_simple (castPtr w') n---- | @copies subsets p w@ is the list of bitmasks that represent copies of @p@ in @w@.-copies :: (Int -> Int -> [SV.Vector Int]) -> Perm0 -> Perm0 -> [SV.Vector Int]-copies subsets p w = filter (ordiso p w) $ subsets n k-    where-      n = size w-      k = size p--avoiders1 :: (Int -> Int -> [SV.Vector Int]) -> (a -> Perm0) -> Perm0 -> [a] -> [a]-avoiders1 subsets f p ws =-    let ws0 = map f ws-        ws2 = zip ws0 ws-    in case group (map SV.length ws0) of-         []  -> []-         [_] -> let k = size p-                    n = SV.length (Prelude.head ws0)-                in  [ v | (v0,v) <- ws2,  not $ any (ordiso p v0) (subsets n k) ]-         _   ->     [ v | (v0,v) <- ws2, null $ copies subsets p v0 ] ---- | @avoiders subsets st ps ws@ is the list of permutations in @ws@--- avoiding the patterns in @ps@.-avoiders :: (Int -> Int -> [SV.Vector Int]) -> (a -> Perm0) -> [Perm0] -> [a] -> [a]-avoiders _       _   []   ws = ws-avoiders subsets f (p:ps) ws = avoiders subsets f ps $ avoiders1 subsets f p ws----- Permutation symmetries--- -------------------------- | @reverse \<a_1,...,a_n\> == \<a_n,,...,a_1\>@. E.g., @reverse--- \<9,3,7,2\> == \<2,7,3,9\>@.-reverse :: Perm0 -> Perm0-reverse = SV.reverse---- | @complement \<a_1,...,a_n\> == \<b_1,,...,b_n\>@, where @b_i = n - a_i - 1@.--- E.g., @complement \<3,4,0,1,2\> == \<1,0,4,3,2\>@.-complement :: Perm0 -> Perm0-complement w = SV.map (\x -> size w - x - 1) w---- | @inverse w@ is the group theoretical inverse of @w@. E.g.,--- @inverse \<1,2,0\> == \<2,0,1\>@.-inverse :: Perm0 -> Perm0-inverse w = runST $ do-  let n = size w-  v <- MV.unsafeNew n-  forM_ [0..n-1] $ \i -> MV.unsafeWrite v (w ! i) i-  SV.unsafeFreeze v---- | The clockwise rotatation through 90 degrees. E.g.,--- @rotate \<1,0,2\> == \<1,2,0\>@.-rotate :: Perm0 -> Perm0-rotate w = runST $ do-  let n = size w-  v <- MV.unsafeNew n-  forM_ [0..n-1] $ \i -> MV.unsafeWrite v (w ! (n-1-i)) i-  SV.unsafeFreeze v----- Permutation statistics--- ------------------------foreign import ccall unsafe "stat.h asc" c_asc-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h des" c_des-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h exc" c_exc-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h fp" c_fp-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h cyc" c_cyc-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h inv" c_inv-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h maj" c_maj-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h comaj" c_comaj-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h peak" c_peak-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h vall" c_vall-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h dasc" c_dasc-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h ddes" c_ddes-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h lmin" c_lmin-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h lmax" c_lmax-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h lir" c_lir-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h ldr" c_ldr-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h comp" c_comp-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h ep" c_ep-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h dim" c_dim-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h asc0" c_asc0-    :: Ptr CLong -> CLong -> CLong--foreign import ccall unsafe "stat.h des0" c_des0-    :: Ptr CLong -> CLong -> CLong---- Marshal a permutation statistic defined in C to on in Haskell.-stat :: (Ptr CLong -> CLong -> CLong) -> Perm0 -> Int-stat f w = unsafePerformIO $-           SV.unsafeWith w $ \ptr ->-               return . fromIntegral $ f (castPtr ptr) (fromIntegral (SV.length w))---- | First (left-most) value of a permutation.-head :: Perm0 -> Int-head = SV.head---- | Last (right-most) value of a permutation.-last :: Perm0 -> Int-last = SV.last---- | The number of left-to-right minima.-rmin :: Perm0 -> Int-rmin = lmin . SV.reverse---- | The number of left-to-right maxima.-rmax :: Perm0 -> Int-rmax = lmax . SV.reverse---- | The right-most increasing run.-rir :: Perm0 -> Int-rir = ldr . SV.reverse---- | The right-most decreasing run.-rdr :: Perm0 -> Int-rdr = lir . SV.reverse---- | The number of ascents.-asc :: Perm0 -> Int-asc = stat c_asc---- | The number of descents.-des :: Perm0 -> Int-des = stat c_des---- | The number of inversions.-inv :: Perm0 -> Int-inv = stat c_inv---- | The major index.-maj :: Perm0 -> Int-maj = stat c_maj---- | The co-major index.-comaj :: Perm0 -> Int-comaj = stat c_comaj---- | The number of peaks.-peak :: Perm0 -> Int-peak = stat c_peak---- | The number of valleys.-vall :: Perm0 -> Int-vall = stat c_vall---- | The number of double ascents.-dasc :: Perm0 -> Int-dasc = stat c_dasc---- | The number of double descents.-ddes :: Perm0 -> Int-ddes = stat c_ddes---- | The number of left-to-right minima.-lmin :: Perm0 -> Int-lmin = stat c_lmin---- | The number of left-to-right maxima.-lmax :: Perm0 -> Int-lmax = stat c_lmax---- | The left-most increasing run.-lir :: Perm0 -> Int-lir = stat c_lir---- | The left-most decreasing run.-ldr :: Perm0 -> Int-ldr = stat c_ldr---- | The number of excedances.-exc :: Perm0 -> Int-exc = stat c_exc---- | The number of fixed points.-fp :: Perm0 -> Int-fp = stat c_fp---- | The number of cycles.-cyc :: Perm0 -> Int-cyc = stat c_cyc---- | The number of components.-comp :: Perm0 -> Int-comp = stat c_comp---- | The number of skew components. -scomp :: Perm0 -> Int-scomp = comp . complement---- | Rank as defined by Elizalde & Pak.-ep :: Perm0 -> Int-ep = stat c_ep---- | Dimension (largest non-fixed-point).-dim :: Perm0 -> Int-dim = stat c_dim---- | The number of small ascents.-asc0 :: Perm0 -> Int-asc0 = stat c_asc0---- | The number of small descents.-des0 :: Perm0 -> Int-des0 = stat c_des0----- Left-to-right maxima, etc--- ----------------------------- | The set of indices of left-to-right maxima.-lMaxima :: Perm0 -> SV.Vector Int-lMaxima w = runST $ do-  v <- MV.unsafeNew n-  (_,_,k) <- foldM iter (v,-1,0) [0..n-1]-  SV.unsafeFreeze $ MV.unsafeSlice 0 k v-    where-      n = size w-      iter (v, m, j) i = do-        let m' = w ! i-        if m' > m then do-            MV.unsafeWrite v j i-            return (v, m', j+1)-          else-            return (v, m, j)---- | The set of indices of right-to-left maxima.-rMaxima :: Perm0 -> SV.Vector Int-rMaxima w = SV.reverse . SV.map (\x -> size w - x - 1) . lMaxima $ reverse w----- Components--- -------------- | The set of indices of components.-components :: Perm0 -> SV.Vector Int-components w = runST $ do-  v <- MV.unsafeNew n-  (_,_,k) <- foldM iter (v,-1,0) [0..n-1]-  SV.unsafeFreeze $ MV.unsafeSlice 0 k v-    where-      n = size w-      iter (v, m, j) i = do-        let m' = max m $ w ! i-        if m' == i then do-            MV.unsafeWrite v j i-            return (v, m', j+1)-          else-            return (v, m', j)----- Sorting operators--- -------------------foreign import ccall unsafe "sortop.h stacksort" c_stacksort-    :: Ptr CLong -> CLong -> IO ()--foreign import ccall unsafe "sortop.h bubblesort" c_bubblesort-    :: Ptr CLong -> CLong -> IO ()---- Marshal a sorting operator defined in C to one in Haskell.-sortop :: (Ptr CLong -> CLong -> IO ()) -> Perm0 -> Perm0-sortop f w = unsafePerformIO $ do-               v <- SV.thaw w-               MV.unsafeWith v $ \ptr -> do-                 f (castPtr ptr) (fromIntegral (size w))-                 SV.unsafeFreeze v---- | One pass of stack-sort.-stackSort :: Perm0 -> Perm0-stackSort = sortop c_stacksort---- | One pass of bubble-sort.-bubbleSort :: Perm0 -> Perm0-bubbleSort = sortop c_bubblesort----- Single point deletions--- -------------------------- | Delete the element at a given position-del :: Int -> Perm0 -> Perm0-del i u = runST $ do-  let n = size u-  let j = u ! i-  v <- MV.unsafeNew (n-1)-  forM_ [0..i-1] $ \k -> do-            let m = u ! k-            MV.unsafeWrite v k (if m < j then m else m-1)-  forM_ [i+1..n-1] $ \k -> do-            let m = u ! k-            MV.unsafeWrite v (k-1) (if m < j then m else m-1)-  SV.unsafeFreeze v----- Bijections--- -------------- | The Simion-Schmidt bijection from Av(123) onto Av(132).-simionSchmidt :: Perm0 -> Perm0-simionSchmidt w = runST $ do-  v <- MV.unsafeNew n-  foldM_ iter (v, n, Set.empty) [0..n-1]-  SV.unsafeFreeze v-    where-      n = size w-      iter (v, m, s) i = do-        let c = w ! i-        let y = Prelude.head [ x | x <- [m+1 .. ], x `Set.notMember` s ]-        let (d, k) = if c < m then (c, c) else (y, m)-        MV.unsafeWrite v i d-        return (v, k, Set.insert d s)---- | The inverse of the Simion-Schmidt bijection. It is a function--- from Av(132) to Av(123).-simionSchmidt' :: Perm0 -> Perm0-simionSchmidt' w = runST $ do-  v <- MV.unsafeNew n-  let is = [0..n-1]-  foldM_ iter (v, n, Set.fromDistinctAscList is) is-  SV.unsafeFreeze v-    where-      n = size w-      iter (v, m, s) i = do-        let c = w ! i-        let (d, k) = if c < m then (c, c) else (Set.findMax s, m)-        MV.unsafeWrite v i d-        return (v, k, Set.delete d s)----- Bitmasks--- ----------foreign import ccall unsafe "bit.h next" c_next :: CUInt -> CUInt---- | Lexicographically, the next 'CUInt' with the same Hamming weight.-nextCUInt :: CUInt -> CUInt-nextCUInt = c_next--foreign import ccall unsafe "bit.h ones" c_ones :: Ptr CUInt -> CUInt -> IO ()---- | @onesCUInt k m@ gives the @k@ smallest indices whose bits are set in @m@.-onesCUInt :: CUInt -> SV.Vector Int-onesCUInt m = SV.map fromIntegral . unsafePerformIO $ do-                v <- MV.unsafeNew (popCount m)-                MV.unsafeWith v $ \ptr -> do-                  c_ones ptr m-                  SV.unsafeFreeze v---- | Lexicographically, the next integral number with the same Hamming weight.-nextIntegral :: (Integral a, Bits a) => a -> a-nextIntegral a =-    let b = (a .|. (a - 1)) + 1-    in  b .|. ((((b .&. (-b)) `div` (a .&. (-a))) `shiftR` 1) - 1)

@@ -1,195 +0,0 @@--- |--- Module      : Math.Sym.Stat--- Copyright   : (c) Anders Claesson 2012, 2013--- License     : BSD-style--- Maintainer  : Anders Claesson <anders.claesson@gmail.com>--- --- Common permutation statistics. Please contact the maintainer if you--- feel that there is a statistic that is missing; even better, send a--- patch or make a pull request.--- --- To avoid name clashes this module is best imported @qualified@;--- e.g.--- --- > import qualified Math.Sym.Stat as S--- --- For any permutation statistic @f@, below, it holds that @f w == f--- (st w)@, and therefore the explanations below will be done on--- standard permutations for convenience.--module Math.Sym.Stat -    (-      asc         -- ascents-    , des         -- descents-    , exc         -- excedances-    , fp          -- fixed points-    , cyc         -- cycles-    , inv         -- inversions-    , maj         -- the major index-    , comaj       -- the co-major index-    , peak        -- peaks-    , vall        -- valleys-    , dasc        -- double ascents-    , ddes        -- double descents-    , lmin        -- left-to-right minima-    , lmax        -- left-to-right maxima-    , rmin        -- right-to-left minima-    , rmax        -- right-to-left maxima-    , head        -- the first element-    , last        -- the last element-    , lir         -- left-most increasing run-    , ldr         -- left-most decreasing run-    , rir         -- right-most increasing run-    , rdr         -- right-most decreasing run-    , comp        -- components-    , scomp       -- skew components-    , ep          -- rank a la Elizalde & Pak-    , dim         -- dimension-    , asc0        -- small ascents-    , des0        -- small descents-    , shad        -- shadow-    ) where--import Prelude hiding (head, last)-import Math.Sym (Perm, toVector, st, shadow)-import Math.Sym.Internal (Perm0)-import qualified Math.Sym.Internal as I -    ( asc, des, exc, fp, cyc, inv, maj, comaj, peak, vall, dasc, ddes-    , lmin, lmax, rmin, rmax-    , head, last, lir, ldr, rir, rdr, comp, scomp, ep, dim, asc0, des0-    )--liftStat :: Perm a => (Perm0 -> b) -> a -> b-liftStat f = f . toVector---- | The number of ascents. An /ascent/ in @w@ is an index @i@ such--- that @w[i] \< w[i+1]@.-asc :: Perm a => a -> Int-asc = liftStat I.asc---- | The number of descents. A /descent/ in @w@ is an index @i@ such--- that @w[i] > w[i+1]@.-des :: Perm a => a -> Int-des = liftStat I.des---- | The number of /excedances/: positions @i@ such that @w[i] > i@.-exc :: Perm a => a -> Int-exc = liftStat I.exc---- | The number of /fixed points/: positions @i@ such that @w[i] == i@.-fp :: Perm a => a -> Int-fp = liftStat I.fp---- | The number of /cycles/: orbits of the permutation when viewed as a function.-cyc :: Perm a => a -> Int-cyc = liftStat I.cyc---- | The number of /inversions/: pairs @\(i,j\)@ such that @i \< j@ and @w[i] > w[j]@.-inv :: Perm a => a -> Int-inv = liftStat I.inv---- | /The major index/ is the sum of descents.-maj :: Perm a => a -> Int-maj = liftStat I.maj---- | /The co-major index/ is the sum of descents.-comaj :: Perm a => a -> Int-comaj = liftStat I.comaj---- | The number of /peaks/: positions @i@ such that @w[i-1] \< w[i]@ and @w[i] \> w[i+1]@.-peak :: Perm a => a -> Int-peak = liftStat I.peak---- | The number of /valleys/: positions @i@ such that @w[i-1] \> w[i]@ and @w[i] \< w[i+1]@.-vall :: Perm a => a -> Int-vall = liftStat I.vall---- | The number of /double ascents/: positions @i@ such that @w[i-1] \<  w[i] \< w[i+1]@.-dasc :: Perm a => a -> Int-dasc = liftStat I.dasc---- | The number of /double descents/: positions @i@ such that @w[i-1] \>  w[i] \> w[i+1]@.-ddes :: Perm a => a -> Int-ddes = liftStat I.ddes---- | The number of /left-to-right minima/: positions @i@ such that @w[i] \< w[j]@ for all @j \< i@.-lmin :: Perm a => a -> Int-lmin = liftStat I.lmin---- | The number of /left-to-right maxima/: positions @i@ such that @w[i] \> w[j]@ for all @j \< i@.-lmax :: Perm a => a -> Int-lmax = liftStat I.lmax---- | The number of /right-to-left minima/: positions @i@ such that @w[i] \< w[j]@ for all @j \> i@.-rmin :: Perm a => a -> Int-rmin = liftStat I.rmin---- | The number of /right-to-left maxima/: positions @i@ such that @w[i] \> w[j]@ for all @j \> i@.-rmax :: Perm a => a -> Int-rmax = liftStat I.rmax---- | The first (left-most) element in the standardization. E.g., @head \"231\" = head (fromList [1,2,0]) = 1@.-head :: Perm a => a -> Int-head = liftStat I.head---- | The last (right-most) element in the standardization. E.g., @last \"231\" = last (fromList [1,2,0]) = 0@.-last :: Perm a => a -> Int-last = liftStat I.last---- | Length of the left-most increasing run: largest @i@ such that--- @w[0] \< w[1] \< ... \< w[i-1]@.-lir :: Perm a => a -> Int-lir = liftStat I.lir---- | Length of the left-most decreasing run: largest @i@ such that--- @w[0] \> w[1] \> ... \> w[i-1]@.-ldr :: Perm a => a -> Int-ldr = liftStat I.ldr---- | Length of the right-most increasing run: largest @i@ such that--- @w[n-i] \< ... \< w[n-2] \< w[n-1]@.-rir :: Perm a => a -> Int-rir = liftStat I.rir---- | Length of the right-most decreasing run: largest @i@ such that--- @w[n-i] \> ... \> w[n-2] \> w[n-1]@.-rdr :: Perm a => a -> Int-rdr = liftStat I.rdr---- | The number of components. E.g., @[2,0,3,1,4,6,7,5]@ has three--- components: @[2,0,3,1]@, @[4]@ and @[6,7,5]@.-comp :: Perm a => a -> Int-comp = liftStat I.comp---- | The number of skew components. E.g., @[5,7,4,6,3,1,0,2]@ has three--- skew components: @[5,7,4,6]@, @[3]@ and @[1,0,2]@.-scomp :: Perm a => a -> Int-scomp = liftStat I.scomp---- | The rank as defined by Elizalde and Pak [Bijections for--- refined restricted permutations, /J. Comb. Theory, Ser. A/, 2004]:--- --- > maximum [ k | k <- [0..n-1], w[i] >= k for all i < k ]--- -ep :: Perm a => a -> Int-ep = liftStat I.ep---- | The dimension of a permutation is defined as the largest--- non-fixed-point, or zero if all points are fixed.-dim :: Perm a => a -> Int-dim = liftStat I.dim---- | The number of small ascents. A /small ascent/ in @w@ is an index--- @i@ such that @w[i] + 1 == w[i+1]@.-asc0 :: Perm a => a -> Int-asc0 = liftStat I.asc0---- | The number of small descents. A /small descent/ in @w@ is an--- index @i@ such that @w[i] == w[i+1] + 1@.-des0 :: Perm a => a -> Int-des0 = liftStat I.des0---- | The size of the shadow of @w@. That is, the number of different--- one point deletions of @w@.-shad :: Perm a => a -> Int-shad = length . shadow . return . st

@@ -0,0 +1,54 @@+/* (c) Anders Claesson 2013 */++#include <stdlib.h>+#include <string.h>++/* The image of w under Simion-Schmidt is assigned to u */+void+simion_schmidt(long *u, const long *w, long len)+{+	register long i, j, x;+	long  size = len * sizeof(*w);+	long *used = alloca(size);++	memset(used, 0, size);+	x = len;++	for (i = 0; i < len; i++, w++, u++) {+		if (*w < x) {+			x = *u = *w;+		} else {+			j = x+1;+			while (j < len && used[j])+				j++;+			*u = j;+		}+		used[*u] = 1;+	}+}+++/* The image of w under the inverse of Simion-Schmidt is assigned to u */+void+simion_schmidt_inverse(long *u, const long *w, long len)+{+	register long i, j, x;+	long  size = len * sizeof(*w);+	long *used = alloca(size);++	memset(used, 0, size);+	x = len;++	for (i = 0; i < len; i++, w++, u++) {+		if (*w < x) {+			x = *u = *w;+		} else {+			j = len-1;+			while (j >= 0 && used[j])+				j--;+			*u = j;+		}+		used[*u] = 1;+	}++}

@@ -1,18 +1,20 @@- #include <strings.h>+/* (c) Anders Claesson 2013 */ +#include <strings.h>+ /* Lexicographically, the next bitmask with the same Hamming weight */-unsigned int-next(const unsigned int v)+long+next(const long v) {-	unsigned int t = v | (v - 1);+	long t = v | (v - 1); 	return ((t + 1) | (((~t & -~t) - 1) >> (__builtin_ctz(v) + 1))); }  /* Positions of bits set */ void-ones(unsigned int *u, const unsigned int a)+ones(long *u, const long a) {-	unsigned int b;+	long b;  	for (b = a; b; b &= b-1) 		*u++ = ffs(b) - 1;

@@ -0,0 +1,33 @@+/* (c) Anders Claesson 2013 */++/* The inverse of w is assigned to u */+void+inverse(long *u, const long *w, long len)+{+	register long i;++	for (i = 0; i < len; i++, w++)+		u[*w] = i;+}+++/* The reverse of w is assigned to u */+void+reverse(long *u, const long *w, long len)+{+	register long i;++	for (i = 0; i < len; i++, u++)+		*u = w[len - i - 1];+}+++/* The complement of w is assigned to u */+void+complement(long *u, const long *w, long len)+{+	register long i;++	for (i = 0; i < len; i++, u++, w++)+		*u = len - 1 - *w;+}

@@ -0,0 +1,40 @@+/* (c) Anders Claesson 2013 */++/* The permutation w is defined by w[i] = u[v[i]]. */+void+compose(long *w, const long *u, long k, const long *v, long n)+{+	register long i = 0;++	if (k < n) {+		for ( ; i < n; i++, w++, v++)+			*w = (*v < k) ? u[*v] : *v;+	} else {+		for ( ; i < n; i++, w++, v++)+			*w = u[*v];++		for ( ; i < k; i++, w++)+			*w = u[i];+	}+}++/* The permutation w is defined by w[u[i]] = v[i]. */+void+act(long *w, const long *u, long k, const long *v, long n)+{+	register long i = 0;++	if (k < n) {+		for ( ; i < k; i++, u++, v++)+			w[*u] = *v;++		for ( ; i < n; i++, v++)+			w[i] = *v;+	} else {+		for ( ; i < n; i++, u++, v++)+			w[*u] = *v;++		for ( ; i < k; i++, u++)+			w[*u] = i; +	}+}

@@ -1,27 +1,24 @@+/* (c) Anders Claesson 2013 */+ #include <stdlib.h> -/*- * Determines whether the subword in v specified by m is order+/* Determines whether the subword in v specified by m is order  * isomorphic to u; len is the length of u.  */ int ordiso(const long *u, const long *v, const long *m, long len) {-	register int i;-	long *w = malloc(len*sizeof(*w));-	long *w0 = w;+	register long i;+	long *w = alloca(len*sizeof(*w)); -        /* Let w = v.m.u^{-1} */+	/* Let w = v.m.u^{-1} */ 	for (i = 0; i < len; i++, u++, m++)-		w[(int)*u] = v[(int)*m];+		w[*u] = v[*m]; -        /* Return 1 if w is increasing, 0 otherwise */-        for (; len > 1; len--, w++) {-                if (*w > *(w+1)) {-			free(w0);+	/* Return 1 if w is increasing, 0 otherwise */+	for (; len > 1; len--, w++) {+		if (*w > *(w+1)) 			return 0;-		}-        }-	free(w0);+	} 	return 1; }

@@ -0,0 +1,66 @@+/* (c) Anders Claesson 2013 */++#include <stdlib.h>+#include <string.h>+#include <math.h>+++static inline void+swap(long *p1, long *p2)+{+	long tmp;++	tmp = *p1;+	*p1 = *p2;+	*p2 = tmp;+}+++/* Returns the rank-th (Myrvold & Ruskey) permutation of {0..len-1}.+ * E.g., len = 3 and rank = 0..5 gives 120 201 102 210 021 012+ */+void+unrank(long *w, long len, double rank)+{+	register long i;++	for (i = 0; i < len; i++)+		w[i] = i;++	for (i = len; i > 0; i--) {+		swap(w + i - 1, w + (long)fmod(rank, i));+		rank /= i;+	}+}+++/* Returns the (Myrvold & Ruskey)-rank of the length len permutation w.+ */+double+rank(long *w, long len)+{+	long s;+	long r = 0;+	long a = 1;+	long size = len * sizeof(*w);+	long *u = alloca(size);+	long *v = alloca(size);+	register long i;++	/* Let v = w */+	memcpy(v, w, size);++	/* Let u = w^{-1} */+	for (i = 0; i < len; i++, w++)+		u[*w] = i;++	while (--len > 0) {+		s = v[len];+		swap(v + len, v + u[len]);+		swap(u + s, u + len);+		r += s*a;+		a *= len+1;+	};++	return r;+}

@@ -1,20 +1,21 @@+/* (c) Anders Claesson 2013 */+ #include <stdlib.h> #include <string.h>  #define MIN(a,b) (((a)<(b))?(a):(b)) #define MAX(a,b) (((a)>(b))?(a):(b)) -/*- * Determines whether a permutation is simple.+/* Determines whether a permutation is simple.  * Based on Michael Albert's java implementation in PermLab.  */ int simple(const long *w, long len) {-	register int i, j;-	int size  = len * sizeof(*w);-	long *mins = malloc(size);-	long *maxs = malloc(size);+	register long i, j;+	long  size = len * sizeof(*w);+	long *mins = alloca(size);+	long *maxs = alloca(size); 	 	memcpy(mins, w, size); 	memcpy(maxs, w, size);@@ -23,14 +24,9 @@ 		for (j = len-1; j >= i; j--) { 			mins[j] = MIN(mins[j-1], w[j]); 			maxs[j] = MAX(maxs[j-1], w[j]);-			if (maxs[j] - mins[j] == i) {-				free(mins);-				free(maxs);+			if (maxs[j] - mins[j] == i) 				return 0;-			} 		} 	}-	free(mins);-	free(maxs); 	return 1; }

@@ -1,21 +1,28 @@+/* (c) Anders Claesson 2013 */ +#include <string.h>+ /* One pass of stack-sort implemented a la Petter Br\"and\'en [Actions  * on permutations and unimodality of descent polynomials, European  * J. Combin. 29 (2008)]  */ void-stacksort(long *w, long len) {-        int i = 0;-        int j = 0;-        int y;+stacksort(long *u, long *w, long len) {+        long i = 0;+        long j = 0;+        long y;+	long size = len * sizeof(*w);++	memcpy(u, w, size);+         while (i < len) {                 j = i;-                y = w[j];-                while (y > w[j+1] && j+1 < len) {-                        w[j] = w[j+1];+                y = u[j];+                while (y > u[j+1] && j+1 < len) {+                        u[j] = u[j+1];                         j++;                 }-                w[j] = y;+                u[j] = y;                 if (j == i) 			i++;         }@@ -23,13 +30,17 @@  /* On pass of bubble-sort */ void-bubblesort(long *w, long len) {-        int tmp;-	for (; len > 1; len--, w++) {-		if (*w > *(w+1)) {-			tmp    = *w;-			*w     = *(w+1);-			*(w+1) = tmp;+bubblesort(long *u, long *w, long len) {+        long tmp;+	long size = len * sizeof(*w);++	memcpy(u, w, size);++	for (; len > 1; len--, u++) {+		if (*u > *(u+1)) {+			tmp    = *u;+			*u     = *(u+1);+			*(u+1) = tmp; 		} 	} }

@@ -1,5 +1,9 @@+/* (c) Anders Claesson 2013 */++#include <stdlib.h> #include <string.h> + /* The number of ascents */ long asc(const long *w, long len)@@ -56,6 +60,24 @@ }  +/* The number of strong fixed points */+long+sfp(const long *w, long len)+{+	long m = *w - 1;+	long i, acc = 0;++	for (i = 0; i < len; i++, w++) {+		if (*w > m) {+			m = *w;+			if (m == i)+				acc++;+		}+	}+	return acc;+}++ /* The number of cycles */ long cyc(const long *w, long len)@@ -77,6 +99,7 @@ 		} 		i = j; 	}+	free(called); 	return acc; } 

@@ -0,0 +1,4 @@+/* (c) Anders Claesson 2013 */++void simion_schmidt(long *, const long *, long);+void simion_schmidt_inverse(long *, const long *, long);

@@ -1,2 +1,4 @@+/* (c) Anders Claesson 2013 */+ unsigned int next(unsigned int); void ones(unsigned int *, const unsigned int);

@@ -0,0 +1,5 @@+/* (c) Anders Claesson 2013 */++void inverse(long, const long *, long);+void reverse(long, const long *, long);+void complement(long, const long *, long);

@@ -0,0 +1,4 @@+/* (c) Anders Claesson 2013 */++void compose (long *, const long *, const long *, long);+void act     (long *, const long *, const long *, long);

@@ -1,1 +1,3 @@+/* (c) Anders Claesson 2013 */+ int ordiso(const long *, const long *, const long *, long);

@@ -0,0 +1,4 @@+/* (c) Anders Claesson 2013 */++void unrank(long *, long, double);+double rank(long *, long);

@@ -1,1 +1,3 @@+/* (c) Anders Claesson 2013 */+ int simple(const long *, long);

@@ -1,1 +1,4 @@-void stacksort(long *, long);+/* (c) Anders Claesson 2013 */++void stacksort (long *, long *, long);+void bubblesort(long *, long *, long);

@@ -1,7 +1,10 @@+/* (c) Anders Claesson 2013 */+ long asc  (const long *, long); long des  (const long *, long); long exc  (const long *, long); long fp   (const long *, long);+long sfp  (const long *, long); long cyc  (const long *, long); long inv  (const long *, long); long maj  (const long *, long);

@@ -1,61 +1,58 @@-Name:                sym-Version:             0.8-Synopsis:            Permutations, patterns, and statistics-Description:         +name:                sym+version:             0.9+synopsis:            Permutations, patterns, and statistics+description:   Definitions for permutations with an emphasis on permutation-  patterns and statistics.-  .-  ["Math.Sym"] Provides an efficient definition of standard-  permutations, @StPerm@, together with a typeclass, @Perm@,  whose-  functionality is largely inherited from @StPerm@ using a group-  action and the standardization map.-  .-  ["Math.Sym.D8"] The dihedral group of order 8 acting on permutations.-  .-  ["Math.Sym.Stat"] Common permutation statistics, such as @des@,-  @inv@, @exc@, @maj@, @fp@, @comp@, @lmin@, @lmax@, ...-  .-  ["Math.Sym.Class"] Common permutation classes.-  .-  ["Math.Sym.Bijection"] Bijections between sets of permutations.--Homepage:            http://github.com/akc/sym--License:             BSD3-License-file:        LICENSE-Author:              Anders Claesson-Maintainer:          anders.claesson@gmail.com-Category:            Math-Build-type:          Simple--Extra-source-files:  tests/Properties.hs+  patterns and permutation statistics. -Cabal-version:       >=1.6+homepage:            https://github.com/akc/sym+license:             BSD3+license-file:        LICENSE+author:              Anders Claesson+maintainer:          anders.claesson@gmail.com+category:            Data+build-type:          Simple+cabal-version:       >=1.8  source-repository head   type:                git   location:            git://github.com/akc/sym.git -Library-  Exposed-modules:     Math.Sym-                       Math.Sym.D8-                       Math.Sym.Stat-                       Math.Sym.Class-                       Math.Sym.Bijection-                       Math.Sym.Internal+library+  exposed-modules:     Data.CLongArray+                       Data.Perm+                       Data.Permgram+                       Math.Perm+                       Math.Perm.Component+                       Math.Perm.Constructions+                       Math.Perm.D8+                       Math.Perm.Group+                       Math.Perm.Bijection+                       Math.Perm.Stat+                       Math.Perm.Sort+                       Math.Perm.Simple+                       Math.Perm.Pattern+                       Math.Perm.Class+                       Math.Sym -  Build-depends:       base >= 3 && < 5, random, vector, containers-  +  other-modules:       Data.Perm.Internal++  build-depends:       base >= 3 && <= 4.7, array >=0.4, hashable >=1.1, QuickCheck >=2.5+   ghc-prof-options:    -auto-all-  ghc-options:         -Wall -O2+  ghc-options:         -Wall   cc-options:          -Wall -  c-sources:           cbits/stat.c-                       cbits/sortop.c+  c-sources:           cbits/rank.c+                       cbits/stat.c+                       cbits/d8.c+                       cbits/group.c+                       cbits/bij.c                        cbits/ordiso.c-                       cbits/simple.c                        cbits/bit.c+                       cbits/simple.c+                       cbits/sortop.c    include-dirs:        include-  includes:            stat.h, sortop.h, ordiso.h, simple.h, bit.h-  install-includes:    stat.h, sortop.h, ordiso.h, simple.h, bit.h+  includes:            rank.h, stat.h, d8.h, group.h, bij.h, ordiso.h, bit.h, simple.h, sortop.h+  install-includes:    rank.h, stat.h, d8.h, group.h, bij.h, ordiso.h, bit.h, simple.h, sortop.h

@@ -1,769 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Copyright   : (c) Anders Claesson 2012, 2013--- License     : BSD-style--- Maintainer  : Anders Claesson <anders.claesson@gmail.com>--import Data.Ord-import Data.List-import Data.Monoid-import Data.Function-import Control.Monad-import Math.Sym (StPerm, IntPerm(..), CharPerm(..))-import qualified Math.Sym as Sym-import qualified Math.Sym.D8 as D8-import qualified Math.Sym.Stat as S-import qualified Math.Sym.Class as C-import qualified Math.Sym.Bijection as B-import qualified Math.Sym.Internal as I-import qualified Data.Vector.Storable as SV-import Test.QuickCheck--check :: Testable prop => prop -> IO ()-check = quickCheck-------------------------------------------------------------------------------------- Generators------------------------------------------------------------------------------------rank :: Int -> Gen Integer-rank n = choose (0, product [1..fromIntegral n] - 1)--lenRank :: Gen (Int, Integer)-lenRank = sized $ \m -> do-            n <- choose (0, m)-            r <- rank n-            return (n, r)--lenRank2 :: Gen (Int, Integer, Integer)-lenRank2 = do-  (n, r1) <- lenRank-  r2 <- rank n-  return (n, r1, r2)--lenRank3 :: Gen (Int, Integer, Integer, Integer)-lenRank3 = do-  (n, r1, r2) <- lenRank2-  r3 <- rank n-  return (n, r1, r2, r3)---- The sub-permutation determined by a set of indices.-subperm :: Sym.Set -> StPerm -> StPerm-subperm m w = Sym.fromVector . I.st $ SV.map ((SV.!) (Sym.toVector w)) m--subperms :: Int -> StPerm -> [StPerm]-subperms k w = [ subperm m w | m <- Sym.subsets (Sym.size w) k ]--instance Arbitrary StPerm where-    arbitrary = uncurry Sym.unrankPerm `liftM` lenRank-    shrink w = nub $ [0 .. Sym.size w - 1] >>= \k -> subperms k w--instance Arbitrary CharPerm where-    arbitrary = Sym.cast `liftM` (arbitrary :: Gen StPerm)--instance Arbitrary IntPerm where-    arbitrary = Sym.cast `liftM` (arbitrary :: Gen StPerm)--perm2 :: Gen (StPerm, IntPerm)-perm2 = do-  (n,r1,r2) <- lenRank2-  let u = Sym.unrankPerm n r1-  let v = Sym.unrankPerm n r2-  return (u, v)--perm3 :: Gen (StPerm, StPerm, IntPerm)-perm3 = do-  (n,r1,r2,r3) <- lenRank3-  let u = Sym.unrankPerm n r1-  let v = Sym.unrankPerm n r2-  let w = Sym.unrankPerm n r3-  return (u, v, w)--stPermsOfEqualLength :: Gen [StPerm]-stPermsOfEqualLength = sized $ \m -> do-  n  <- choose (0,m)-  k  <- choose (0,m^2)-  rs <- replicateM k $ rank n-  return $ nub $ map (Sym.unrankPerm n) rs--newtype Symmetry = Symmetry (StPerm -> StPerm, String)--d8Symmetries :: [Symmetry]-d8Symmetries = [ Symmetry (D8.r0, "r0")-               , Symmetry (D8.r1, "r1")-               , Symmetry (D8.r2, "r2")-               , Symmetry (D8.r3, "r3")-               , Symmetry (D8.s0, "s0")-               , Symmetry (D8.s1, "s1")-               , Symmetry (D8.s2, "s2")-               , Symmetry (D8.s3, "s3")-               ]--instance Show Symmetry where-    show (Symmetry (_,s)) = s--instance Arbitrary Symmetry where-    arbitrary = liftM (d8Symmetries !!) $ choose (0, length d8Symmetries - 1)--------------------------------------------------------------------------------------- Properties for Math.Sym------------------------------------------------------------------------------------prop_monoid_mempty1 w = mempty <> w == (w :: StPerm)-prop_monoid_mempty2 w = w <> mempty == (w :: StPerm)-prop_monoid_associative u v w = u <> (v <> w) == (u <> v) <> (w :: StPerm)--newtype S = S {unS :: StPerm} deriving (Eq, Show)--instance Arbitrary S where-    arbitrary = liftM S arbitrary--instance Monoid S where-    mempty = S $ Sym.fromVector SV.empty-    mappend u v = S $ (Sym.\-\) (unS u) (unS v)--prop_monoid_mempty1_S w = mempty <> w == (w :: S)-prop_monoid_mempty2_S w = w <> mempty == (w :: S)-prop_monoid_associative_S u v w = u <> (v <> w) == (u <> v) <> (w :: S)--neutralize :: Sym.Perm a => a -> a-neutralize = Sym.idperm . Sym.size--forAllPermEq f g w = f w == g (w :: IntPerm)--prop_unrankPerm_distinct =-    forAll lenRank $ \(n, r) ->-        let w = Sym.toList (Sym.unrankPerm n r) in nub w == w--prop_unrankPerm_injective =-    forAll lenRank2 $ \(n, r1, r2) ->-        (Sym.unrankPerm n r1 :: StPerm) /= Sym.unrankPerm n r2 || r1 == r2--prop_sym = and [ sort (Sym.sym n) == sort (sym' n) | n<-[0..6] ]-    where-      sym' n = map Sym.fromList $ Data.List.permutations [0..fromIntegral n - 1]--prop_perm =-    and [ map ints (sort (Sym.perms n)) == sort (permutations [1..n]) | n<-[0..6::Int] ]--prop_st =-    forAll perm2 $ \(u,v) -> Sym.st (u `Sym.act` v) == u `Sym.act` Sym.st v--prop_act_def =-    forAll perm2 $ \(u,v) -> u `Sym.act` v == IntPerm (map (ints v !!) (Sym.toList u))--prop_act_id =-    forAll perm2 $ \(u,v) -> neutralize u `Sym.act` v == v--prop_act_associative =-    forAll perm3 $ \(u,v,w) -> (u `Sym.act` v) `Sym.act` w == u `Sym.act` (v `Sym.act` w)--prop_size = Sym.size `forAllPermEq` (Sym.size . Sym.st)--prop_neutralize = neutralize `forAllPermEq` (\u -> Sym.inverse (Sym.st u) `Sym.act` u)--prop_inverse = forAllPermEq Sym.inverse $ \v -> Sym.inverse (Sym.st v) `Sym.act` neutralize v--prop_ordiso1 =-    forAll perm2 $ \(u,v) -> u `Sym.ordiso` v == (u == Sym.st v)--prop_ordiso2 =-    forAll perm2 $ \(u,v) ->-        u `Sym.ordiso` v == (Sym.inverse u `Sym.act` v == neutralize v)--shadow :: Ord a => [a] -> [[a]]-shadow w = nubsort . map normalize $ ptDeletions w-    where-      w' = sort w-      normalize u = [ w'!!i | i <- st u ]-      nubsort = map head . group . sort-      ptDeletions [] = []-      ptDeletions xs@(x:xt) = xt : map (x:) (ptDeletions xt)--prop_shadow = forAll (resize 30 arbitrary) $ \w -> Sym.shadow [w] == map IntPerm (shadow (ints w))--prop_downset_shadow =-    forAll (resize 10 arbitrary) $ \w ->-        [ v | v <- Sym.downset [w], 1 + Sym.size v == Sym.size w ] == Sym.shadow [w :: CharPerm]--prop_downset_orderideal =-    forAll (resize 9 arbitrary) $ \w -> null [ v | v <- Sym.downset [w :: CharPerm]-                                             , w `Sym.avoids` v-                                             ]--coshadow :: Integral a => [a] -> [[Int]]-coshadow w = nub . sort . map (map (+1) . st) $ [0..length w] >>= \i ->-             ptExtensions (fromIntegral i + 0.5) (map fromIntegral w)-    where-      ptExtensions n [] = [[n]]-      ptExtensions n xs@(x:xt) = (n:xs) : map (x:) (ptExtensions n xt)--prop_coshadow = forAll (resize 12 arbitrary) $ \w -> Sym.coshadow [w] == map IntPerm (coshadow (ints w))--prop_coeff =-    forAll (resize 5 arbitrary) $ \u ->-    forAll (resize 6 arbitrary) $ \v ->-        Sym.coeff (Sym.stat u) (v :: CharPerm) == fromEnum (u==v)--prop_minima_antichain =-    forAll (resize 14 arbitrary) $ \ws ->-        let vs = Sym.minima ws in and [ (v::StPerm) `Sym.avoidsAll` (vs \\ [v]) | v <- vs ]--prop_minima_smallest =-    forAll (resize 14 arbitrary) $ \ws ->-        let vs = Sym.minima ws in and [ not ((w::StPerm) `Sym.avoidsAll` vs) | w <- ws ]--prop_maxima_antichain =-    forAll (resize 12 arbitrary) $ \ws ->-        let vs = Sym.maxima ws in and [ (v::StPerm) `Sym.avoidsAll` (vs \\ [v]) | v <- vs ]--recordIndicesAgree f g w = SV.fromList (recordIndices w) == f w-    where-      w' = ints w-      recordIndices w = [ head $ elemIndices x w' | x <- g w' ]--prop_lMaxima = recordIndicesAgree Sym.lMaxima lMaxima-prop_lMinima = recordIndicesAgree Sym.lMinima lMinima-prop_rMaxima = recordIndicesAgree Sym.rMaxima rMaxima-prop_rMinima = recordIndicesAgree Sym.rMinima rMinima--prop_lMaxima_card = S.lmax `forAllPermEq` (SV.length . Sym.lMaxima)-prop_lMinima_card = S.lmin `forAllPermEq` (SV.length . Sym.lMinima)-prop_rMaxima_card = S.rmax `forAllPermEq` (SV.length . Sym.rMaxima)-prop_rMinima_card = S.rmin `forAllPermEq` (SV.length . Sym.rMinima)---- The list of indices of components in a permutation-components w = lMaxima w `cap` rMinima (bubble w)---- The list of indices of skew components in a permutation-skewComponents w = components $ map (\x -> length w - x - 1) w--prop_components = (components . st . ints) `forAllPermEq` (SV.toList . Sym.components)--prop_skewComponents = (skewComponents . st . ints) `forAllPermEq` (SV.toList . Sym.skewComponents)--prop_dsum u v = (Sym./+/) u v == Sym.inflate ("12" :: CharPerm) [u, v :: CharPerm]--prop_ssum u v = (Sym.\-\) u v == Sym.inflate ("21" :: CharPerm) [u, v :: CharPerm]--inflate :: [Int] -> [[Int]] -> [Int]-inflate w vs = sort [ (i, map (+c) u) | (i, c, u) <- zip3 w' cs us ] >>= snd-    where-      (_, w',us) = unzip3 . sort $ zip3 w [0..] vs-      cs = scanl (\i u -> i + length u) 0 us--prop_inflate u0 u1 u2 u3 =-    let us = [u0, u1, u2, u3]-    in and [ IntPerm (inflate w (map ints us)) == Sym.inflate (IntPerm w) us | w <- permutations [1..4] ]--segments :: [a] -> [[a]]-segments [] = [[]]-segments (x:xs) = segments xs ++ map (x:) (inits xs)--nonEmptySegments :: [a] -> [[a]]-nonEmptySegments = drop 1 . segments--properSegments :: [a] -> [[a]]-properSegments xs = [ ys | ys@(_:_:_) <- init $ segments xs ]--properIntervals :: Ord a => [a] -> [[a]]-properIntervals xs = [ ys | ys <- yss, sort ys `elem` zss ]-    where-      yss = properSegments xs-      zss = properSegments $ sort xs--simple :: Ord a => [a] -> Bool-simple = null . properIntervals--prop_simple = forAll (resize 40 arbitrary) $ \w -> Sym.simple w == simple (ints w)--prop_stackSort = Sym.stackSort `forAllPermEq` (IntPerm . stack . ints)--prop_stackSort_231 =-  (\v -> Sym.stackSort v == neutralize v) `forAllPermEq` (`Sym.avoids` ("231" :: CharPerm))--prop_bubbleSort = Sym.bubbleSort `forAllPermEq` (IntPerm . bubble . ints)--prop_bubbleSort_231_321 = f `forAllPermEq` g-    where f v = Sym.bubbleSort v == neutralize v-          g v = v `Sym.avoidsAll` ["231", "321" :: CharPerm]--prop_subperm_copies p =-    forAll (resize 21 arbitrary) $ \w ->-        and [ subperm m (Sym.st w) == p | m <- Sym.copiesOf p (w :: CharPerm) ]--prop_copies =-    forAll (resize  6 arbitrary) $ \p ->-    forAll (resize 12 arbitrary) $ \w ->-        sort (Sym.copiesOf p w) == sort (map I.fromList $ copies (Sym.toList p) (ints w))--prop_copies_self v = Sym.copiesOf v (v :: CharPerm) == [SV.fromList [0 .. Sym.size v - 1]]--prop_copies_d8 (Symmetry (f,_)) =-    forAll (resize  6 arbitrary) $ \p ->-    forAll (resize 20 arbitrary) $ \w ->-        let p' = f p-            w' = (Sym.unst . f . Sym.st) (w :: CharPerm)-        in Sym.stat p w == Sym.stat p' (w' :: CharPerm)--prop_avoiders_avoid =-    forAll (resize 20 arbitrary) $ \ws ->-    forAll (resize  6 arbitrary) $ \ps ->-        all (`Sym.avoidsAll` ps) $ Sym.avoiders (ps :: [StPerm]) (ws :: [StPerm])--prop_avoiders_idempotent =-    forAll (resize 18 arbitrary) $ \vs ->-    forAll (resize  5 arbitrary) $ \ps ->-        let ws = Sym.avoiders (ps :: [StPerm]) (vs :: [StPerm])-        in  ws == Sym.avoiders ps ws--prop_avoiders_d8 (Symmetry (f,_)) =-    forAll (choose (0, 5))      $ \n ->-    forAll (resize 5 arbitrary) $ \p ->-        let ws = Sym.sym n-        in sort (map f $ Sym.avoiders [p] ws) == sort (Sym.avoiders [f p] ws)--prop_avoiders_d8' (Symmetry (f,_)) =-    forAll (choose (0, 5))      $ \n ->-    forAll (resize 5 arbitrary) $ \ps ->-        let ws = Sym.sym n-        in sort (map f $ Sym.avoiders ps ws) == sort (Sym.avoiders (map f ps) (map f ws))--prop_avoiders_d8'' (Symmetry (f,_)) =-    forAll (resize 18 arbitrary) $ \ws ->-    forAll (resize  5 arbitrary) $ \ps ->-        sort (map f $ Sym.avoiders ps ws) == sort (Sym.avoiders (map f ps) (map f ws :: [StPerm]))--prop_av_cardinality =-    forAll (resize 3 arbitrary) $ \p ->-        let spec = [ length $ Sym.av [p :: StPerm] n | n<-[0..6] ]-        in case Sym.size p of-             0 -> spec == [0,0,0,0,0,0,0]-             1 -> spec == [1,0,0,0,0,0,0]-             2 -> spec == [1,1,1,1,1,1,1]-             3 -> spec == [1,1,2,5,14,42,132]-             _ -> True--binomial n k = fromIntegral $ product [n', n'-1 .. n'-k'+1] `div` product [1..k']-    where-      n' = toInteger n-      k' = toInteger k--kSubsequences :: Int -> [a] -> [[a]]-kSubsequences 0 _      = [[]]-kSubsequences _ []     = []-kSubsequences k (x:xs) = map (x:) (kSubsequences (k-1) xs) ++ kSubsequences k xs--copies :: [Int] -> [Int] -> [[Int]]-copies p w = [ is | js <- u, let (is, q) = unzip (f js (zip [0..] w)), st q == p ]-    where-      k = length p-      n = length w-      u = kSubsequences k [0..n-1]-      f s@(j:t) ((i,x):v) = if i == j then (i,x) : f t v else f s v-      f _       _         = []--prop_subsets1 =-    forAll (choose (0,13)) $ \n ->-    forAll (choose (0,13)) $ \k ->-        sort (kSubsequences k [0..n-1]) == sort (map SV.toList $ Sym.subsets n k)--prop_subsets2 =-    forAll (choose (0,33)) $ \n ->-    forAll (choose (0,3))  $ \k ->-        sort (kSubsequences k [0..n-1]) == sort (map SV.toList $ Sym.subsets n k)--prop_subsets_singleton =-    forAll (choose (0,500)) $ \n ->-        let [v] = Sym.subsets n n in SV.toList v == [0..n-1]--prop_subsets_cardinality1 =-    forAll (choose (0,16)) $ \n ->-    forAll (choose (0,16)) $ \k ->-        length (Sym.subsets n k) == binomial n k--prop_subsets_cardinality2 =-    forAll (choose (0,16)) $ \n ->-    forAll (choose (0,16)) $ \k ->-        let cs = map SV.length (Sym.subsets n k)-        in ((k > n) && null cs) || ([k] == nub cs)--testsPerm =-    [ ("monoid/mempty/1",                check prop_monoid_mempty1)-    , ("monoid/mempty/2",                check prop_monoid_mempty2)-    , ("monoid/mempty/associative",      check prop_monoid_associative)-    , ("monoid/mempty/1/skew",           check prop_monoid_mempty1_S)-    , ("monoid/mempty/2/skew",           check prop_monoid_mempty2_S)-    , ("monoid/mempty/associative/skew", check prop_monoid_associative_S)-    , ("unrankPerm/distinct",            check prop_unrankPerm_distinct)-    , ("unrankPerm/injective",           check prop_unrankPerm_injective)-    , ("sym",                            check prop_sym)-    , ("perm",                           check prop_perm)-    , ("st",                             check prop_st)-    , ("act/def",                        check prop_act_def)-    , ("act/id",                         check prop_act_id)-    , ("act/associative",                check prop_act_associative)-    , ("size",                           check prop_size)-    , ("neutralize",                     check prop_neutralize)-    , ("inverse",                        check prop_inverse)-    , ("ordiso/1",                       check prop_ordiso1)-    , ("ordiso/2",                       check prop_ordiso2)-    , ("shadow",                         check prop_shadow)-    , ("coshadow",                       check prop_coshadow)-    , ("coeff",                          check prop_coeff)-    , ("downset/shadow",                 check prop_downset_shadow)-    , ("downset/orderideal",             check prop_downset_orderideal)-    , ("minima/smallest",                check prop_minima_smallest)-    , ("minima/antichain",               check prop_minima_antichain)-    , ("maxima/antichain",               check prop_maxima_antichain)-    , ("simple",                         check prop_simple)-    , ("lMaxima",                        check prop_lMaxima)-    , ("lMinima",                        check prop_lMinima)-    , ("rMaxima",                        check prop_rMaxima)-    , ("rMinima",                        check prop_rMinima)-    , ("lMaxima/card",                   check prop_lMaxima_card)-    , ("lMinima/card",                   check prop_lMinima_card)-    , ("rMaxima/card",                   check prop_rMaxima_card)-    , ("rMinima/card",                   check prop_rMinima_card)-    , ("components",                     check prop_components)-    , ("dsum",                           check prop_dsum)-    , ("ssum",                           check prop_ssum)-    , ("inflate",                        check prop_inflate)-    , ("skewComponents",                 check prop_skewComponents)-    , ("stackSort",                      check prop_stackSort)-    , ("stackSort/231",                  check prop_stackSort_231)-    , ("bubbleSort",                     check prop_bubbleSort)-    , ("bubbleSort/231&321",             check prop_bubbleSort_231_321)-    , ("subperm/copies",                 check prop_subperm_copies)-    , ("copies",                         check prop_copies)-    , ("copies/self",                    check prop_copies_self)-    , ("copies/D8",                      check prop_copies_d8)-    , ("avoiders/avoid",                 check prop_avoiders_avoid)-    , ("avoiders/idempotent",            check prop_avoiders_idempotent)-    , ("avoiders/D8/0",                  check prop_avoiders_d8)-    , ("avoiders/D8/1",                  check prop_avoiders_d8')-    , ("avoiders/D8/2",                  check prop_avoiders_d8'')-    , ("av/cardinality",                 check prop_av_cardinality)-    , ("subsets/1",                      check prop_subsets1)-    , ("subsets/2",                      check prop_subsets2)-    , ("subsets/singleton",              check prop_subsets_singleton)-    , ("subsets/cardinality/1",          check prop_subsets_cardinality1)-    , ("subsets/cardinality/2",          check prop_subsets_cardinality2)-    ]-------------------------------------------------------------------------------------- Properties for Math.Sym.D8------------------------------------------------------------------------------------fn (Symmetry (f,_)) = f--prop_D8_orbit fs w = all (`elem` orbD8) $ D8.orbit (map fn fs) w-    where-      orbD8 = D8.orbit D8.d8 (w :: StPerm)--symmetriesAgrees f g = (f . Sym.toVector) `forAllPermEq` (Sym.toVector . g)--prop_D8_reverse    = symmetriesAgrees I.reverse    D8.reverse-prop_D8_complement = symmetriesAgrees I.complement D8.complement-prop_D8_inverse    = symmetriesAgrees I.inverse    D8.inverse-prop_D8_rotate     = symmetriesAgrees I.rotate     D8.rotate---- Auxilary function that partitions a list xs with respect to the--- equivalence induced by a function f; i.e. x ~ y iff f x == f y.--- The time complexity is the same as for sorting, O(n log n).-eqClasses :: Ord a => (b -> a) -> [b] -> [[b]]-eqClasses f xs = (map . map) snd . group' $ sort' [ (f x, x) | x <- xs ]-    where-      group' = groupBy ((==) `on` fst)-      sort' = sortBy $ comparing fst--symmetryClasses :: (Ord a, Sym.Perm a) => [a -> a] -> [a] -> [[a]]-symmetryClasses fs xs = sort . map sort $ eqClasses (D8.orbit fs) xs--symmetryClassesByGroup fs =-    forAll (resize 10 stPermsOfEqualLength) $ \ws ->-        symmetryClasses fs ws == D8.symmetryClasses fs ws--prop_symmetryClasses_d8     = symmetryClassesByGroup D8.d8-prop_symmetryClasses_klein4 = symmetryClassesByGroup D8.klein4-prop_symmetryClasses_ei     = symmetryClassesByGroup [D8.id, D8.inverse]-prop_symmetryClasses_er     = symmetryClassesByGroup [D8.id, D8.reverse]-prop_symmetryClasses_ec     = symmetryClassesByGroup [D8.id, D8.complement]--testsD8 =-    [ ("D8/orbit",                   check prop_D8_orbit)-    , ("D8/reverse",                 check prop_D8_reverse)-    , ("D8/complement",              check prop_D8_complement)-    , ("D8/inverse",                 check prop_D8_inverse)-    , ("D8/rotate",                  check prop_D8_rotate)-    , ("D8/symmetryClasses/ei",      check prop_symmetryClasses_ei)-    , ("D8/symmetryClasses/er",      check prop_symmetryClasses_er)-    , ("D8/symmetryClasses/ec",      check prop_symmetryClasses_ec)-    , ("D8/symmetryClasses/d8",      check prop_symmetryClasses_d8)-    , ("D8/symmetryClasses/klein4",  check prop_symmetryClasses_klein4)-    ]-------------------------------------------------------------------------------------- Properties for Math.Sym.Stat-------------------------------------------------------------------------------------- the group theoretical inverse of w-inverse :: (Ord a) => [a] -> [Int]-inverse w = map snd . sort $ zip w [0..]---- the standardization of w-st :: (Ord a) => [a] -> [Int]-st = inverse . inverse--ascents, descents :: (Ord a) => [a] -> [(a, a)]-ascents  w = filter (uncurry (<)) $ zip w (tail w)-descents w = filter (uncurry (>)) $ zip w (tail w)--peaks          w = [ v | v@(x,y,z) <- zip3 w (tail w) (tail (tail w)), x < y, y > z ]-valleys        w = [ v | v@(x,y,z) <- zip3 w (tail w) (tail (tail w)), x > y, y < z ]-doubleAscents  w = [ v | v@(x,y,z) <- zip3 w (tail w) (tail (tail w)), x < y, y < z ]-doubleDescents w = [ v | v@(x,y,z) <- zip3 w (tail w) (tail (tail w)), x > y, y > z ]--inversions :: (Ord a) => [a] -> [(a, a)]-inversions w = init (tails w) >>= \(x:xs) -> [ (x,y) | y<-xs, x > y ]--records :: (a -> a -> Bool) -> [a] -> [a]-records f []     = []-records f (x:xs) = records' f [x] xs where-    records' f recs       []     = recs-    records' f recs@(r:_) (x:xs) = records' f (if f r x then x:recs else recs) xs--lMinima, lMaxima, rMinima, rMaxima :: (Ord a) => [a] -> [a]--lMinima = reverse . records (>)-lMaxima = reverse . records (<)-rMinima = records (>) . reverse-rMaxima = records (<) . reverse--excedances  xs = map fst . filter (\(i,a)->i <  fromIntegral a) $ zip [0..] xs-fixedpoints xs = map fst . filter (\(i,a)->i == fromIntegral a) $ zip [0..] xs--orbit :: Eq a => (a -> a) -> a -> [a]-orbit f x = y:takeWhile (/=y) ys where (y:ys) = iterate f x--orbits :: Eq a => (a -> a) -> [a] -> [[a]]-orbits f [] = []-orbits f (x:xs) = ys:orbits f (xs\\ys) where ys = orbit f x--exc, fp :: [Int] -> Int-exc = length . excedances . st-fp  = length . fixedpoints . st--cyc :: [Int] -> Int-cyc w = let v = st w in length $ orbits (v!!) v--runs :: Ord a => (a -> a -> Bool) -> [a] -> [a] -> [[a]]-runs _ [] [] = []-runs _ rs [] = [rs]-runs f [] (x:xs) = runs f [x] xs-runs f u@(r:_) v@(x:xs) | f r x = runs f (x:u) xs-                        | otherwise = u : runs f [x] xs--decruns :: Ord a => [a] -> [[a]]-decruns = runs (>) []--incruns :: Ord a => [a] -> [[a]]-incruns = runs (<) []--ldr, rdr, lir, rir :: (Ord a) => [a] -> Int--ldr [] = 0-ldr xs = length . head $ decruns xs--rdr [] = 0-rdr xs = length . last $ decruns xs--lir [] = 0-lir xs = length . head $ incruns xs--rir [] = 0-rir xs = length . last $ incruns xs---- The stack-sort operator-stack [] = []-stack xs = stack left ++ stack right ++ [n]-    where-      (left, n:right) = span ( < maximum xs) xs---- The bubble-sort operator; i.e. one pass of the classical bubble--- sort algorithm-bubble :: Ord a => [a] -> [a]-bubble = bub []-    where-      bub xs []       = reverse xs-      bub [] (y:ys)   = bub [y] ys-      bub (x:xs) (y:ys)-          | x < y     = bub (y:x:xs) ys-          | otherwise = bub (x:y:xs) ys---- Like Data.List.intersect, but by assuming that the lists are sorted--- uses a faster algorithm-cap :: Ord a => [a] -> [a] -> [a]-cap [] ys = []-cap xs [] = []-cap xs@(x:xt) ys@(y:yt) = case compare x y of-                            EQ -> x : cap xt yt-                            LT -> cap xt ys-                            GT -> cap xs yt---- The number of components in a permutation-comp = length . components---- The number of skew components in a permutation-scomp = length . skewComponents---- rank a la Elizalde-ep = fst . last . filter (\(k,ys) -> all (k<=) ys) . zip [0..] . inits . st--des, asc, inv, lmin, lmax, rmin, rmax, peak, vall :: [Int] -> Int-dasc, ddes, maj, comp, ep, dim :: [Int] -> Int--dim   w = maximum $ 0 : [ i | (i,x) <- zip [0..] (st w), i /= x ]-maj   w = sum [ i | (i,x,y) <- zip3 [1..] w (tail w), x > y ]-comaj w = sum [ n-i | (i,x,y) <- zip3 [1..] w (tail w), x > y ] where n = length w-asc0  w = sum [ 1 | (x,y) <- ascents  $ st w, y-x == 1 ]-des0  w = sum [ 1 | (x,y) <- descents $ st w, x-y == 1 ]--asc  = length . ascents-des  = length . descents-inv  = length . inversions-lmin = length . lMinima-lmax = length . lMaxima-rmin = length . rMinima-rmax = length . rMaxima-peak = length . peaks-vall = length . valleys-dasc = length . doubleAscents-ddes = length . doubleDescents-shad = length . shadow--prop_asc    = forAllPermEq  (asc   . ints)  S.asc-prop_des    = forAllPermEq  (des   . ints)  S.des-prop_exc    = forAllPermEq  (exc   . ints)  S.exc-prop_fp     = forAllPermEq  (fp    . ints)  S.fp-prop_cyc    = forAllPermEq  (cyc   . ints)  S.cyc-prop_inv    = forAllPermEq  (inv   . ints)  S.inv-prop_maj    = forAllPermEq  (maj   . ints)  S.maj-prop_comaj  = forAllPermEq  (comaj . ints)  S.comaj-prop_lmin   = forAllPermEq  (lmin  . ints)  S.lmin-prop_lmax   = forAllPermEq  (lmax  . ints)  S.lmax-prop_rmin   = forAllPermEq  (rmin  . ints)  S.rmin-prop_rmax   = forAllPermEq  (rmax  . ints)  S.rmax-prop_head w = (w /= Sym.empty) ==> head (ints w) == 1 + S.head w-prop_last w = (w /= Sym.empty) ==> last (ints w) == 1 + S.last w-prop_peak   = forAllPermEq  (peak  . ints)  S.peak-prop_vall   = forAllPermEq  (vall  . ints)  S.vall-prop_dasc   = forAllPermEq  (dasc  . ints)  S.dasc-prop_ddes   = forAllPermEq  (ddes  . ints)  S.ddes-prop_ep     = forAllPermEq  (ep    . ints)  S.ep-prop_lir    = forAllPermEq  (lir   . ints)  S.lir-prop_ldr    = forAllPermEq  (ldr   . ints)  S.ldr-prop_rir    = forAllPermEq  (rir   . ints)  S.rir-prop_rdr    = forAllPermEq  (rdr   . ints)  S.rdr-prop_comp   = forAllPermEq  (comp  . ints)  S.comp-prop_scomp  = forAllPermEq  (scomp . ints)  S.scomp-prop_dim    = forAllPermEq  (dim   . ints)  S.dim-prop_asc0   = forAllPermEq  (asc0  . ints)  S.asc0-prop_des0   = forAllPermEq  (des0  . ints)  S.des0-prop_shad   = forAllPermEq  (shad  . ints)  S.shad-prop_inv_21 = forAll (resize 30 arbitrary) $ \w -> S.inv (w :: IntPerm) == Sym.stat ("21" :: CharPerm) w--testsStat =-    [ ("asc",          check prop_asc)-    , ("des",          check prop_des)-    , ("exc",          check prop_exc)-    , ("fp",           check prop_fp)-    , ("cyc",          check prop_cyc)-    , ("inv",          check prop_inv)-    , ("maj",          check prop_maj)-    , ("comaj",        check prop_comaj)-    , ("lmin",         check prop_lmin)-    , ("lmax",         check prop_lmax)-    , ("rmin",         check prop_rmin)-    , ("rmax",         check prop_rmax)-    , ("head",         check prop_head)-    , ("last",         check prop_last)-    , ("peak",         check prop_peak)-    , ("vall",         check prop_vall)-    , ("dasc",         check prop_dasc)-    , ("ddes",         check prop_ddes)-    , ("ep",           check prop_ep)-    , ("lir",          check prop_lir)-    , ("ldr",          check prop_ldr)-    , ("rir",          check prop_rir)-    , ("rdr",          check prop_rdr)-    , ("comp",         check prop_comp)-    , ("scomp",        check prop_scomp)-    , ("dim",          check prop_dim)-    , ("asc0",         check prop_asc0)-    , ("des0",         check prop_des0)-    , ("shad",         check prop_shad)-    , ("inv/21",       check prop_inv_21)-    ]-------------------------------------------------------------------------------------- Properties for Math.Sym.Class------------------------------------------------------------------------------------agreesWithBasis bs cls m =-    and [ sort (Sym.av (map Sym.st bs) n) == sort (cls n) | n<-[0..m] ]--prop_av231      = agreesWithBasis ["231" :: CharPerm]          C.av231      7-prop_vee        = agreesWithBasis ["132", "231" :: CharPerm]   C.vee        7-prop_caret      = agreesWithBasis ["213", "312" :: CharPerm]   C.caret      7-prop_gt         = agreesWithBasis ["132", "312" :: CharPerm]   C.gt         7-prop_lt         = agreesWithBasis ["213", "231" :: CharPerm]   C.lt         7-prop_separables = agreesWithBasis ["2413", "3142" :: CharPerm] C.separables 7--testsClass =-    [ ("av231",        check prop_av231)-    , ("vee",          check prop_vee)-    , ("caret",        check prop_caret)-    , ("gt",           check prop_gt)-    , ("lt",           check prop_lt)-    , ("separables",   check prop_separables)-    ]-------------------------------------------------------------------------------------- Properties for Math.Sym.Bijection------------------------------------------------------------------------------------prop_simionSchmidt_avoid =-    forAll (resize 15 arbitrary) $ \w ->-        (w :: CharPerm) `Sym.avoids` ("123" :: CharPerm) ==> B.simionSchmidt w `Sym.avoids` ("132" :: CharPerm)--prop_simionSchmidt_avoid' =-    forAll (resize 15 arbitrary) $ \w ->-        (w :: CharPerm) `Sym.avoids` ("132" :: CharPerm) ==> B.simionSchmidt' w `Sym.avoids` ("123" :: CharPerm)--prop_simionSchmidt_id =-    forAll (resize 15 arbitrary) $ \w ->-        (w :: CharPerm) `Sym.avoids` ("123" :: CharPerm) ==> B.simionSchmidt' (B.simionSchmidt w) == w--prop_simionSchmidt_id' =-    forAll (resize 15 arbitrary) $ \w ->-        (w :: CharPerm) `Sym.avoids` ("132" :: CharPerm) ==> B.simionSchmidt (B.simionSchmidt' w) == w--testsBijection =-    [ ("simionSchmidt/avoid",   check prop_simionSchmidt_avoid)-    , ("simionSchmidt'/avoid",  check prop_simionSchmidt_avoid')-    , ("simionSchmidt/id",      check prop_simionSchmidt_id)-    , ("simionSchmidt'/id",     check prop_simionSchmidt_id')-    ]-------------------------------------------------------------------------------------- Main------------------------------------------------------------------------------------tests = testsPerm ++ testsD8 ++ testsStat ++ testsClass ++ testsBijection--runTests = mapM_ (\(name, t) -> putStr (name ++ ":\t") >> t)--main = runTests tests