sym 0.6 → 0.6.1
raw patch · 7 files changed
+87/−51 lines, 7 files
Files
- Math/Sym.hs +38/−16
- Math/Sym/Class.hs +11/−14
- Math/Sym/D8.hs +1/−1
- Math/Sym/Internal.hs +1/−1
- Math/Sym/Stat.hs +1/−1
- sym.cabal +1/−1
- tests/Properties.hs +34/−17
Math/Sym.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Math.Sym--- Copyright : (c) Anders Claesson 2012+-- Copyright : (c) Anders Claesson 2012, 2013 -- License : BSD-style -- Maintainer : Anders Claesson <anders.claesson@gmail.com> -- @@ -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
Math/Sym/Class.hs view
@@ -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 <anders.claesson@gmail.com> -- @@ -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
Math/Sym/D8.hs view
@@ -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 <anders.claesson@gmail.com> --
Math/Sym/Internal.hs view
@@ -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 <anders.claesson@gmail.com> --
Math/Sym/Stat.hs view
@@ -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 <anders.claesson@gmail.com> --
sym.cabal view
@@ -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
tests/Properties.hs view
@@ -1,5 +1,5 @@ -- |--- Copyright : (c) Anders Claesson 2012+-- Copyright : (c) Anders Claesson 2012, 2013 -- License : BSD-style -- Maintainer : Anders Claesson <anders.claesson@gmail.com> @@ -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)