packages feed

combinat (empty) → 0.1

raw patch · 11 files changed

+908/−0 lines, 11 filesdep +arraydep +basedep +containerssetup-changed

Dependencies added: array, base, containers

Files

+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2008, Balazs Komuves+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither names of the copyright holders nor the names of the contributors+may be used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Math/Combinat.hs view
@@ -0,0 +1,40 @@++-- | A collection of functions to generate combinatorial+-- objects like partitions, combinations, permutations,+-- Young tableaux, various trees, etc.+--+-- The long-term goals are +--+--  (1) to be efficient; +--+--  (2) to be able to enumerate the structures +--      with constant memory usage. +--+-- The short-term goal is to generate +-- many interesting structures.+--+-- Naming conventions (subject to change): +--+--  * prime suffix: additional constrains, typically more general;+--+--  * underscore prefix: use plain lists instead of other types with +--    enforced invariants;+--+--  * \"count\" prefix: counting functions.++module Math.Combinat +  ( module Math.Combinat.Tuples+  , module Math.Combinat.Combinations+  , module Math.Combinat.Partitions+  , module Math.Combinat.Permutations+  , module Math.Combinat.Tableaux+  , module Math.Combinat.Trees+  ) where++import Math.Combinat.Tuples+import Math.Combinat.Combinations+import Math.Combinat.Partitions+import Math.Combinat.Permutations+import Math.Combinat.Tableaux+import Math.Combinat.Trees+
+ Math/Combinat/Combinations.hs view
@@ -0,0 +1,59 @@++-- | Combinations++module Math.Combinat.Combinations where++import Math.Combinat.Helper++-------------------------------------------------------++-- | Combinations fitting into a given shape and having a given degree.+--   The order is lexicographic, that is, +--+-- > sort cs == cs where cs = combinations' shape k+--+combinations'  +  :: [Int]         -- ^ shape+  -> Int           -- ^ sum+  -> [[Int]]+combinations' [] 0 = [[]]+combinations' [] _ = []+combinations' shape@(s:ss) n = +  [ x:xs | x <- [0..min s n] , xs <- combinations' ss (n-x) ] ++countCombinations' :: [Int] -> Int -> Integer+countCombinations' [] 0 = 1+countCombinations' [] _ = 0+countCombinations' shape@(s:ss) n = sum +  [ countCombinations' ss (n-x) | x <- [0..min s n] ] ++-- | All combinations fitting into a given shape.+allCombinations' :: [Int] -> [[[Int]]]+allCombinations' shape = map (combinations' shape) [0..d] where d = sum shape++-- | Combinations of a given length.+combinations +  :: Int       -- ^ length+  -> Int       -- ^ sum+  -> [[Int]]+combinations len d = combinations' (replicate len d) d++-- | # = \\binom { len+d-1 } { len-1 }+countCombinations :: Int -> Int -> Integer+countCombinations len d = binomial (len+d-1) (len-1)++-- | Positive combinations of a given length.+combinations1  +  :: Int       -- ^ length+  -> Int       -- ^ sum+  -> [[Int]]+combinations1 len d +  | len > d = []+  | otherwise = map plus1 $ combinations len (d-len)+  where+    plus1 = map (+1)++countCombinations1 :: Int -> Int -> Integer+countCombinations1 len d = countCombinations len (d-len)++-------------------------------------------------------
+ Math/Combinat/Helper.hs view
@@ -0,0 +1,63 @@++module Math.Combinat.Helper where++import Debug.Trace++debug :: Show a => a -> b -> b+debug x y = trace (show x) y++fromJust :: Maybe a -> a+fromJust (Just x) = x+fromJust Nothing = error "fromJust: Nothing"++-- iterated function application+nest :: Int -> (a -> a) -> a -> a+nest 0 _ x = x+nest n f x = nest (n-1) f (f x)++reverseOrdering :: Ordering -> Ordering+reverseOrdering LT = GT+reverseOrdering GT = LT+reverseOrdering EQ = EQ++reverseCompare :: Ord a => a -> a -> Ordering+reverseCompare x y = reverseOrdering $ compare x y++factorial :: Int -> Integer+factorial 0 = 1+factorial n = product [1..fromIntegral n]++binomial :: Int -> Int -> Integer+binomial n k +  | k > n = 0+  | k < 0 = 0+  | k > (n `div` 2) = binomial n (n-k)+  | otherwise = (product [n'-k'+1 .. n']) `div` (product [1..k'])+  where +    k' = fromIntegral k+    n' = fromIntegral n+    +intToBool :: Int -> Bool+intToBool 0 = False+intToBool 1 = True+intToBool _ = error "intToBool"++boolToInt :: Bool -> Int +boolToInt False = 0+boolToInt True  = 1++unfold1 :: (a -> Maybe a) -> a -> [a]+unfold1 f x = case f x of +  Nothing -> [x] +  Just y  -> x : unfold1 f y +  +unfold :: (b -> (a,Maybe b)) -> b -> [a]+unfold f y = let (x,m) = f y in case m of +  Nothing -> [x]+  Just y' -> x : unfold f y'++unfoldEither :: (b -> Either c (b,a)) -> b -> (c,[a])+unfoldEither f y = case f y of+  Left z -> (z,[])+  Right (y,x) -> let (z,xs) = unfoldEither f y in (z,x:xs)+
+ Math/Combinat/Partitions.hs view
@@ -0,0 +1,148 @@++-- | Partitions. Partitions are nonincreasing sequences of positive integers.++module Math.Combinat.Partitions+  ( -- * Type and basic stuff+    Partition+  , toPartition+  , toPartitionUnsafe+  , mkPartition+  , isPartition+  , fromPartition+  , height+  , width+  , heightWidth+  , weight+  , _dualPartition+  , dualPartition+    -- * Generation+  , _partitions' +  , partitions'  +  , countPartitions'+  , _partitions+  , partitions+  , countPartitions+  , allPartitions'  +  , allPartitions +  , countAllPartitions'+  , countAllPartitions+  ) +  where++import Data.List+import Math.Combinat.Helper++-------------------------------------------------------++-- | The additional invariant enforced here is that partitions +--   are monotone decreasing sequences of positive integers.+newtype Partition = Partition [Int] deriving (Eq,Ord,Show,Read)++-- | Sorts the input.+mkPartition :: [Int] -> Partition+mkPartition xs = Partition $ sortBy (reverseCompare) $ filter (>0) xs++-- | Assumes that the input is decreasing.+toPartitionUnsafe :: [Int] -> Partition+toPartitionUnsafe = Partition++-- | Checks whether the input is a partition.+toPartition :: [Int] -> Partition+toPartition xs = if isPartition xs+  then toPartitionUnsafe xs+  else error "toPartition: not a partition"+  +isPartition :: [Int] -> Bool+isPartition []  = True+isPartition [_] = True+isPartition (x:xs@(y:_)) = (x >= y) && isPartition xs++fromPartition :: Partition -> [Int]+fromPartition (Partition part) = part++-- | The first element of the sequence.+height :: Partition -> Int+height (Partition part) = case part of+  (p:_) -> p+  [] -> 0+  +-- | The length of the sequence.+width :: Partition -> Int+width (Partition part) = length part++heightWidth :: Partition -> (Int,Int)+heightWidth part = (height part, width part)++-- | The weight of the partition +--   (that is, the sum of the corresponding sequence).+weight :: Partition -> Int+weight (Partition part) = sum part++-- | The dual (or conjugate) partition.+dualPartition :: Partition -> Partition+dualPartition (Partition part) = Partition (_dualPartition part)++-- (we could be more efficient, but it hardly matters)+_dualPartition :: [Int] -> [Int]+_dualPartition [] = []+_dualPartition xs@(k:_) = [ length $ filter (>=i) xs | i <- [1..k] ]+  +-------------------------------------------------------++-- | Partitions of d, fitting into a given rectangle, as lists.+_partitions' +  :: (Int,Int)     -- ^ (height,width)+  -> Int           -- ^ d+  -> [[Int]]        +_partitions' _ 0 = [[]] +_partitions' (0,_) d = if d==0 then [[]] else []+_partitions' (_,0) d = if d==0 then [[]] else []+_partitions' (h,w) d = +  [ i:xs | i <- [1..min d h] , xs <- _partitions' (i,w-1) (d-i) ]++-- | Partitions of d, fitting into a given rectangle. The order is again lexicographic.+partitions'  +  :: (Int,Int)     -- ^ (height,width)+  -> Int           -- ^ d+  -> [Partition]+partitions' hw d = map toPartitionUnsafe $ _partitions' hw d        ++countPartitions' :: (Int,Int) -> Int -> Integer+countPartitions' _ 0 = 1+countPartitions' (0,_) d = if d==0 then 1 else 0+countPartitions' (_,0) d = if d==0 then 1 else 0+countPartitions' (h,w) d = sum+  [ countPartitions' (i,w-1) (d-i) | i <- [1..min d h] ] ++-- | Partitions of d, as lists+_partitions :: Int -> [[Int]]+_partitions d = _partitions' (d,d) d++-- | Partitions of d.+partitions :: Int -> [Partition]+partitions d = partitions' (d,d) d++countPartitions :: Int -> Integer+countPartitions d = countPartitions' (d,d) d++-- | All partitions fitting into a given rectangle.+allPartitions'  +  :: (Int,Int)        -- ^ (height,width)+  -> [[Partition]]+allPartitions' (h,w) = [ partitions' (h,w) i | i <- [0..d] ] where d = h*w++-- | All partitions up to a given degree.+allPartitions :: Int -> [[Partition]]+allPartitions d = [ partitions i | i <- [0..d] ]++-- | # = \\binom { h+w } { h }+countAllPartitions' :: (Int,Int) -> Integer+countAllPartitions' (h,w) = +  binomial (h+w) (min h w)+  --sum [ countPartitions' (h,w) i | i <- [0..d] ] where d = h*w++countAllPartitions :: Int -> Integer+countAllPartitions d = sum [ countPartitions i | i <- [0..d] ]++-------------------------------------------------------+
+ Math/Combinat/Permutations.hs view
@@ -0,0 +1,86 @@++-- | Permutations. See:+--   Donald E. Knuth: The Art of Computer Programming, vol 4, pre-fascicle 2B.+--+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+module Math.Combinat.Permutations where++import Data.List+import Data.Array++import Math.Combinat.Helper++-------------------------------------------------------+{-+-- * Types++-- | Standard notation for permutations+newtype Permutation = Permutation (Array Int Int) deriving (Eq,Ord,Show,Read)++-- | Disjoint cycle notation for permutations+newtype DisjCycles  = DisjCycles [[Int]] deriving (Eq,Ord,Show,Read)+-}++-------------------------------------------------------+-- * Permutations of distinct elements++-- | Permutations of [1..n] in lexicographic order, naive algorithm.+_permutations :: Int -> [[Int]]  +_permutations 0 = [[]]+_permutations 1 = [[1]]+_permutations n = helper [1..n] where+  helper [] = [[]]+  helper xs = [ i : ys | i <- xs , ys <- helper (xs `minus` i) ]+  minus [] _ = []+  minus (x:xs) i = if x < i then x : minus xs i else xs++{-+permutations :: Int -> [Permutation]+permutations n = map toPermutationUnsafe $ _permutations n +-}++-- | # = n!+countPermutations :: Int -> Integer+countPermutations = factorial++-------------------------------------------------------+-- * Permutations of a multiset++-- | Generates all permutations of a multiset. +--   The order is lexicographic.  +permute :: (Eq a, Ord a) => [a] -> [[a]] +permute = fasc2B_algorithm_L++-- | # = \\frac { (\sum_i n_i) ! } { \\prod_i (n_i !) }    +countPermute :: (Eq a, Ord a) => [a] -> Integer+countPermute xs = factorial n `div` product [ factorial (length z) | z <- group ys ] +  where+    ys = sort xs+    n = length xs+  +-- | Generates all permutations of a multiset +--   (based on \"algorithm L\" in Knuth; somewhat less efficient). +--   The order is lexicographic.  +fasc2B_algorithm_L :: (Eq a, Ord a) => [a] -> [[a]] +fasc2B_algorithm_L xs = unfold1 next (sort xs) where+  -- next :: [a] -> Maybe [a]+  next xs = case findj (reverse xs,[]) of +    Nothing -> Nothing+    Just ( (l:ls) , rs) -> Just $ inc l ls (reverse rs,[]) +    Just ( [] , _ ) -> error "permute: should not happen"++  -- we use simple list zippers: (left,right)+  -- findj :: ([a],[a]) -> Maybe ([a],[a])   +  findj ( xxs@(x:xs) , yys@(y:_) ) = if x >= y +    then findj ( xs , x : yys )+    else Just ( xxs , yys )+  findj ( x:xs , [] ) = findj ( xs , [x] )  +  findj ( [] , _ ) = Nothing+  +  -- inc :: a -> [a] -> ([a],[a]) -> [a]+  inc u us ( (x:xs) , yys ) = if u >= x+    then inc u us ( xs , x : yys ) +    else reverse (x:us)  ++ reverse (u:yys) ++ xs+  inc _ _ ( [] , _ ) = error "permute: should not happen"+      +-------------------------------------------------------
+ Math/Combinat/Tableaux.hs view
@@ -0,0 +1,118 @@++-- | Young tableaux and similar gadgets. +--   See e.g. William Fulton: Young Tableaux, with Applications to +--   Representation theory and Geometry (CUP 1997).+-- +--   The convention is that we use +--   the English notation, and we store the tableaux as lists of the rows.+-- +--   That is, the following standard tableau of shape [5,4,1]+-- +-- >  1  3  4  6  7+-- >  2  5  8 10+-- >  9+--+--   is encoded conveniently as+-- +-- > [ [ 1 , 3 , 4 , 6 , 7 ]+-- > , [ 2 , 5 , 8 ,10 ]+-- > , [ 9 ]+-- > ]+--++module Math.Combinat.Tableaux where++import Data.List++import Math.Combinat.Helper+import Math.Combinat.Partitions++-------------------------------------------------------+-- * Basic stuff++type Tableau a = [[a]]++_shape :: Tableau a -> [Int]+_shape t = map length t ++shape :: Tableau a -> Partition+shape t = toPartition (_shape t)++dualTableau :: Tableau a -> Tableau a+dualTableau = transpose++hooks :: Partition -> Tableau Int+hooks part = zipWith f p [1..] where +  p = fromPartition part+  q = _dualPartition p+  f l i = zipWith (\x y -> x+y-i) q [l,l-1..1] ++-------------------------------------------------------+-- * Row and column words++rowWord :: Tableau a -> [a]+rowWord = concat . reverse++rowWordToTableau :: Ord a => [a] -> Tableau a+rowWordToTableau xs = reverse rows where+  rows = break xs+  break [] = [[]]+  break [x] = [[x]]+  break (x:xs@(y:_)) = if x>y+    then [x] : break xs+    else let (h:t) = break xs in (x:h):t++columnWord :: Tableau a -> [a]+columnWord = rowWord . transpose++columnWordToTableau :: Ord a => [a] -> Tableau a+columnWordToTableau = transpose . rowWordToTableau+    +-------------------------------------------------------+-- * Standard Young tableaux++-- | Standard Young tableaux of a given shape.+--   Adapted from John Stembridge, +--   <http://www.math.lsa.umich.edu/~jrs/software/SFexamples/tableaux>.+standardYoungTableaux :: Partition -> [Tableau Int]+standardYoungTableaux shape' = map rev $ tableaux shape where+  shape = fromPartition shape'+  rev = reverse . map reverse+  tableaux :: [Int] -> [Tableau Int]+  tableaux p = +    case p of+      []  -> [[]]+      [n] -> [[[n,n-1..1]]]+      _   -> worker (n,k) 0 [] p+    where+      n = sum p+      k = length p+  worker :: (Int,Int) -> Int -> [Int] -> [Int] -> [Tableau Int]+  worker _ _ _ [] = []+  worker nk i ls (x:rs) = case rs of+    (y:_) -> if x==y +      then worker nk (i+1) (x:ls) rs+      else worker2 nk i ls x rs+    [] ->  worker2 nk i ls x rs+  worker2 :: (Int,Int) -> Int -> [Int] -> Int -> [Int] -> [Tableau Int]+  worker2 nk@(n,k) i ls x rs = new ++ worker nk (i+1) (x:ls) rs where+    old = if x>1 +      then             tableaux $ reverse ls ++ (x-1) : rs+      else map ([]:) $ tableaux $ reverse ls ++ rs   +    a = k-1-i+    new = {- debug ( i , a , head old , f a (head old) ) $ -}+      map (f a) old+    f :: Int -> Tableau Int -> Tableau Int+    f _ [] = []+    f 0 (t:ts) = (n:t) : f (-1) ts+    f j (t:ts) = t : f (j-1) ts+  +-- | hook-length formula+countStandardYoungTableaux :: Partition -> Integer+countStandardYoungTableaux part = {- debug (hooks part) $ -}+  factorial n `div` h where+    h = product $ map fromIntegral $ concat $ hooks part +    n = weight part+        +-------------------------------------------------------+
+ Math/Combinat/Trees.hs view
@@ -0,0 +1,259 @@++-- | Trees, forests, etc. See:+--   Donald E. Knuth: The Art of Computer Programming, vol 4, pre-fascicle 4A.++module Math.Combinat.Trees +  ( -- * Types+    BinTree(..)+  , leaf+  , module Data.Tree +  , Paren(..)+  , parenthesesToString+  , stringToParentheses+    -- * Bijections+  , forestToNestedParentheses+  , forestToBinaryTree+  , nestedParenthesesToForest+  , nestedParenthesesToForestUnsafe+  , nestedParenthesesToBinaryTree+  , nestedParenthesesToBinaryTreeUnsafe+  , binaryTreeToForest+  , binaryTreeToNestedParentheses+    -- * Nested parentheses+  , nestedParentheses +  , fasc4A_algorithm_P+    -- * Binary trees+  , binaryTrees+  , countBinaryTrees+  , binaryTreesNaive+  ) +  where++import Data.List+import Data.Tree (Tree(..),Forest(..))++import Math.Combinat.Helper++-------------------------------------------------------+-- * Types++data BinTree a+  = Branch (BinTree a) (BinTree a)+  | Leaf a+  deriving (Eq,Ord,Show,Read)++leaf :: BinTree ()+leaf = Leaf ()++-------------------------------------------------------++data Paren = LeftParen | RightParen deriving (Eq,Ord,Show,Read)++parenToChar :: Paren -> Char+parenToChar LeftParen = '('+parenToChar RightParen = ')'++parenthesesToString :: [Paren] -> String+parenthesesToString = map parenToChar++stringToParentheses :: String -> [Paren]+stringToParentheses [] = []+stringToParentheses (x:xs) = p : stringToParentheses xs where+  p = case x of+    '(' -> LeftParen+    ')' -> RightParen+    _ -> error "stringToParentheses: invalid character"++-------------------------------------------------------+-- * Bijections++forestToNestedParentheses :: Forest a -> [Paren]+forestToNestedParentheses = forest where+  -- forest :: Forest a -> [Paren]+  forest = concatMap tree +  -- tree :: Tree a -> [Paren]+  tree (Node _ sf) = LeftParen : forest sf ++ [RightParen]++forestToBinaryTree :: Forest a -> BinTree ()+forestToBinaryTree = forest where+  -- forest :: Forest a -> BinTree ()+  forest = foldr Branch leaf . map tree +  -- tree :: Tree a -> BinTree ()+  tree (Node _ sf) = case sf of+    [] -> leaf+    _  -> forest sf +   +nestedParenthesesToForest :: [Paren] -> Maybe (Forest ())+nestedParenthesesToForest ps = +  case parseForest ps of +    (rest,forest) -> case rest of+      [] -> Just forest+      _  -> Nothing+  where  +    parseForest :: [Paren] -> ( [Paren] , Forest () )+    parseForest ps = unfoldEither parseTree ps+    parseTree :: [Paren] -> Either [Paren] ( [Paren] , Tree () )  +    parseTree orig@(LeftParen:ps) = let (rest,ts) = parseForest ps in case rest of+      (RightParen:qs) -> Right (qs, Node () ts)+      _ -> Left orig+    parseTree qs = Left qs++nestedParenthesesToForestUnsafe :: [Paren] -> Forest ()+nestedParenthesesToForestUnsafe = fromJust . nestedParenthesesToForest++nestedParenthesesToBinaryTree :: [Paren] -> Maybe (BinTree ())+nestedParenthesesToBinaryTree ps = +  case parseForest ps of +    (rest,forest) -> case rest of+      [] -> Just forest+      _  -> Nothing+  where  +    parseForest :: [Paren] -> ( [Paren] , BinTree () )+    parseForest ps = let (rest,ts) = unfoldEither parseTree ps in (rest , foldr Branch leaf ts)+    parseTree :: [Paren] -> Either [Paren] ( [Paren] , BinTree () )  +    parseTree orig@(LeftParen:ps) = let (rest,ts) = parseForest ps in case rest of+      (RightParen:qs) -> Right (qs, ts)+      _ -> Left orig+    parseTree qs = Left qs+    +nestedParenthesesToBinaryTreeUnsafe :: [Paren] -> BinTree ()+nestedParenthesesToBinaryTreeUnsafe = fromJust . nestedParenthesesToBinaryTree++binaryTreeToNestedParentheses :: BinTree a -> [Paren]+binaryTreeToNestedParentheses = worker where+  worker (Branch l r) = LeftParen : worker l ++ RightParen : worker r+  worker (Leaf _) = []++binaryTreeToForest :: BinTree a -> Forest ()+binaryTreeToForest = worker where+  worker (Branch l r) = Node () (worker l) : worker r+  worker (Leaf _) = []++-------------------------------------------------------+-- * Nested parentheses++-- | Synonym for 'fasc4A_algorithm_P'.+nestedParentheses :: Int -> [[Paren]]+nestedParentheses = fasc4A_algorithm_P++-- | Generates all sequences of nested parentheses of length 2n.+-- Order is lexigraphic (when right parentheses are considered +-- smaller then left ones).+-- Based on \"Algorithm P\" in Knuth, but less efficient because of+-- the \"idiomatic\" code.+fasc4A_algorithm_P :: Int -> [[Paren]]+fasc4A_algorithm_P 0 = []+fasc4A_algorithm_P 1 = [[LeftParen,RightParen]]+fasc4A_algorithm_P n = unfold next ( start , [] ) where +  start = concat $ replicate n [RightParen,LeftParen]  -- already reversed!+   +  next :: ([Paren],[Paren]) -> ( [Paren] , Maybe ([Paren],[Paren]) )+  next ( (a:b:ls) , [] ) = next ( ls , b:a:[] )+  next ( lls@(l:ls) , rrs@(r:rs) ) = ( visit , new ) where+    visit = reverse lls ++ rrs+    new = +      {- debug (reverse ls,l,r,rs) $ -} +      case l of +	      RightParen -> Just ( ls , LeftParen:RightParen:rs )+	      LeftParen  -> +	        {- debug ("---",reverse ls,l,r,rs) $ -}+	        findj ( lls , [] ) ( reverse (RightParen:rs) , [] ) ++  findj :: ([Paren],[Paren]) -> ([Paren],[Paren]) -> Maybe ([Paren],[Paren])+  findj ( [] , _ ) _ = Nothing+  findj ( lls@(l:ls) , rs) ( xs , ys ) = +    {- debug ((reverse ls,l,rs),(reverse xs,ys)) $ -}+    case l of+	    LeftParen  -> case xs of+	      (a:_:as) -> findj ( ls, RightParen:rs ) ( as , LeftParen:a:ys )+	      _ -> findj ( lls, [] ) ( reverse rs ++ xs , ys) +	    RightParen -> Just ( reverse ys ++ xs ++ reverse (LeftParen:rs) ++ ls , [] )+    ++-------------------------------------------------------+-- * Binary trees++-- | Generates all binary trees with n nodes. +binaryTrees :: Int -> [BinTree ()]+binaryTrees = binaryTreesNaive++-- | # = Catalan(n) = \\frac { 1 } { n+1 } \\binom { 2n } { n }.+--+-- This is also the counting function for forests and nested parentheses.+countBinaryTrees :: Int -> Integer+countBinaryTrees n = binomial (2*n) n `div` (1 + fromIntegral n)++-- | Generates all binary trees with n nodes. The naive algorithm.+binaryTreesNaive :: Int -> [BinTree ()]+binaryTreesNaive 0 = [ leaf ]+binaryTreesNaive n = +  [ Branch l r +  | i <- [0..n-1] +  , l <- binaryTreesNaive i +  , r <- binaryTreesNaive (n-1-i) +  ]++----- binary tree zipper++data Ctx a+  = Top +  | L (Ctx a) (BinTree a)+  | R (BinTree a) (Ctx a) ++type Loc a = (BinTree a, Ctx a)++left :: Loc a -> Loc a+left (Branch l r , c) = (l , L c r)+left (Leaf _ , _) = error "left: Leaf"++right :: Loc a -> Loc a+right (Branch l r , c) = (r , R l c)+right (Leaf _ , _) = error "right: Leaf"+ +top :: BinTree a -> Loc a+top t = (t, Top)+ +up :: Loc a -> Loc a+up (t, L c r) = (Branch t r, c)+up (t, R l c) = (Branch l t, c)+up (t, Top  ) = error "up: top"++upmost :: Loc a -> Loc a+upmost l@(t, Top) = l+upmost l = upmost (up l)+ +modify :: (BinTree a -> BinTree a) -> Loc a -> Loc a+modify f (t, c) = (f t, c)++-----++{-+-- | Generates all binary trees with n nodes.+-- Based on \"Algorithm B\" in Knuth, uses tree zippers.+fasc4A_algorithm_B	:: Int -> [BinTree ()]+fasc4A_algorithm_B 0 = [ leaf ]+fasc4A_algorithm_B n = unfold1 next start where+  start = nest n (\t -> Branch t leaf) leaf++  killLeft  (Branch _ r) = Branch leaf r+  killRight (Branch l _) = Branch l leaf+  +  next t = case findj (top t) of+    Nothing -> Nothing+    Just locj@(s,c) -> case findk (top s) of+      lock@(u,Top) -> Just $ promote (modify killLeft locj ) lock +      lock@(u,_  ) -> Just $ promote locj (modify killRight lock)+      +  findj :: Loc () -> Maybe (Loc ())+  findj (Branch (Leaf _) t , c) = case t of+    Branch l r -> findj $ left (Branch t leaf , c) +    Leaf _ -> Nothing+  findj loc@(Leaf _ , c) = Just loc++  findk :: Loc () -> Loc ()+  findk loc@( Branch l (Leaf _) , _) = loc+  findk loc@( Branch l r , _) = findk (right loc)+  +  promote :: Loc () -> Loc () -> BinTree ()+  promote locj lock = undefined+-}
+ Math/Combinat/Tuples.hs view
@@ -0,0 +1,61 @@++-- | Tuples.++module Math.Combinat.Tuples where++import Math.Combinat.Helper++-------------------------------------------------------+-- Tuples++-- | \"Tuples\" fitting into a give shape. The order is lexicographic, that is,+--+-- > sort ts == ts where ts = tuples' shape+--+--   Example: +--+-- > tuples' [2,3] = +-- >   [[0,0],[0,1],[0,2],[0,3],[1,0],[1,1],[1,2],[1,3],[2,0],[2,1],[2,2],[2,3]]+--+tuples' :: [Int] -> [[Int]]+tuples' [] = [[]]+tuples' (s:ss) = [ x:xs | x <- [0..s] , xs <- tuples' ss ] ++-- | positive \"tuples\" fitting into a give shape.+tuples1' :: [Int] -> [[Int]]+tuples1' [] = [[]]+tuples1' (s:ss) = [ x:xs | x <- [1..s] , xs <- tuples1' ss ] ++-- | # = \\prod_i (m_i + 1)+countTuples' :: [Int] -> Integer+countTuples' shape = product $ map f shape where+  f k = 1 + fromIntegral k++-- | # = \\prod_i m_i+countTuples1' :: [Int] -> Integer+countTuples1' shape = product $ map fromIntegral shape++tuples +  :: Int    -- ^ length (width)+  -> Int    -- ^ maximum (height)+  -> [[Int]]+tuples len k = tuples' (replicate len k)++tuples1 +  :: Int    -- ^ length (width)+  -> Int    -- ^ maximum (height)+  -> [[Int]]+tuples1 len k = tuples1' (replicate len k)++-- | # = (m+1) ^ len+countTuples :: Int -> Int -> Integer+countTuples len k = (1 + fromIntegral k) ^ len++-- | # = m ^ len+countTuples1 :: Int -> Int -> Integer+countTuples1 len k = fromIntegral k ^ len++binaryTuples :: Int -> [[Bool]]+binaryTuples len = map (map intToBool) (tuples len 1)++-------------------------------------------------------
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell
+ 
+> import Distribution.Simple
+> main = defaultMain
+ combinat.cabal view
@@ -0,0 +1,41 @@+Name:                combinat+Version:             0.1+Synopsis:            Generation of various combinatorial objects.+Description:         A collection of functions to generate combinatorial+                     objects like partitions, combinations, permutations,+                     Young tableaux, various trees, etc.+License:             BSD3+License-file:        LICENSE+Author:              Balazs Komuves+Copyright:           (c) 2008 Balazs Komuves+Maintainer:          bkomuves (plus) hackage (at) gmail (dot) com+Stability:           Unstable+--Portability:         Portable+Category:            Math+Tested-With:         GHC == 6.8.3+Cabal-Version:       >= 1.2+Build-Type:          Simple++Flag splitBase+  Description: Choose the new smaller, split-up base package.++Library+  if flag(splitBase)+    Build-Depends:       base >= 3, array, containers+  else+    Build-Depends:       base <  3++  Exposed-Modules:     Math.Combinat, +                       Math.Combinat.Tuples, +                       Math.Combinat.Combinations,+                       Math.Combinat.Partitions,+                       Math.Combinat.Permutations,+                       Math.Combinat.Tableaux,+                       Math.Combinat.Trees+  +  Other-Modules:       Math.Combinat.Helper++  Hs-Source-Dirs:      .++  ghc-options:         -Wall -fno-warn-unused-matches+