multiset-comb 0.1 → 0.2

raw patch · 2 files changed

+228/−60 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Math/Combinatorics/Multiset.hs +217/−56
• multiset-comb.cabal +11/−4

@@ -1,16 +1,30 @@--- | Efficient combinatorial algorithms to generate all permutations---   and partitions of a multiset.  Note that an 'Eq' or 'Ord'---   instance on the elements is /not/ required; the algorithms are---   careful to keep track of which things are (by construction) equal---   to which other things, so equality testing is not needed.++-- | Efficient combinatorial algorithms over multisets, including+--   generating all permutations, partitions, subsets, cycles, and+--   other combinatorial structures based on multisets.  Note that an+--   'Eq' or 'Ord' instance on the elements is /not/ required; the+--   algorithms are careful to keep track of which things are (by+--   construction) equal to which other things, so equality testing is+--   not needed. module Math.Combinatorics.Multiset-       ( -- * The 'MultiSet' type+       ( -- * The 'Multiset' type           Count-       , MultiSet+       , Multiset(..)+       , consMS, (+:)++         -- ** Conversions        , toList        , fromList+       , fromListEq+       , fromDistinctList+       , fromCounts+       , getCounts +         -- ** Operations+       , disjUnion+       , disjUnions+          -- * Permutations         , permutations@@ -22,53 +36,120 @@        , vPartitions        , partitions +         -- * Submultisets++       , splits+       , kSubsets++         -- * Cycles++       , cycles++         -- * Miscellaneous++       , sequenceMS+        ) where  import Data.List (group, sort)-import Control.Arrow (first, second, (&&&))+import Control.Arrow (first, second, (&&&), (***)) import Data.Maybe (catMaybes)  type Count = Int --- | A multiset is a list of (element, count) pairs.  We maintain the---   invariants that the counts are always positive, and no element---   ever appears more than once.-type MultiSet a = [(a, Count)]+-- | A multiset is represented as a list of (element, count) pairs.+--   We maintain the invariants that the counts are always positive,+--   and no element ever appears more than once.+newtype Multiset a = MS { toCounts :: [(a, Count)] }+  deriving (Show) +-- | Construct a 'Multiset' from a list of (element, count) pairs.+--   Precondition: the counts must all be positive, and there must not+--   be any duplicate elements.+fromCounts :: [(a, Count)] -> Multiset a+fromCounts = MS++-- | Extract just the element counts from a multiset, forgetting the+--   elements.+getCounts :: Multiset a -> [Count]+getCounts (MS xs) = map snd xs++liftMS :: ([(a, Count)] -> [(b, Count)]) -> Multiset a -> Multiset b+liftMS f (MS m) = MS (f m)++-- | Add an element with multiplicity to a multiset.  Precondition:+--   the new element is distinct from all elements already in the+--   multiset.+consMS :: (a, Count) -> Multiset a -> Multiset a+consMS e (MS m) = MS (e:m)++-- | A convenient shorthand for 'consMS'.+(+:) :: (a, Count) -> Multiset a -> Multiset a+(+:) = consMS++instance Functor Multiset where+  fmap f = fromCounts . (map . first $ f) . toCounts+ -- | Convert a multiset to a list.-toList :: MultiSet a -> [a]-toList = concatMap (uncurry (flip replicate))+toList :: Multiset a -> [a]+toList = expandCounts . toCounts --- | Convert a list to a multiset.  This method is provided just for---   convenience; you can of course construct your own 'MultiSet's---   directly (especially if the type of the elements is not an---   instance of 'Ord').-fromList :: Ord a => [a] -> MultiSet a-fromList = map (head &&& length) . group . sort+expandCounts :: [(a, Count)] -> [a]+expandCounts = concatMap (uncurry (flip replicate)) +-- | Efficiently convert a list to a multiset, given an 'Ord' instance+--   for the elements.  This method is provided just for convenience.+--   you can also use 'fromListEq' with only an 'Eq' instance, or+--   construct 'Multiset's directly using 'fromCounts'.+fromList :: Ord a => [a] -> Multiset a+fromList = fromCounts . map (head &&& length) . group . sort++-- | Convert a list to a multiset, given an 'Eq' instance for the+--   elements.+fromListEq :: Eq a => [a] -> Multiset a+fromListEq = fromCounts . fromListEq'+  where fromListEq' []     = []+        fromListEq' (x:xs) = (x, 1 + count x xs) : fromListEq' (filter (/=x) xs)+        count x = length . filter (==x)++-- | Make a multiset with one copy of each element from a list of+--   distinct elements.+fromDistinctList :: [a] -> Multiset a+fromDistinctList = fromCounts . map (\x -> (x,1))++-- | Form the disjoint union of two multisets; i.e. we assume the two+--   multisets share no elements in common.+disjUnion :: Multiset a -> Multiset a -> Multiset a+disjUnion (MS xs) (MS ys) = MS (xs ++ ys)++-- | Form the disjoint union of a collection of multisets.  We assume+--   that the multisets all have distinct elements.+disjUnions :: [Multiset a] -> Multiset a+disjUnions = foldr disjUnion (MS [])+ -- | In order to generate permutations of a multiset, we need to keep --   track of the most recently used element in the permutation being --   built, so that we don't use it again immediately.  The---   'RMultiSet' type (for \"restricted multiset\") records this+--   'RMultiset' type (for \"restricted multiset\") records this --   information, consisting of a multiset possibly paired with an --   element (with multiplicity) which is also part of the multiset, --   but should not be used at the beginning of permutations.-data RMultiSet a = RMS (Maybe (a, Count)) (MultiSet a)+data RMultiset a = RMS (Maybe (a, Count)) [(a,Count)]   deriving Show --- | Convert a 'MultiSet' to a 'RMultiSet' (with no avoided element).-toRMS :: MultiSet a -> RMultiSet a-toRMS = RMS Nothing+-- | Convert a 'Multiset' to a 'RMultiset' (with no avoided element).+toRMS :: Multiset a -> RMultiset a+toRMS = RMS Nothing . toCounts --- | Convert a 'RMultiSet' to a 'MultiSet'.-fromRMS :: RMultiSet a -> MultiSet a-fromRMS (RMS Nothing m)  = m-fromRMS (RMS (Just e) m) = e:m+-- | Convert a 'RMultiset' to a 'Multiset'.+fromRMS :: RMultiset a -> Multiset a+fromRMS (RMS Nothing m)  = MS m+fromRMS (RMS (Just e) m) = MS (e:m)  -- | List all the distinct permutations of the elements of a --   multiset. -----   For example, @permutations [('a',1), ('b',2)] ==+--   For example, @permutations (fromList \"abb\") == --   [\"abb\",\"bba\",\"bab\"]@, whereas @Data.List.permutations --   \"abb\" == [\"abb\",\"bab\",\"bba\",\"bba\",\"bab\",\"abb\"]@. --   This function is equivalent to, but /much/ more efficient than,@@ -77,8 +158,8 @@ -- --   Note that this is a specialized version of 'permutationsRLE', --   where each run has been expanded via 'replicate'.-permutations :: MultiSet a -> [[a]]-permutations = map toList . permutationsRLE+permutations :: Multiset a -> [[a]]+permutations = map expandCounts . permutationsRLE  -- | List all the distinct permutations of the elements of a multiset, --   with each permutation run-length encoded. (Note that the@@ -88,19 +169,19 @@ --   For example, @permutationsRLE [('a',1), ('b',2)] == --   [[('a',1),('b',2)],[('b',2),('a',1)],[('b',1),('a',1),('b',1)]]@. -----   (Note that although the output type is equivalent to @[MultiSet---   a]@, we don't call it that since the output may violate the---   'MultiSet' invariant that no element should appear more than---   once.  And indeed, morally this function does not output---   multisets at all.)-permutationsRLE :: MultiSet a -> [[(a,Count)]]-permutationsRLE [] = [[]]-permutationsRLE m  = permutationsRLE' (toRMS m)+--   (Note that although the output type is newtype-equivalent to+--   @[Multiset a]@, we don't call it that since the output may+--   violate the 'Multiset' invariant that no element should appear+--   more than once.  And indeed, morally this function does not+--   output multisets at all.)+permutationsRLE :: Multiset a -> [[(a,Count)]]+permutationsRLE (MS []) = [[]]+permutationsRLE m       = permutationsRLE' (toRMS m)  -- | List all the (run-length encoded) distinct permutations of the--- elements of a multiset which do not start with the element to avoid--- (if any).-permutationsRLE' :: RMultiSet a -> [[(a,Count)]]+--   elements of a multiset which do not start with the element to+--   avoid (if any).+permutationsRLE' :: RMultiset a -> [[(a,Count)]]  -- If only one element is left, there's only one permutation. permutationsRLE' (RMS Nothing [(x,n)]) = [[(x,n)]]@@ -116,7 +197,7 @@ -- | Select an element + multiplicity from a multiset in all possible --   ways, appropriately keeping track of elements to avoid at the --   start of permutations.-selectRMS :: RMultiSet a -> [((a, Count), RMultiSet a)]+selectRMS :: RMultiset a -> [((a, Count), RMultiset a)]  -- No elements to select. selectRMS (RMS _ [])            = []@@ -138,7 +219,7 @@   -- Finally, we can recursively choose something other than x.   map (second (consRMS (x,n))) (selectRMS (RMS e ms)) -consRMS :: (a, Count) -> RMultiSet a -> RMultiSet a+consRMS :: (a, Count) -> RMultiset a -> RMultiset a consRMS x (RMS e m) = RMS e (x:m)  @@ -150,11 +231,11 @@ -- instance Arbitrary Count where --   arbitrary = elements (map ArbCount [1..3]) --- prop_perms_distinct :: MultiSet Char ArbCount -> Bool+-- prop_perms_distinct :: Multiset Char ArbCount -> Bool -- prop_perms_distinct m = length ps == length (nub ps) --   where ps = permutations m --- prop_perms_are_perms :: MultiSet Char ArbCount -> Bool+-- prop_perms_are_perms :: Multiset Char ArbCount -> Bool -- prop_perms_are_perms m = all ((==l') . sort) (permutations m) --   where l' = sort (toList m) @@ -213,14 +294,15 @@ --     <http://www.haskell.org/sitewiki/images/d/dd/TMR-Issue8.pdf> -- --   See that article for a detailed discussion of the code and how it works.-vPartitions :: Vec -> [MultiSet (Vec)]+vPartitions :: Vec -> [Multiset Vec] vPartitions v = vPart v (vZero v) where-  vPart v _ | vIsZero v = [[]]+  vPart v _ | vIsZero v = [MS []]   vPart v vL     | v <= vL   = []-    | otherwise = [(v,1)] : [ (v',k) : p' | v' <- withinFromTo v (vHalf v) (vInc v vL)-                                          , k  <- [1 .. (v `vDiv` v')]-                                          , p' <- vPart (v .-. (k *. v')) v' ]+    | otherwise = MS [(v,1)]+                : [ (v',k) +: p' | v' <- withinFromTo v (vHalf v) (vInc v vL)+                                 , k  <- [1 .. (v `vDiv` v')]+                                 , p' <- vPart (v .-. (k *. v')) v' ]  -- | 'vHalf v' computes the \"lexicographic half\" of 'v', that is, --   the vector which is the middle element (biased towards the end)@@ -264,8 +346,87 @@ --   each partition is represented as a multiset of parts (each of --   which is a multiset) in order to properly reflect the fact that --   some parts may occur multiple times.-partitions :: MultiSet a -> [MultiSet (MultiSet a)]-partitions [] = [[]]-partitions m  = (map . map . first) (combine elts) $ vPartitions counts+partitions :: Multiset a -> [Multiset (Multiset a)]+partitions (MS []) = [MS []]+partitions (MS m)  = (map . fmap) (combine elts) $ vPartitions counts   where (elts, counts) = unzip m-        combine es cs  = filter ((/=0) . snd) $ zip es cs+        combine es cs  = MS . filter ((/=0) . snd) $ zip es cs++-- | Generate all splittings of a multiset into two submultisets,+--   i.e. all size-two partitions.+splits :: Multiset a -> [(Multiset a, Multiset a)]+splits (MS [])        = [(MS [], MS [])]+splits (MS ((x,n):m)) =+  for [0..n] $ \k ->+    map (addElt x k *** addElt x (n-k)) (splits (MS m))++-- | Generate all size-k submultisets.+kSubsets :: Count -> Multiset a -> [Multiset a]+kSubsets 0 _              = [MS []]+kSubsets _ (MS [])        = []+kSubsets k (MS ((x,n):m)) =+  for [0 .. min k n] $ \j ->+    map (addElt x j) (kSubsets (k - j) (MS m))++for = flip concatMap++addElt _ 0 = id+addElt x k = ((x,k) +:)++-- | Generate all distinct cycles, aka necklaces, with elements taken+--   from a multiset.  See J. Sawada, \"A fast algorithm to generate+--   necklaces with fixed content\", J. Theor. Comput. Sci. 301 (2003)+--   pp. 477-489.+--+--   Given the ordering on the elements of the multiset based on their+--   position in the multiset representation (with \"smaller\"+--   elements first), in @map reverse (cycles m)@, each generated+--   cycle is lexicographically smallest among all its cyclic shifts,+--   and furthermore, the cycles occur in reverse lexicographic+--   order. (It's simply more convenient/efficient to generate the+--   cycles reversed in this way, and of course we get the same set of+--   cycles either way.)+--+--   For example, @cycles (fromList \"aabbc\") ==+--   [\"cabba\",\"bcaba\",\"cbaba\",\"bbcaa\",\"bcbaa\",\"cbbaa\"]@.+cycles :: Multiset a -> [[a]]+cycles (MS [])         = []   -- no such thing as an empty cycle+cycles m@(MS ((x1,n1):xs))+  | n1 == 1    = (cycles' n 2 1 [(0,x1)] (reverse $ zip [1..] xs))+  | otherwise =  (cycles' n 2 1 [(0,x1)] (reverse $ zip [0..] ((x1,n1-1):xs)))+  where n = sum . getCounts $ m++-- | The first parameter is the length of the necklaces being+--   generated.  The second parameter @p@ is the length of the longest+--   prefix of @pre@ which is a Lyndon word, i.e. an aperiodic+--   necklace.  @pre@ is the current (reversed) prefix of the+--   necklaces being generated.+cycles' :: Int -> Int -> Int -> [(Int, a)] -> [(Int, (a,Count))] -> [[a]]+cycles' n t p pre [] | n `mod` p == 0 = [map snd pre]+                     | otherwise      = []++cycles' n t p pre xs =+  (takeWhile ((>=atp) . fst) xs) >>= \(j, (xj,nj)) ->+    cycles' n (t+1) (if j == atp then p else t)+      ((j,xj):pre)+      (remove j xs)+  where atp = fst $ pre !! (p - 1)++remove j [] = []+remove j (x@(j',(xj,nj)):xs)+  | j == j' && nj == 1 = xs+  | j == j'            = (j',(xj,nj-1)):xs+  | otherwise          = x:remove j xs++-- | Take a multiset of lists, and select one element from each list+--   in every possible combination to form a list of multisets.  We+--   assume that all the list elements are distinct.+sequenceMS :: Multiset [a] -> [Multiset a]+sequenceMS = map disjUnions+           . sequence+           . map (\(xs, n) -> kSubsets n (MS $ uncollate (xs, n)))+           . toCounts++uncollate :: ([a], Count) -> [(a, Count)]+uncollate (xs, n) = map (\x -> (x,n)) xs+

@@ -1,7 +1,11 @@ Name:                multiset-comb-Version:             0.1-Synopsis:            Combinatorial operations on multisets-Description:         Efficiently generate all permutations and partitions of multisets.+Version:             0.2+Synopsis:            Combinatorial algorithms over multisets+Description:         Various combinatorial algorithms over multisets,+                     including generating all permutations,+                     partitions, size-2 partitions, size-k subsets,+                     and Sawada's algorithm for generating all+                     necklaces with elements from a multiset. Homepage:            http://code.haskell.org/~byorgey/code/multiset-comb License:             BSD3 License-file:        LICENSE@@ -12,7 +16,10 @@ Category:            Math Tested-with:         GHC ==6.10.4, GHC ==6.12.1 Build-type:          Simple-Cabal-version:       >=1.2+Cabal-version:       >=1.6+source-repository head+  type:     darcs+  location: http://code.haskell.org/~byorgey/code/multiset-comb  Library   Exposed-modules:     Math.Combinatorics.Multiset