sym 0.5.2 → 0.6

raw patch · 5 files changed

+311/−238 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Math/Sym.hs +140/−111
• Math/Sym/Class.hs +35/−14
• Math/Sym/Internal.hs +11/−2
• sym.cabal +1/−1
• tests/Properties.hs +124/−110

@@ -15,25 +15,31 @@     (     -- * Standard permutations       StPerm-    , empty-    , one-    , toVector-    , fromVector     , toList     , fromList-    , (/-/)-    , bijection-    , unrankStPerm     , sym      -- * The permutation typeclass     , Perm (..) -    -- * Generalize, normalize and cast+    -- * Convenience functions+    , empty+    , one+    , toVector+    , fromVector+    , bijection     , generalize+    , generalize2     , normalize     , cast +    -- * Constructions+    , (\+\)+    , dsum+    , (/-/)+    , ssum+    , inflate+     -- * Generating permutations     , unrankPerm     , randomPerm@@ -77,12 +83,12 @@ import Control.Monad (liftM) import Data.Ord (comparing) import Data.Char (ord)-import Data.Monoid (Monoid(..))+import Data.Monoid (Monoid(..),(<>)) import Data.Bits (Bits, bitSize, testBit, popCount, shiftL) import Data.List (sort, sortBy, group) import Data.Vector.Storable (Vector) import qualified Data.Vector.Storable as SV-    ( (!), Vector, toList, fromList, fromListN, empty, singleton+    ( (!), toList, fromList, fromListN, empty, singleton     , length, map, concat, splitAt     ) import qualified Math.Sym.Internal as I@@ -105,30 +111,8 @@     show = show . toVector  instance Monoid StPerm where-    mempty = fromVector SV.empty-    mappend u v = fromVector $ SV.concat [u', v']-        where-          u' = toVector u-          v' = SV.map ( + size u) $ toVector v----- | The empty permutation.-empty :: StPerm-empty = StPerm SV.empty---- | The one letter permutation.-one :: StPerm-one = StPerm $ SV.singleton 0---- | Convert a standard permutation to a vector.-toVector :: StPerm -> Vector Int-toVector = perm0---- | Convert a vector to a standard permutation. The vector should be a--- permutation of the elements @[0..k-1]@ for some positive @k@. No--- checks for this are done.-fromVector :: Vector Int -> StPerm-fromVector = StPerm+    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]@@ -140,34 +124,12 @@ fromList :: [Int] -> StPerm fromList = fromVector . SV.fromList -infixl 6 /-/---- | The /skew sum/ of two permutations. (A definition of the--- /direct sum/ is provided by 'mappend' of the 'Monoid' instance for 'StPerm'.)-(/-/) :: StPerm -> StPerm -> StPerm-u /-/ v = fromVector $ SV.concat [u', v']-    where-      u' = SV.map ( + size v) $ toVector u-      v' = toVector v---- | The bijective function defined by a standard permutation.-bijection :: StPerm -> Int -> Int-bijection w = (SV.!) (toVector w)---- | @unrankStPerm n rank@ is the @rank@-th (Myrvold & Ruskey)--- permutation of @[0..n-1]@. E.g.,--- --- > unrankStPerm 16 19028390 == fromList [6,15,4,11,7,8,9,2,5,0,10,3,12,13,14,1]--- -unrankStPerm :: Int -> Integer -> StPerm-unrankStPerm n = fromVector . I.unrankPerm n- -- | 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 n = map (unrankStPerm n) [0 .. product [1 .. toInteger n] - 1]+sym = perms   -- The permutation typeclass@@ -212,28 +174,14 @@     -- | The identity permutation of the given size.     idperm :: Int -> a -    -- | The permutation obtained by acting on the given permutation-    -- with its own inverse; that is, the identity permutation on the-    -- same underlying set as the given permutation. It should hold-    -- that-    -- -    -- > st (neutralize u) == neutralize (st u)-    -- > neutralize u == inverse (st u) `act` u-    -- > neutralize u == idperm (size u)-    -- -    -- The default implementation uses the last of these three equations.-    {-# INLINE neutralize #-}-    neutralize :: a -> a-    neutralize = idperm . size-     -- | The group theoretical inverse. It should hold that     -- -    -- > inverse u == inverse (st u) `act` neutralize u+    -- > inverse == unst . inverse . st     --      -- and this is the default implementation.     {-# INLINE inverse #-}     inverse :: a -> a-    inverse u = inverse (st u) `act` neutralize u+    inverse = unst . inverse . st      -- | Predicate determining if two permutations are     -- order-isomorphic. The default implementation uses@@ -242,19 +190,40 @@     --      -- Equivalently, one could use     -- -    -- > u `ordiso` v  ==  inverse u `act` v == neutralize v+    -- > u `ordiso` v  ==  inverse u `act` v == idperm (size u)     --      {-# INLINE ordiso #-}     ordiso :: StPerm -> 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+    -- +    -- and this is the default implementation.+    unst :: Perm a => StPerm -> a+    unst w = unstn (size w) w+ instance Perm StPerm where     st         = id-    act u v    = fromVector $ I.act (toVector u) (toVector v)+    act        = lift2 I.act     size       = I.size . toVector     idperm     = fromVector . I.idperm-    inverse    = fromVector . I.inverse . toVector+    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.@@ -274,42 +243,105 @@ instance Perm String where     st         = stString     act        = actL-    inverse v  = act' v (neutralize v)+    inverse v  = act' v (idperm (size v))     size       = length     idperm n   = take n $ ['1'..'9'] ++ ['A'..'Z'] ++ ['a'..]  instance Perm [Int] where     st         = fromList . map (+(-1))     act        = actL-    inverse v  = act' v (neutralize v)+    inverse v  = act' v (idperm (size v))     size       = length     idperm n   = [1..n]  --- Generalize, normalize and cast--- ------------------------------+-- 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 :: StPerm -> Int -> Int+bijection w = (SV.!) v where v = toVector w++lift :: Perm a => (Vector Int -> Vector Int) -> a -> a+lift f = fromVector . f . toVector++lift2 :: Perm a => (Vector Int -> Vector Int -> Vector Int) -> a -> a -> a+lift2 f u v = fromVector $ f (toVector u) (toVector v)+ -- | Generalize a function on 'StPerm' to a function on any permutations: -- --- > generalize f v = f (st v) `act` neutralize v+-- > generalize f = unst . f . st -- --- Note that this will only work as intended if @f@ is size preserving.-generalize :: Perm a => (StPerm -> StPerm) -> a -> a-generalize f v = f (st v) `act` neutralize v+generalize :: (Perm a, Perm b) => (StPerm -> StPerm) -> a -> b+generalize f = unst . f . st +-- | Like 'generalize' but for functions of two variables+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 :: (Ord a, Perm a) => [a] -> [a]-normalize xs = map ((`act` idperm n) . head) . group $ sort ys-    where-      ys = map st xs-      n = maximum $ map size ys+normalize = map (unst . head) . group . sort . map st  -- | Cast a permutation of one type to another cast :: (Perm a, Perm b) => a -> b-cast w = st w `act` idperm (size w)+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 (fromList [0,1]) [u,v]+-- > u /-/ v == inflate (fromList [1,0]) [u,v]+-- +inflate :: Perm a => a -> [a] -> a+inflate w vs = lift (\v -> I.inflate v (map toVector vs)) w++ -- Generating permutations -- ----------------------- @@ -319,18 +351,18 @@ -- > unrankPerm 9 88888 == "561297843" --  unrankPerm :: Perm a => Int -> Integer -> a-unrankPerm n = (`act` idperm n) . fromVector . I.unrankPerm n+unrankPerm n = fromVector . I.unrankPerm n  -- | @randomPerm n@ is a random permutation of size @n@. randomPerm :: Perm a => Int -> IO a-randomPerm n = ((`act` idperm n) . fromVector . I.fromLehmercode) `liftM` I.randomLehmercode n+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 (`act` idperm n) $ sym n+perms n = map (unrankPerm n) [0 .. product [1 .. toInteger n] - 1]   -- Sorting operators@@ -338,11 +370,11 @@  -- | One pass of stack-sort. stackSort :: Perm a => a -> a-stackSort = generalize (fromVector . I.stackSort . toVector)+stackSort = lift I.stackSort  -- | One pass of bubble-sort. bubbleSort :: Perm a => a -> a-bubbleSort = generalize (fromVector . I.bubbleSort . toVector)+bubbleSort = lift I.bubbleSort   -- Permutation patterns@@ -354,7 +386,7 @@ -- > copiesOf (st "21") "2431" == [fromList [1,2],fromList [0,3],fromList [1,3],fromList [2,3]] --  copiesOf :: Perm a => StPerm -> a -> [Set]-copiesOf p w = I.copies subsets (toVector p) (toVector $ st w)+copiesOf p w = I.copies subsets (toVector p) (toVector w)  -- | @avoids w ps@ is a predicate determining if @w@ avoids the patterns @ps@. avoids :: Perm a => a -> [StPerm] -> Bool@@ -367,7 +399,7 @@ --  -- but is usually much faster. avoiders :: Perm a => [StPerm] -> [a] -> [a]-avoiders ps = I.avoiders subsets (toVector . st) (map toVector ps)+avoiders ps = I.avoiders subsets toVector (map toVector ps)  -- | @av ps n@ is the list of permutations of @[0..n-1]@ avoiding the -- patterns @ps@. E.g.,@@ -383,7 +415,7 @@  -- | Delete the element at a given position del :: Perm a => Int -> a -> a-del i = generalize $ fromVector . I.del i . toVector+del i = lift $ I.del i  -- | The list of all single point deletions shadow :: (Ord a, Perm a) => [a] -> [a]@@ -400,12 +432,9 @@ -- | Extend a permutation by inserting a new largest element at the -- given position ext :: Perm a => Int -> a -> a-ext i = generalize' $ fromVector . ext0 . toVector-    where-      generalize' f w = f (st w) `act` idperm (1+size w)-      ext0 w = SV.concat [u, SV.singleton (SV.length w), v]-          where-            (u,v) = SV.splitAt i w+ext i = lift $ \w ->+          let (u,v) = SV.splitAt i w+          in SV.concat [u, SV.singleton (SV.length w), v]  -- | The list of all single point extensions coshadow :: (Ord a, Perm a) => [a] -> [a]@@ -417,19 +446,19 @@  -- | The set of indices of left-to-right maxima. lMaxima :: Perm a => a -> Set-lMaxima = I.lMaxima . toVector . st+lMaxima = I.lMaxima . toVector  -- | The set of indices of left-to-right minima. lMinima :: Perm a => a -> Set-lMinima = I.lMaxima . I.complement . toVector . st+lMinima = I.lMaxima . I.complement . toVector  -- | The set of indices of right-to-left maxima. rMaxima :: Perm a => a -> Set-rMaxima = I.rMaxima . toVector . st+rMaxima = I.rMaxima . toVector  -- | The set of indices of right-to-left minima. rMinima :: Perm a => a -> Set-rMinima = I.rMaxima . I.complement . toVector . st+rMinima = I.rMaxima . I.complement . toVector   -- Components and skew components@@ -437,11 +466,11 @@  -- | The set of indices of components. components :: Perm a => a -> Set-components = I.components . toVector . st+components = I.components . toVector  -- | The set of indices of skew components. skewComponents :: Perm a => a -> Set-skewComponents = I.components . I.complement . toVector . st+skewComponents = I.components . I.complement . toVector   -- Simple permutations@@ -449,7 +478,7 @@  -- | A predicate determining if a given permutation is simple. simple :: Perm a => a -> Bool-simple = I.simple . toVector . st+simple = I.simple . toVector   -- Subsets@@ -457,7 +486,7 @@  -- | A set is represented by an increasing vector of non-negative -- integers.-type Set = SV.Vector Int+type Set = Vector Int  -- A sub-class of 'Bits' used internally. Minimal complete definiton: 'next'. class (Bits a, Integral a) => Bitmask a where

@@ -10,55 +10,76 @@  module Math.Sym.Class     (-     av231, vee, wedge, gt, lt, vorb+     av231, vee, wedge, gt, lt, vorb, separables     ) where -import Data.Monoid ((<>))-import Math.Sym (empty, one, (/-/), StPerm, normalize)+import Math.Sym (Perm, empty, one, (\+\), (/-/), dsum, ssum, normalize) import Math.Sym.D8 as D8  -- | Av(231); also know as the stack sortable permutations.-av231 :: Int -> [StPerm]+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)+  return $ s \+\ (one /-/ t) -streamAv231 :: [[StPerm]]+streamAv231 :: Perm a => [[a]] streamAv231 = map av231 [0..]  -- | 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 -> [StPerm]+vee :: Perm a => Int -> [a] vee = (streamVee !!) -streamVee :: [[StPerm]]+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+      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 wedge.-wedge :: Int -> [StPerm]+wedge :: Perm a => Int -> [a] wedge = 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 -> [StPerm]+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 :: Int -> [StPerm]+lt :: Perm a => Int -> [a] lt = map D8.reverse . gt -union :: [Int -> [StPerm]] -> Int -> [StPerm]+union :: (Ord a, Perm a) => [Int -> [a]] -> Int -> [a] union cs n = normalize $ concat [ c n | c <- cs ]  -- | The union of 'vee', 'wedge', 'gt' and 'lt'; the orbit of a V under rotation-vorb :: Int -> [StPerm]+vorb :: (Ord a, Perm a) => Int -> [a] vorb = union [vee, wedge, 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+      pIndec 0 = []+      pIndec 1 = [one]+      pIndec m = comps m >>= map ssum . mapM (streamMIndec !!)+      streamPIndec = map pIndec [0..]+      mIndec 0 = []+      mIndec 1 = [one]+      mIndec m = comps m >>= map dsum . mapM (streamPIndec !!)+      streamMIndec = map mIndec [0..]+      comps  m = [2..m] >>= \k -> compositions k m

@@ -35,6 +35,7 @@     , toList     , fromList     , act+    , inflate     , unrankPerm     , randomPerm     , sym@@ -109,10 +110,10 @@ import System.Random (getStdRandom, randomR) import Control.Monad (forM_, liftM) import Control.Monad.ST (runST)-import Data.List (group)+import Data.List (group, sort) import Data.Bits (Bits, shiftR, (.|.), (.&.), popCount) import qualified Data.Vector.Storable as SV-    ( Vector, toList, fromList, length, (!), thaw+    ( Vector, toList, fromList, length, (!), thaw, concat     , unsafeFreeze, unsafeWith, enumFromN, enumFromStepN     , head, last, filter, maximum, minimum, null, reverse, map     )@@ -190,6 +191,14 @@   w <- MV.unsafeNew n   forM_ [0..n-1] $ \i -> MV.unsafeWrite w i ((SV.!) v ((SV.!) 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 

@@ -1,5 +1,5 @@ Name:                sym-Version:             0.5.2+Version:             0.6 Synopsis:            Permutations, patterns, and statistics Description:            Definitions for permutations with an emphasis on permutation

@@ -52,7 +52,7 @@ subperms k w = [ subperm m w | m <- Sym.subsets (Sym.size w) k ]  instance Arbitrary Sym.StPerm where-    arbitrary = uncurry Sym.unrankStPerm `liftM` lenRank+    arbitrary = uncurry Sym.unrankPerm `liftM` lenRank     shrink w = nub $ [0 .. Sym.size w - 1] >>= \k -> subperms k w  perm :: Gen [Int]@@ -61,16 +61,16 @@ perm2 :: Gen (Sym.StPerm, [Int]) perm2 = do   (n,r1,r2) <- lenRank2-  let u = Sym.unrankStPerm n r1-  let v = Sym.unrankStPerm n r2+  let u = Sym.unrankPerm n r1+  let v = Sym.unrankPerm n r2   return (u, v `Sym.act` [1..n])  perm3 :: Gen (Sym.StPerm, Sym.StPerm, [Int]) perm3 = do   (n,r1,r2,r3) <- lenRank3-  let u = Sym.unrankStPerm n r1-  let v = Sym.unrankStPerm n r2-  let w = Sym.unrankStPerm n r3+  let u = Sym.unrankPerm n r1+  let v = Sym.unrankPerm n r2+  let w = Sym.unrankPerm n r3   return (u, v, w `Sym.act` [1..n])  stPermsOfEqualLength :: Gen [Sym.StPerm]@@ -78,7 +78,7 @@   n  <- choose (0,m)   k  <- choose (0,m^2)   rs <- replicateM k $ rank n-  return $ nub $ map (Sym.unrankStPerm n) rs+  return $ nub $ map (Sym.unrankPerm n) rs  newtype Symmetry = Symmetry (Sym.StPerm -> Sym.StPerm, String) @@ -121,13 +121,18 @@     mempty = S $ Sym.fromVector SV.empty     mappend u v = S $ (Sym./-/) (unS u) (unS v) -prop_unrankStPerm_distinct =+neutralize :: Sym.Perm a => a -> a+neutralize = Sym.idperm . Sym.size++forAllPermEq f g = forAll perm $ \w -> f w == g w++prop_unrankPerm_distinct =     forAll lenRank $ \(n, r) ->-        let w = Sym.toList (Sym.unrankStPerm n r) in nub w == w+        let w = Sym.toList (Sym.unrankPerm n r) in nub w == w -prop_unrankStPerm_injective =+prop_unrankPerm_injective =     forAll lenRank2 $ \(n, r1, r2) ->-        (Sym.unrankStPerm n r1 :: Sym.StPerm) /= Sym.unrankStPerm n r2 || r1 == r2+        (Sym.unrankPerm n r1 :: Sym.StPerm) /= Sym.unrankPerm n r2 || r1 == r2  prop_sym = and [ sort (Sym.sym n) == sort (sym' n) | n<-[0..6] ]     where@@ -143,25 +148,24 @@     forAll perm2 $ \(u,v) -> u `Sym.act` v == map (v!!) (Sym.toList u)  prop_act_id =-    forAll perm2 $ \(u,v) -> Sym.neutralize u `Sym.act` v == v+    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 =-    forAll perm $ \v -> Sym.size v == Sym.size (Sym.st v)+prop_size = Sym.size `forAllPermEq` (Sym.size . Sym.st) -prop_neutralize =-    forAll perm2 $ \(u,v) -> Sym.neutralize u == Sym.inverse (Sym.st u) `Sym.act` u+prop_neutralize = neutralize `forAllPermEq` (\u -> Sym.inverse (Sym.st u) `Sym.act` u)  prop_inverse =-    forAll perm $ \v -> Sym.inverse v == Sym.inverse (Sym.st v) `Sym.act` Sym.neutralize v+    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 == Sym.neutralize v)+    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@@ -191,30 +195,20 @@  prop_coshadow = forAll (resize 50 perm) $ \w -> Sym.coshadow [w] == coshadow w -prop_record f g =+recordIndicesAgree f g =     forAll perm $ \w -> SV.fromList (recordIndices w) == f w         where           recordIndices w = [ head $ elemIndices x w | x <- g w ] -prop_lMaxima = prop_record Sym.lMaxima lMaxima--prop_lMinima = prop_record Sym.lMinima lMinima--prop_rMaxima = prop_record Sym.rMaxima rMaxima--prop_rMinima = prop_record Sym.rMinima rMinima--prop_lMaxima_card =-    forAll perm $ \w -> S.lmax w == SV.length (Sym.lMaxima w)--prop_lMinima_card =-    forAll perm $ \w -> S.lmin w == SV.length (Sym.lMinima w)--prop_rMaxima_card =-    forAll perm $ \w -> S.rmax w == SV.length (Sym.rMaxima 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_rMinima_card =-    forAll perm $ \w -> S.rmin w == SV.length (Sym.rMinima w)+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)@@ -222,12 +216,30 @@ -- The list of indices of skew components in a permutation skewComponents w = components $ map (\x -> length w - x - 1) w -prop_components =-    forAll perm $ \w -> components (st w) == SV.toList (Sym.components w)+prop_components = (components . st) `forAllPermEq` (SV.toList . Sym.components) -prop_skewComponents =-    forAll perm $ \w -> skewComponents (st w) == SV.toList (Sym.skewComponents w)+prop_skewComponents = (skewComponents . st) `forAllPermEq` (SV.toList . Sym.skewComponents) +prop_dsum = forAll perm $ \u ->+            forAll perm $ \v -> (Sym.\+\) u v == Sym.inflate [1,2] [u,v]++prop_ssum = forAll perm $ \u ->+            forAll perm $ \v -> (Sym./-/) u v == Sym.inflate [2,1] [u,v]++inflate :: [Int] -> [[Int]] -> [Int]+inflate w vs = concat . map snd $ sort [ (i, map (+c) u) | (i, c, u) <- zip3 w' cs us ]+    where+      (_, w',us) = unzip3 . sort $ zip3 w [0..] vs+      cs = scanl (\i u -> i + length u) 0 us++prop_inflate =+    forAll perm $ \u0 ->+    forAll perm $ \u1 ->+    forAll perm $ \u2 ->+    forAll perm $ \u3 ->+        let us = [u0, u1, u2, u3]+        in and [ inflate w us == Sym.inflate w us | w <- permutations [1..4] ]+ segments :: [a] -> [[a]] segments [] = [[]] segments (x:xs) = segments xs ++ map (x:) (inits xs)@@ -249,26 +261,20 @@  prop_simple = forAll (resize 40 perm) $ \w -> Sym.simple w == simple w -prop_unrankPerm =-    forAll perm $ \w ->-        let n = length w-        in forAll (choose (0, product [1..fromIntegral n - 1])) $ \r ->-            Sym.st (Sym.unrankPerm n r :: [Int]) == Sym.unrankStPerm n r--prop_stackSort = forAll perm $ \v -> Sym.stackSort v == stack v+prop_stackSort = Sym.stackSort `forAllPermEq` stack  prop_stackSort_231 =-    forAll perm $ \v ->-        (Sym.stackSort v == Sym.neutralize v) == (v `Sym.avoids` [Sym.st "231"])+  (\v -> Sym.stackSort v == neutralize v) `forAllPermEq` (`Sym.avoids` [Sym.st "231"]) -prop_bubbleSort = forAll perm $ \v -> Sym.bubbleSort v == bubble v+prop_bubbleSort = Sym.bubbleSort `forAllPermEq` bubble -prop_bubbleSort_231_321 =-    forAll perm $ \v ->-        (Sym.bubbleSort v == Sym.neutralize v) == (v `Sym.avoids` [Sym.st "231", Sym.st "321"])+prop_bubbleSort_231_321 = forAllPermEq f g+    where f v = Sym.bubbleSort v == neutralize v+          g v = v `Sym.avoids` [Sym.st "231", Sym.st "321"]  prop_subperm_copies p =-    forAll (resize 21 perm) $ \w -> and [ subperm m (Sym.st w) == p | m <- Sym.copiesOf p w ]+    forAll (resize 21 perm) $ \w ->+        and [ subperm m (Sym.st w) == p | m <- Sym.copiesOf p w ]  prop_copies =     forAll (resize  6 arbitrary) $ \p ->@@ -282,7 +288,7 @@     forAll (resize  6 arbitrary) $ \p ->     forAll (resize 20 perm)      $ \w ->         let p' = f p-            w' = Sym.generalize f w+            w' = Sym.generalize f w :: [Int]         in length (Sym.copiesOf p w) == length (Sym.copiesOf p' w')  prop_avoiders_avoid =@@ -298,12 +304,14 @@ 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)+        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))+        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 ->@@ -361,7 +369,8 @@ prop_subsets_cardinality2 =     forAll (choose (0,20)) $ \n ->     forAll (choose (0,20)) $ \k ->-        let cs = map SV.length (Sym.subsets n k) in ((k > n) && null cs) || ([k] == nub cs)+        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)@@ -370,8 +379,8 @@     , ("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)-    , ("unrankStPerm/distinct",          check prop_unrankStPerm_distinct)-    , ("unrankStPerm/injective",         check prop_unrankStPerm_injective)+    , ("unrankPerm/distinct",            check prop_unrankPerm_distinct)+    , ("unrankPerm/injective",           check prop_unrankPerm_injective)     , ("sym",                            check prop_sym)     , ("perm",                           check prop_perm)     , ("st",                             check prop_st)@@ -397,8 +406,10 @@     , ("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)-    , ("unrankPerm",                     check prop_unrankPerm)     , ("stackSort",                      check prop_stackSort)     , ("stackSort/231",                  check prop_stackSort_231)     , ("bubbleSort",                     check prop_bubbleSort)@@ -428,13 +439,15 @@  prop_D8_orbit fs w = all (`elem` orbD8) $ D8.orbit (map fn fs) w     where-      orbD8 = D8.orbit D8.d8 w+      orbD8 = D8.orbit D8.d8 (w :: Sym.StPerm) -prop_D8_reverse w    = I.reverse    (Sym.toVector w) == Sym.toVector (D8.reverse w)-prop_D8_complement w = I.complement (Sym.toVector w) == Sym.toVector (D8.complement w)-prop_D8_inverse w    = I.inverse    (Sym.toVector w) == Sym.toVector (D8.inverse w)-prop_D8_rotate w     = I.rotate     (Sym.toVector w) == Sym.toVector (D8.rotate w)+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).@@ -447,15 +460,15 @@ symmetryClasses :: (Ord a, Sym.Perm a) => [a -> a] -> [a] -> [[a]] symmetryClasses fs xs = sort . map sort $ eqClasses (D8.orbit fs) xs -prop_symmetryClasses fs =+symmetryClassesByGroup fs =     forAll (resize 10 stPermsOfEqualLength) $ \ws ->         symmetryClasses fs ws == D8.symmetryClasses fs ws -prop_symmetryClasses_d8     = prop_symmetryClasses D8.d8-prop_symmetryClasses_klein4 = prop_symmetryClasses D8.klein4-prop_symmetryClasses_ei     = prop_symmetryClasses [D8.id, D8.inverse]-prop_symmetryClasses_er     = prop_symmetryClasses [D8.id, D8.reverse]-prop_symmetryClasses_ec     = prop_symmetryClasses [D8.id, D8.complement]+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)@@ -609,37 +622,36 @@ ddes = length . doubleDescents shad = length . shadow -prop_asc   = forAll perm $ \w -> asc   w == S.asc   w-prop_des   = forAll perm $ \w -> des   w == S.des   w-prop_exc   = forAll perm $ \w -> exc   w == S.exc   w-prop_fp    = forAll perm $ \w -> fp    w == S.fp    w-prop_cyc   = forAll perm $ \w -> cyc   w == S.cyc   w-prop_inv   = forAll perm $ \w -> inv   w == S.inv   w-prop_maj   = forAll perm $ \w -> maj   w == S.maj   w-prop_comaj = forAll perm $ \w -> comaj w == S.comaj w-prop_lmin  = forAll perm $ \w -> lmin  w == S.lmin  w-prop_lmax  = forAll perm $ \w -> lmax  w == S.lmax  w-prop_rmin  = forAll perm $ \w -> rmin  w == S.rmin  w-prop_rmax  = forAll perm $ \w -> rmax  w == S.rmax  w-prop_head  = forAll perm $ \w -> not (null w) ==> head w == 1 + S.head w-prop_last  = forAll perm $ \w -> not (null w) ==> last w == 1 + S.last w-prop_peak  = forAll perm $ \w -> peak  w == S.peak  w-prop_vall  = forAll perm $ \w -> vall  w == S.vall  w-prop_dasc  = forAll perm $ \w -> dasc  w == S.dasc  w-prop_ddes  = forAll perm $ \w -> ddes  w == S.ddes  w-prop_ep    = forAll perm $ \w -> ep    w == S.ep    w-prop_lir   = forAll perm $ \w -> lir   w == S.lir   w-prop_ldr   = forAll perm $ \w -> ldr   w == S.ldr   w-prop_rir   = forAll perm $ \w -> rir   w == S.rir   w-prop_rdr   = forAll perm $ \w -> rdr   w == S.rdr   w-prop_comp  = forAll perm $ \w -> comp  w == S.comp  w-prop_scomp = forAll perm $ \w -> scomp w == S.scomp w-prop_dim   = forAll perm $ \w -> dim   w == S.dim   w-prop_asc0  = forAll perm $ \w -> asc0  w == S.asc0  w-prop_des0  = forAll perm $ \w -> des0  w == S.des0  w-prop_shad  = forAll perm $ \w -> shad  w == S.shad  w--prop_inv_21 = forAll perm $ \w -> S.inv w == length (Sym.copiesOf (Sym.st "21") w)+prop_asc    = forAllPermEq asc   S.asc+prop_des    = forAllPermEq des   S.des+prop_exc    = forAllPermEq exc   S.exc+prop_fp     = forAllPermEq fp    S.fp+prop_cyc    = forAllPermEq cyc   S.cyc+prop_inv    = forAllPermEq inv   S.inv+prop_maj    = forAllPermEq maj   S.maj+prop_comaj  = forAllPermEq comaj S.comaj+prop_lmin   = forAllPermEq lmin  S.lmin+prop_lmax   = forAllPermEq lmax  S.lmax+prop_rmin   = forAllPermEq rmin  S.rmin+prop_rmax   = forAllPermEq rmax  S.rmax+prop_head   = forAll perm $ \w -> not (null w) ==> head w == 1 + S.head w+prop_last   = forAll perm $ \w -> not (null w) ==> last w == 1 + S.last w+prop_peak   = forAllPermEq peak  S.peak+prop_vall   = forAllPermEq vall  S.vall+prop_dasc   = forAllPermEq dasc  S.dasc+prop_ddes   = forAllPermEq ddes  S.ddes+prop_ep     = forAllPermEq ep    S.ep+prop_lir    = forAllPermEq lir   S.lir+prop_ldr    = forAllPermEq ldr   S.ldr+prop_rir    = forAllPermEq rir   S.rir+prop_rdr    = forAllPermEq rdr   S.rdr+prop_comp   = forAllPermEq comp  S.comp+prop_scomp  = forAllPermEq scomp S.scomp+prop_dim    = forAllPermEq dim   S.dim+prop_asc0   = forAllPermEq asc0  S.asc0+prop_des0   = forAllPermEq des0  S.des0+prop_shad   = forAllPermEq shad  S.shad+prop_inv_21 = forAllPermEq S.inv (length . Sym.copiesOf (Sym.st "21"))  testsStat =     [ ("asc",          check prop_asc)@@ -678,14 +690,15 @@ -- Properties for Math.Sym.Class --------------------------------------------------------------------------------- -prop_agrees_with_basis bs cls m =+agreesWithBasis bs cls m =     and [ sort (Sym.av (map Sym.st bs) n) == sort (cls n) | n<-[0..m] ] -prop_av231 = prop_agrees_with_basis ["231"]        C.av231 7-prop_vee   = prop_agrees_with_basis ["132", "231"] C.vee   7-prop_wedge = prop_agrees_with_basis ["213", "312"] C.wedge 7-prop_gt    = prop_agrees_with_basis ["132", "312"] C.gt    7-prop_lt    = prop_agrees_with_basis ["213", "231"] C.lt    7+prop_av231      = agreesWithBasis ["231"]          C.av231      7+prop_vee        = agreesWithBasis ["132", "231"]   C.vee        7+prop_wedge      = agreesWithBasis ["213", "312"]   C.wedge      7+prop_gt         = agreesWithBasis ["132", "312"]   C.gt         7+prop_lt         = agreesWithBasis ["213", "231"]   C.lt         7+prop_separables = agreesWithBasis ["2413", "3142"] C.separables 7  testsClass =     [ ("av231",        check prop_av231)@@ -693,6 +706,7 @@     , ("wedge",        check prop_wedge)     , ("gt",           check prop_gt)     , ("lt",           check prop_lt)+    , ("separables",   check prop_separables)     ]  ---------------------------------------------------------------------------------