diff --git a/Math/Sym.hs b/Math/Sym.hs --- a/Math/Sym.hs +++ b/Math/Sym.hs @@ -2,7 +2,7 @@ -- | -- Module : Math.Sym --- Copyright : (c) Anders Claesson 2012 +-- Copyright : (c) Anders Claesson 2012, 2013 -- License : BSD-style -- Maintainer : Anders Claesson -- @@ -54,13 +54,16 @@ , avoids , avoiders , av + , permClass - -- * Single point extensions/deletions, shadows and downsets + -- * Poset functions , del , shadow , downset , ext , coshadow + , minima + , maxima -- * Left-to-right maxima and similar functions , lMaxima @@ -277,13 +280,14 @@ fromVector = unst . StPerm -- | The bijective function defined by a permutation. -bijection :: StPerm -> Int -> Int +bijection :: Perm a => a -> Int -> Int bijection w = (SV.!) v where v = toVector w -lift :: Perm a => (Vector Int -> Vector Int) -> a -> a +lift :: (Perm a, Perm b) => (Vector Int -> Vector Int) -> a -> b lift f = fromVector . f . toVector -lift2 :: Perm a => (Vector Int -> Vector Int -> Vector Int) -> a -> a -> a +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 a function on 'StPerm' to a function on any permutations: @@ -335,10 +339,10 @@ -- 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] +-- > u \+\ v == inflate "12" [u,v] +-- > u /-/ v == inflate "21" [u,v] -- -inflate :: Perm a => a -> [a] -> a +inflate :: (Perm a, Perm b) => b -> [a] -> a inflate w vs = lift (\v -> I.inflate v (map toVector vs)) w @@ -383,13 +387,13 @@ -- | @copiesOf p w@ is the list of (indices of) copies of the pattern -- @p@ in the permutation @w@. E.g., -- --- > copiesOf (st "21") "2431" == [fromList [1,2],fromList [0,3],fromList [1,3],fromList [2,3]] +-- > copiesOf "21" "2431" == [fromList [1,2],fromList [0,3],fromList [1,3],fromList [2,3]] -- -copiesOf :: Perm a => StPerm -> a -> [Set] +copiesOf :: (Perm a, Perm b) => b -> a -> [Set] 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 +avoids :: (Perm a, Perm b) => a -> [b] -> Bool w `avoids` ps = all null [ copiesOf p w | p <- ps ] -- | @avoiders ps vs@ is the list of permutations in @vs@ avoiding the @@ -398,21 +402,25 @@ -- > avoiders ps = filter (`avoids` ps) -- -- but is usually much faster. -avoiders :: Perm a => [StPerm] -> [a] -> [a] +avoiders :: (Perm a, Perm b) => [b] -> [a] -> [a] 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., -- --- > map (length . av [st "132", st "321"]) [1..8] == [1,2,4,7,11,16,22,29] +-- > map (length . av ["132","321"]) [1..8] == [1,2,4,7,11,16,22,29] -- -av :: [StPerm] -> Int -> [StPerm] +av :: Perm a => [a] -> Int -> [StPerm] av ps = avoiders ps . sym +-- | Like 'av' but the return type is any set of permutations. +permClass :: (Perm a, Perm b) => [a] -> Int -> [b] +permClass ps = avoiders ps . perms --- Single point extensions/deletions, shadows and downsets --- ------------------------------------------------------- +-- Poset functions +-- --------------- + -- | Delete the element at a given position del :: Perm a => Int -> a -> a del i = lift $ I.del i @@ -439,6 +447,20 @@ -- | The list of all single point extensions coshadow :: (Ord a, Perm a) => [a] -> [a] coshadow ws = normalize [ ext i w | w <- ws, i <- [0 .. size w] ] + +-- | The set of minimal elements with respect to containment. +minima :: (Ord a, Perm 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 :: (Ord a, Perm a) => [a] -> [a] +maxima [] = [] +maxima ws = v : maxima [ u | u <- vs, v `avoids` [u] ] + where + (v:vs) = reverse $ normalize ws -- Left-to-right maxima and similar functions diff --git a/Math/Sym/Class.hs b/Math/Sym/Class.hs --- a/Math/Sym/Class.hs +++ b/Math/Sym/Class.hs @@ -1,6 +1,6 @@ -- | -- Module : Math.Sym.Class --- Copyright : (c) Anders Claesson 2012 +-- Copyright : (c) Anders Claesson 2012, 2013 -- License : BSD-style -- Maintainer : Anders Claesson -- @@ -10,10 +10,10 @@ module Math.Sym.Class ( - av231, vee, wedge, gt, lt, vorb, separables + av231, vee, caret, gt, lt, wedges, separables ) where -import Math.Sym (Perm, empty, one, (\+\), (/-/), dsum, ssum, normalize) +import Math.Sym (Perm, empty, one, (\+\), (/-/), ssum, normalize) import Math.Sym.D8 as D8 -- | Av(231); also know as the stack sortable permutations. @@ -41,9 +41,9 @@ 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 :: Perm a => Int -> [a] -wedge = map D8.complement . vee +-- 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 >. @@ -58,9 +58,9 @@ 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 :: (Ord a, Perm a) => Int -> [a] -vorb = union [vee, wedge, gt, lt] +-- | The union of 'vee', 'caret', 'gt' and 'lt'. +wedges :: (Ord a, Perm a) => Int -> [a] +wedges = union [vee, caret, gt, lt] compositions :: Int -> Int -> [[Int]] compositions 0 0 = [[]] @@ -74,12 +74,9 @@ 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 !!) - streamPIndec = map pIndec [0..] - mIndec 0 = [] - mIndec 1 = [one] - mIndec m = comps m >>= map dsum . mapM (streamPIndec !!) + mIndec m = map D8.complement $ pIndec m streamMIndec = map mIndec [0..] - comps m = [2..m] >>= \k -> compositions k m diff --git a/Math/Sym/D8.hs b/Math/Sym/D8.hs --- a/Math/Sym/D8.hs +++ b/Math/Sym/D8.hs @@ -1,6 +1,6 @@ -- | -- Module : Math.Sym.D8 --- Copyright : (c) Anders Claesson 2012 +-- Copyright : (c) Anders Claesson 2012, 2013 -- License : BSD-style -- Maintainer : Anders Claesson -- diff --git a/Math/Sym/Internal.hs b/Math/Sym/Internal.hs --- a/Math/Sym/Internal.hs +++ b/Math/Sym/Internal.hs @@ -2,7 +2,7 @@ -- | -- Module : Math.Sym.Internal --- Copyright : (c) Anders Claesson 2012 +-- Copyright : (c) Anders Claesson 2012, 2013 -- License : BSD-style -- Maintainer : Anders Claesson -- diff --git a/Math/Sym/Stat.hs b/Math/Sym/Stat.hs --- a/Math/Sym/Stat.hs +++ b/Math/Sym/Stat.hs @@ -1,6 +1,6 @@ -- | -- Module : Math.Sym.Stat --- Copyright : (c) Anders Claesson 2012 +-- Copyright : (c) Anders Claesson 2012, 2013 -- License : BSD-style -- Maintainer : Anders Claesson -- diff --git a/sym.cabal b/sym.cabal --- a/sym.cabal +++ b/sym.cabal @@ -1,5 +1,5 @@ Name: sym -Version: 0.6 +Version: 0.6.1 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 @@ -1,5 +1,5 @@ -- | --- Copyright : (c) Anders Claesson 2012 +-- Copyright : (c) Anders Claesson 2012, 2013 -- License : BSD-style -- Maintainer : Anders Claesson @@ -195,6 +195,18 @@ prop_coshadow = forAll (resize 50 perm) $ \w -> Sym.coshadow [w] == coshadow w +prop_minima_antichain = + forAll (resize 14 arbitrary) $ \ws -> + let vs = Sym.minima ws in and [ (v::Sym.StPerm) `Sym.avoids` (vs \\ [v]) | v <- vs ] + +prop_minima_smallest = + forAll (resize 14 arbitrary) $ \ws -> + let vs = Sym.minima ws in and [ not ((w::Sym.StPerm) `Sym.avoids` vs) | w <- ws ] + +prop_maxima_antichain = + forAll (resize 12 arbitrary) $ \ws -> + let vs = Sym.maxima ws in and [ (v::Sym.StPerm) `Sym.avoids` (vs \\ [v]) | v <- vs ] + recordIndicesAgree f g = forAll perm $ \w -> SV.fromList (recordIndices w) == f w where @@ -221,13 +233,13 @@ 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] + forAll perm $ \v -> (Sym.\+\) u v == Sym.inflate "12" [u,v] prop_ssum = forAll perm $ \u -> - forAll perm $ \v -> (Sym./-/) u v == Sym.inflate [2,1] [u,v] + forAll perm $ \v -> (Sym./-/) u v == Sym.inflate "21" [u,v] inflate :: [Int] -> [[Int]] -> [Int] -inflate w vs = concat . map snd $ sort [ (i, map (+c) u) | (i, c, u) <- zip3 w' cs us ] +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 @@ -294,12 +306,13 @@ prop_avoiders_avoid = forAll (resize 20 arbitrary) $ \ws -> forAll (resize 6 arbitrary) $ \ps -> - all (`Sym.avoids` ps) $ Sym.avoiders ps (ws :: [Sym.StPerm]) + all (`Sym.avoids` ps) $ Sym.avoiders (ps :: [Sym.StPerm]) (ws :: [Sym.StPerm]) prop_avoiders_idempotent = forAll (resize 18 arbitrary) $ \vs -> forAll (resize 5 arbitrary) $ \ps -> - let ws = Sym.avoiders ps (vs :: [Sym.StPerm]) in ws == Sym.avoiders ps ws + let ws = Sym.avoiders (ps :: [Sym.StPerm]) (vs :: [Sym.StPerm]) + in ws == Sym.avoiders ps ws prop_avoiders_d8 (Symmetry (f,_)) = forAll (choose (0, 5)) $ \n -> @@ -320,7 +333,7 @@ prop_av_cardinality = forAll (resize 3 arbitrary) $ \p -> - let spec = [ length $ Sym.av [p] n | n<-[0..6] ] + let spec = [ length $ Sym.av [p :: Sym.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] @@ -348,12 +361,12 @@ f _ _ = [] prop_subsets1 = - forAll (choose (0,14)) $ \n -> - forAll (choose (0,14)) $ \k -> + 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,35)) $ \n -> + forAll (choose (0,33)) $ \n -> forAll (choose (0,3)) $ \k -> sort (kSubsequences k [0..n-1]) == sort (map SV.toList $ Sym.subsets n k) @@ -362,13 +375,13 @@ let [v] = Sym.subsets n n in SV.toList v == [0..n-1] prop_subsets_cardinality1 = - forAll (choose (0,20)) $ \n -> - forAll (choose (0,20)) $ \k -> + forAll (choose (0,16)) $ \n -> + forAll (choose (0,16)) $ \k -> length (Sym.subsets n k) == binomial n k prop_subsets_cardinality2 = - forAll (choose (0,20)) $ \n -> - forAll (choose (0,20)) $ \k -> + 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) @@ -396,6 +409,9 @@ , ("coshadow", check prop_coshadow) , ("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) @@ -651,7 +667,8 @@ 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")) +prop_inv_21 = forAll (resize 30 perm) $ \w -> + S.inv w == (length . Sym.copiesOf (Sym.st "21")) w testsStat = [ ("asc", check prop_asc) @@ -695,7 +712,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_caret = agreesWithBasis ["213", "312"] C.caret 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 @@ -703,7 +720,7 @@ testsClass = [ ("av231", check prop_av231) , ("vee", check prop_vee) - , ("wedge", check prop_wedge) + , ("caret", check prop_caret) , ("gt", check prop_gt) , ("lt", check prop_lt) , ("separables", check prop_separables)