diff --git a/Math/Sym.hs b/Math/Sym.hs --- a/Math/Sym.hs +++ b/Math/Sym.hs @@ -15,62 +15,65 @@ ( -- * Standard permutations StPerm - , toVector -- :: StPerm -> Vector Int - , fromVector -- :: Vector Int -> StPerm - , toList -- :: StPerm -> [Int] - , fromList -- :: [Int] -> StPerm - , (/-/) -- :: StPerm -> StPerm -> StPerm - , bijection -- :: StPerm -> Int -> Int - , unrankStPerm -- :: Int -> Integer -> StPerm - , sym -- :: Int -> [StPerm] + , toVector + , fromVector + , toList + , fromList + , (/-/) + , bijection + , unrankStPerm + , sym -- * The permutation typeclass , Perm (..) - -- * Generalize - , generalize -- :: Perm a => (StPerm -> StPerm) -> a -> a + -- * Generalize and normalize + , generalize + , normalize -- * Generating permutations - , unrankPerm -- :: Perm a => Int -> Integer -> a - , randomPerm -- :: Perm a => Int -> IO a - , perms -- :: Perm a => Int -> [a] + , unrankPerm + , randomPerm + , perms -- * Sorting operators - , stackSort -- :: Perm a => a -> a - , bubbleSort -- :: Perm a => a -> a + , stackSort + , bubbleSort -- * Permutation patterns - , copiesOf -- :: Perm a => StPerm -> a -> [Set] - , avoids -- :: Perm a => a -> [StPerm] -> Bool - , avoiders -- :: Perm a => [StPerm] -> [a] -> [a] - , av -- :: [StPerm] -> Int -> [StPerm] + , copiesOf + , avoids + , avoiders + , av - -- * Single point extensions and deletions - , del -- :: Perm a => Int -> a -> a - , shadow -- :: (Ord a, Perm a) => a -> [a] - , ext -- :: Perm a => Int -> a -> a - , coshadow -- :: (Ord a, Perm a) => a -> [a] + -- * Single point extensions/deletions, shadows and downsets + , del + , shadow + , downset + , ext + , coshadow -- * Left-to-right maxima and similar functions - , lMaxima -- :: Perm a => a -> Set - , lMinima -- :: Perm a => a -> Set - , rMaxima -- :: Perm a => a -> Set - , rMinima -- :: Perm a => a -> Set + , lMaxima + , lMinima + , rMaxima + , rMinima -- * Components and skew components , components , skewComponents -- * Simple permutations - , simple -- :: Perm a => a -> Bool + , simple -- * Subsets , Set - , subsets -- :: Int -> Int -> [Set] + , subsets ) where import Control.Monad (liftM) import Data.Ord (comparing) +import Data.Char (ord) import Data.Monoid (Monoid(..)) import Data.Bits (Bits, bitSize, testBit, popCount, shiftL) import Data.List (sort, sortBy, group) @@ -246,29 +249,33 @@ act' :: Ord a => [a] -> [b] -> [b] act' u = map snd . sortBy (comparing fst) . zip u -stL :: Enum a => [a] -> StPerm -stL = fromVector . I.st . I.fromList . map fromEnum - 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 + instance Perm String where - st = stL + st = stString act = actL inverse v = act' v (neutralize v) size = length - idperm n = take n $ ['1'..'9'] ++ ['A'..'Z'] ++ ['a'..'z'] ++ ['{'..] + idperm n = take n $ ['1'..'9'] ++ ['A'..'Z'] ++ ['a'..] instance Perm [Int] where - st = stL + st = fromList . map (+(-1)) act = actL inverse v = act' v (neutralize v) size = length idperm n = [1..n] --- Generalize --- ---------- +-- Generalize and normalize +-- ------------------------ -- | Generalize a function on 'StPerm' to a function on any permutations: -- @@ -278,6 +285,13 @@ generalize :: Perm a => (StPerm -> StPerm) -> a -> a generalize f v = f (st v) `act` neutralize 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 -- Generating permutations -- ----------------------- @@ -347,17 +361,25 @@ av ps = avoiders ps . sym --- Single point extensions and deletions --- ------------------------------------- +-- Single point extensions/deletions, shadows and downsets +-- ------------------------------------------------------- -- | Delete the element at a given position del :: Perm a => Int -> a -> a del i = generalize $ fromVector . I.del i . toVector -- | The list of all single point deletions -shadow :: (Ord a, Perm a) => a -> [a] -shadow w = map head . group $ sort [ del i w | i <- [0 .. size w - 1]] +shadow :: (Ord a, 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 :: (Ord a, Perm a) => [a] -> [a] +downset = normalize . concat . downset' + where + downset' [] = [] + downset' ws = ws : downset' (shadow ws) + -- | Extend a permutation by inserting a new largest element at the -- given position ext :: Perm a => Int -> a -> a @@ -369,8 +391,8 @@ (u,v) = SV.splitAt i w -- | The list of all single point extensions -coshadow :: (Ord a, Perm a) => a -> [a] -coshadow w = map head . group $ sort [ ext i w | i <- [0 .. size w]] +coshadow :: (Ord a, Perm a) => [a] -> [a] +coshadow ws = normalize [ ext i w | w <- ws, i <- [0 .. size w] ] -- Left-to-right maxima and similar functions diff --git a/Math/Sym/D8.hs b/Math/Sym/D8.hs --- a/Math/Sym/D8.hs +++ b/Math/Sym/D8.hs @@ -15,34 +15,28 @@ module Math.Sym.D8 ( -- * The group elements - r0 -- :: Perm a => a -> a - , r1 -- :: Perm a => a -> a - , r2 -- :: Perm a => a -> a - , r3 -- :: Perm a => a -> a - , s0 -- :: Perm a => a -> a - , s1 -- :: Perm a => a -> a - , s2 -- :: Perm a => a -> a - , s3 -- :: Perm a => a -> a + r0, r1, r2, r3 + , s0, s1, s2, s3 -- * D8, the klein four-group, and orbits - , d8 -- :: Perm a => [a -> a] - , klein4 -- :: Perm a => [a -> a] - , orbit -- :: (Ord a, Perm a) => [a -> a] -> a -> [a] - , symmetryClasses -- :: (Ord a, Perm a) => [a -> a] -> [a] -> [[a]] - , d8Classes -- :: (Ord a, Perm a) => [a] -> [[a]] - , klein4Classes -- :: (Ord a, Perm a) => [a] -> [[a]] + , d8 + , klein4 + , orbit + , symmetryClasses + , d8Classes + , klein4Classes -- * Aliases - , id -- :: Perm a => a -> a - , rotate -- :: Perm a => a -> a - , complement -- :: Perm a => a -> a - , reverse -- :: Perm a => a -> a - , inverse -- :: Perm a => a -> a + , id + , rotate + , complement + , reverse + , inverse ) where import Prelude hiding (reverse, id) -import Data.List (group, sort, insert) -import Math.Sym (Perm (size), fromVector, act) +import Data.List (insert) +import Math.Sym (Perm (size), fromVector, act, normalize) import qualified Math.Sym (inverse) import Math.Sym.Internal (revIdperm) @@ -106,7 +100,7 @@ -- > orbit klein4 "2314" == ["1423","2314","3241","4132"] -- orbit :: (Ord a, Perm a) => [a -> a] -> a -> [a] -orbit fs x = map head . group $ sort [ f x | f <- fs ] +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@. diff --git a/Math/Sym/Internal.hs b/Math/Sym/Internal.hs --- a/Math/Sym/Internal.hs +++ b/Math/Sym/Internal.hs @@ -54,34 +54,34 @@ , rotate -- * Permutation statistics - , 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 + , 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 @@ -101,6 +101,7 @@ , onesCUInt , nextCUInt , nextIntegral + ) where import Prelude hiding (reverse, head, last) diff --git a/Math/Sym/Stat.hs b/Math/Sym/Stat.hs --- a/Math/Sym/Stat.hs +++ b/Math/Sym/Stat.hs @@ -192,4 +192,4 @@ -- | 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 . st +shad = length . shadow . return . st diff --git a/include/stat.h b/include/stat.h --- a/include/stat.h +++ b/include/stat.h @@ -1,21 +1,21 @@ -long asc (const long *, long); /* ascents */ -long des (const long *, long); /* descents */ -long exc (const long *, long); /* excedances */ -long fp (const long *, long); /* fixed points */ -long cyc (const long *, long); /* The number of cycles */ -long inv (const long *, long); /* inversions */ -long maj (const long *, long); /* major index */ -long comaj(const long *, long); /* co-major index */ -long peak (const long *, long); /* peaks */ -long vall (const long *, long); /* valleys */ -long dasc (const long *, long); /* double ascents */ -long ddes (const long *, long); /* double descents */ -long lmin (const long *, long); /* left-to-right minima */ -long lmax (const long *, long); /* left-to-right maxima */ -long lir (const long *, long); /* left-most increasing run */ -long ldr (const long *, long); /* left-most decreasing run */ -long comp (const long *, long); /* components */ -long ep (const long *, long); /* rank a la Elizalde & Pak */ -long dim (const long *, long); /* dimension */ -long asc0 (const long *, long); /* small ascents */ -long des0 (const long *, long); /* small descents */ +long asc (const long *, long); +long des (const long *, long); +long exc (const long *, long); +long fp (const long *, long); +long cyc (const long *, long); +long inv (const long *, long); +long maj (const long *, long); +long comaj(const long *, long); +long peak (const long *, long); +long vall (const long *, long); +long dasc (const long *, long); +long ddes (const long *, long); +long lmin (const long *, long); +long lmax (const long *, long); +long lir (const long *, long); +long ldr (const long *, long); +long comp (const long *, long); +long ep (const long *, long); +long dim (const long *, long); +long asc0 (const long *, long); +long des0 (const long *, long); diff --git a/sym.cabal b/sym.cabal --- a/sym.cabal +++ b/sym.cabal @@ -1,5 +1,5 @@ Name: sym -Version: 0.4.2 +Version: 0.5 Synopsis: Permutations, patterns, and statistics Description: Definitions for permutations with an emphasis on permutation diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -163,23 +163,32 @@ forAll perm2 $ \(u,v) -> u `Sym.ordiso` v == (Sym.inverse u `Sym.act` v == Sym.neutralize v) shadow :: Ord a => [a] -> [[a]] -shadow w = nubSort . map normalize $ ptDeletions w +shadow w = nubsort . map normalize $ ptDeletions w where w' = sort w normalize u = [ w'!!i | i <- st u ] - nubSort = map head . group . sort + nubsort = map head . group . sort ptDeletions [] = [] ptDeletions xs@(x:xt) = xt : map (x:) (ptDeletions xt) -prop_shadow = forAll (resize 30 perm) $ \w -> Sym.shadow w == shadow w +prop_shadow = forAll (resize 30 perm) $ \w -> Sym.shadow [w] == shadow w +prop_downset_shadow = + forAll (resize 10 perm) $ \w -> + [ v | v <- Sym.downset [w], 1 + length v == length w ] == Sym.shadow [w] + +prop_downset_orderideal = + forAll (resize 9 perm) $ \w -> null [ v | v <- Sym.downset [w] + , w `Sym.avoids` [Sym.st v] + ] + coshadow :: (Enum a, Ord a) => [a] -> [[a]] coshadow w = sort $ ptExtensions (succ $ maximum (toEnum 0 : w)) w where ptExtensions n [] = [[n]] ptExtensions n xs@(x:xt) = (n:xs) : map (x:) (ptExtensions n xt) -prop_coshadow = forAll (resize 50 perm) $ \w -> Sym.coshadow w == coshadow w +prop_coshadow = forAll (resize 50 perm) $ \w -> Sym.coshadow [w] == coshadow w prop_record f g = forAll perm $ \w -> SV.fromList (recordIndices w) == f w @@ -375,6 +384,8 @@ , ("ordiso/2", check prop_ordiso2) , ("shadow", check prop_shadow) , ("coshadow", check prop_coshadow) + , ("downset/shadow", check prop_downset_shadow) + , ("downset/orderideal", check prop_downset_orderideal) , ("simple", check prop_simple) , ("lMaxima", check prop_lMaxima) , ("lMinima", check prop_lMinima)