Introduction

Posted on May 25, 2018

This is a very small chapter (just one page) in the book, and all we do here is define a permutation, introduce some notation, and count the total number of permutations of a given number of objects (everyone knows the answer). Nevertheless, we need to tell Haskell what a set is before we can tell it what a permutation is. And then we can also define some of the familiar operations on sets, which may come in handy later.

A permutation is an arrangement. Of elements of some set. We don't care what the elements are, so they might as well be the familar natural numbers that are easy to talk about. We'll denote the set of the first \(n\) natural numbers as \([n] = \{1, 2, \ldots, n\}\). Now we can define (our own version of) what a permutation is.

Definition: Permutation
A permutation is a linear ordering of the elements of the set \([n]\). In particular, this is an \(n\)-permutation. A general \(n\)-permutation \(p\) is written as \(p_1 p_2 \cdots p_n\), where \(p_i\) is the \(i\)th element in the linear order defined by \(p\).

There are other possible definitions of permutations, and we will be seeing those in later chapters.

Okay, so we've got permutations, but where is the combinatorics? Here it is, in this well known result.

Proposition
The number of \(n\)-permutations is \(n!\).

I promise the rest of this post will be less straightforward.1

Sets in Haskell

To efficiently encode a set in Haskell, we will use a binary search tree. First, let us look at what a binary tree is. A binary tree can be recursively defined as a structure consisting of a node and two children (left and right), each of which is itself a binary tree. But that defines an infinite binary tree, so we add a base case to this definition by stating that a binary tree is either an empty tree, or non-empty tree as we already defined.

Example: Binary Tree 
    a
   / \
  b   c
 /\   /\
.  . x  y
(where . denotes an empty tree), or equivalently 
    a
   / \
  b   c
      /\
     x  y
is a binary tree with root node 'a', whose left child is the (singleton) binary tree with root 'b' and right child is the tree with root 'c'. This latter tree itself has two children with root nodes 'x' and 'y'.

A binary search tree is a binary tree satisfying a constraint: every element in the left child of a node must be smaller than the element at the node, and similarly, every element in the right child should be greater than the element at the node.

For the moment, let us set the contraint aside and try to define a simple binary tree in Haskell. We will call it Set, since that's what we're trying to define using trees. Our recursive definition of a binary tree (or Set) can be beautifully implemented in Haskell by means of a data declaration:
data Set t = Null | NonEmpty t (Set t) (Set t).

Here is a great tutorial on types and typeclasses, if things are starting to get confusing.

However, the constructor name NonEmpty is too unwieldly, so let's replace it by something shorter. And why not Set itself? This is allowed, and it causes no problems – we just have to remember which is which. One is a type and the other is a function (Exercise: Write the type of the constructor function Set), so there is no cause for confusion.

Now using pattern matching we can define a function that extracts the element at the root node of the tree representing a set:
root (Set n left right) = n.

We could similarly define functions to extract the left and right children of the tree. But this is so mechanical a process that we can think of automating it. And that has already been done! Haskell's record syntax for data declarations automatically defines these "getter" functions for us. So let's rewrite the definition of Set.

This is a binary tree, not a binary search tree – because there is nothing to stop us from defining a set Set 1 (Set 2 Null (Set 3)) (Set 4 (Set 4) (Set 5)), which violates the constraint that left child elements must be smaller and right child elements must be greater than the root element (note that repeating an element is one of the ways of violating this contraint). This will break all the operations that we will be defining under the assumption that we are operating on a binary search tree. To prevent this, we will define a new way of constructing sets – adding one element at a time and making sure that it goes to its correct place in the tree.

But talking about comparing the elements of a set assumes they are comparable – in Haskell, this means they are members of the class Ord. Under no circumstances do we want to define or use a set of elements that cannot be ordered, so we can enforce this as a constraint in the data declaration itself. To do this, however, we need to enable the Generalised Algebraic Datatypes (GADTs) language option by adding {-# LANGUAGE GADTs -#} to the beginning of our source file. Now we rewrite Set yet again.

Remember (if you did the exercise) that the Set constructor is a function of type t -> Set t -> Set t -> Set t. Now we have just added the class constraint Ord t to its type signature. If we want to retain the record syntax, we have to rewrite this (one final time).

Now let us write that function for (correctly) building sets. We could write an insert function and then to construct the set \(\{1,2,3,4,5\}\), we would have to write
insert 1 $ insert 2 $ insert 3 $ insert 4 $ insert 5 Null.
Tiresome! (Exercise: Write the expression for the same set assuming that the first argument of insert is the set and the second one is the element). It's much cleaner to use an operator.

Now <<- is a left-associative infix operator with fixity 5, whose first argument is of type Set t and second argument is (an element) of type t. What should this operator do, for example, if we write set <<- n (where set is some already defined set)? Let's assume that set = Set m left right (i.e., it has root element m, and left and right children left and right respectively). If n is smaller than m, then we should insert it in the left child, and if it is greater than m, we should insert it in the right child. Otherwise, there is nothing to do, it's already in set. To insert n in the left or right child, we again use <<-, of course: left <<- n or right <<- n. So this function is recursive, and needs a base case. Where does our process (as it is at present) fail? When we reach a set that has no left or right child. That's Null. So the base case is inserting an element into Null, and that should obviously give us Set n Null Null. And that's it, we're done! Using pattern matching:

Now we can write our earlier example as Null <<- 1 <<- 2 <<- 3 <<- 4 <<- 5. So much simpler! But we can't "see" this set because we haven't written a show function yet. We could derive Show, but that's not of much use if we want the set to be displayed as {1,2,3,4,5} (like in math). So we need a clever show function.

It must be recursive and the base case is clearly show Null = "{}". Or is it? Remember that a non-empty set can have nodes with Null children. We don't want these as well to be shown as "{}". And in a recursive function call, there is no way of telling (without using flags or something similarly ugly), whether the current Null set is a child of some node or not. So what we will do is have show call a helper function show', which would do the heavy lifting and use recursion, and then insert the output between "{" and "}". The base case for show' should take a Null and return the empty string. And for a non-empty set we have:

Does this work? Clearly not, for show' $ Null <<- 1 would be ",1,". We need to be smarter. When the node has an empty child, we should not add a comma on that side. That becomes three different cases.

There is clearly some repetition of logic here. After all, whether it's on the left or right, a comma is inserted if and only if the tree is non-empty. That is, comma Null = "" and comma _ = ",". Using this, we can write a much more compact show'. Also, notice that we are calling show n, which assumes that n is a member of Show. This must be added as a constraint in the type signature.

Let's try this out.

Beautiful!

The most basic operation (or relation) for sets is membership. And that is easy to define. No element is a member of the empty set. An element is a member of a non-empty set if and only if it is either equal to the root element, or smaller than the root element and a member of the left child, or greater than the root element and a member of the right child (and this is what makes this represention of sets efficient).

Finally, we are ready to define permutations! We will not restrict permutations to arrangements of \([n]\) (partly because this is difficult to do, and partly because we will certainly have to revise this definition later). A permutation is just a list then, for a list (in Haskell) is naturally ordered from its first element to its last. But it is a list in which elements do not repeat. So once again, we have to define a type for permutations and then write a function that constructs only valid permutations. To define a permutation, we simply wrap a list in a constructor. Rather than using a data declaration, we will use a newtype.

A newtype combines the efficiency of a type (Perms and lists are indistinguishable in memory) with the safety of a data declaration (the wrapper ensures that Perms and lists are not interchange in code). And there are some additional benefits.

Now pList is a function that let's us easily extract the underlying list of a permutation whenever pattern matching is inconvenient, and comparing permutations is equivalent to comparing their underlying lists.

As in the case of Set, will write a new, smart constructor to replace Perm. We do want to construct permutations from lists (anything else would be too tedious), but we will have to discard any repetitions. So we read in the elements of the list one by one, and add it to the permutation only if it is not already present. In fact, we can first write a function to do this (safe) element addition, and use it repeatedly to construct a permutation from a list

In permIns, we use elem for lists (ps is the underlying list of the permutation we are constructing), because even though <<= for sets is more efficient on the average when we have to repeatedly search an existing set, constructing a set by adding elements one at a time is inefficient compared to constructing a list in the same way – adding an element to the head of a list is done in constant time, whereas inserting an element into a set (a binary search tree) can take linear time in the worst case. Again, in the interest of efficiency, permIns adds the element at the head of the permutation (list), which makes it necessary to reverse the final permutation in perm.

We have defined and constructed permutations, now all that remains is to generate \(n\)-permutations. There are some clever an relatively efficient algorithms to do this, but we will brute force it for now. The key idea in generating all permutations (naïvely) can be obtained by looking at the recurrence relation for counting all permutations. Indeed, this is generally true in all of combinatorics.

The total number of \(n\)-permutations is \(n\) times the total number of \((n - 1)\)-permutations: \(n! = n(n - 1)!\). The idea this gives is this:

Suppose we have all the \((n - 1)!\) permutations of a set of \(n - 1\) objects. If we now add an \(n\)th element to this set, then in order to get all of their \(n!\) permutations, we must somehow generate \(n\) permutations from each of the \((n - 1)!\) permutations of the smaler set (so that \(n \times (n - 1)! = n!\)).

But we do already know how we can generate those \(n\) \(n\)-permutations corresponding to each \((n-1)\)-permutation (for that is how we know the reccurence relation in the first place!). From each \((n-1)\)-permutation, we can get an \(n\)-permutation by inserting the new element somewhere in the \((n-1)\)-permutation. How many choices of places are there for inserting the element? There are \(n - 2\) places between the \(n - 1\) objects, and there are two more places (extreme left and extreme right), so the answer is \(n\). And this is precisely how we will generate the permutations too!

Our perms function will take a set as input, convert it to a list (guaranteed to have no repeated elements) and pass this to a helper function perms' (since it is more convenient to work with lists and avoid having to unwrap permutations all the time). The output of the helper function will be a list of lists, so perms will also have to wrap each permutation in Perm and finally return a list of permutations.

In defining perms', the helper function, the main difficulty seems to be in inserting the new element in all possible positions in the \((n-1)\)-permutation. This can be broken down into two logical steps. First, we tear apart a given list (the \((n-1)\)-permutation) into two parts in all possible ways. Then we join (concatenate) the two parts, but place the new element in between first. Concatenation of lists is easily done in Haskell, but although we could use take and drop to tear apart a list, it is more efficient to do this recursively and avoid performing the same operation twice. So we will write another helper function lisa to tear the list apart.

The argument ps is an accumulator (that stores all permutations generated so far). Then lisa mapped over them tears each one apart in all possible ways (generating a list of lists of list-tuples which have to be concatenated to give us back a list of list-tuples). And then we stitch each list-tuple back together but with the new element in between, and this is our new accumulator.

Let's write a show function for permutations and then test this!

Well, that was easy. Here we go then…

And that gives us a tiny verification of the proposition.

Here is the entire module, with some more operations on sets and permutations.

{-# LANGUAGE GADTs, StandaloneDeriving #-}

module M0Introduction (Set(Null), (<<=), (<<), (<<-), (->>), (<+>), (<**>),
                       setMap, card, setFoldl, setFoldr, setZipWith, setMin, setMax, listToSet, setToList, setToList', 
                       atom, consInts, finNats, nats,
                       perm, pList, permIns, revPerm, addPerms, perms, permSet) where

data Set t where
   Null :: Set t
   Set :: Ord t => {
       root :: t,
       lSet :: Set t,
       rSet :: Set t
   } -> Set t

instance Show t => Show (Set t) where
   show set = "{" ++ show' set ++ "}" where
       show' Null = ""
       show' (Set n left right) = show' left ++ comma left ++ show n ++ comma right ++ show' right where
           comma Null = ""
           comma _ = ","

-- Set membership
infix 4 <<=
(<<=) :: t -> Set t -> Bool
_ <<= Null = False
n <<= (Set m left right) = n == m || (n < m && n <<= left) || (n > m && n <<= right)

-- Subset
infix 4 <<
(<<) :: Set t -> Set t -> Bool
Null << _ = True
Set n left right << mset = n <<= mset && left << mset && right << mset

-- Set equality
instance Eq (Set t) where
   mset == nset = mset << nset && nset << mset

deriving instance Ord (Set t)

-- Insert into set
infixl 5 <<-
(<<-) :: Ord t => Set t -> t -> Set t
Null <<- n = Set n Null Null
Set m left right <<- n = Set m left' right' where
   (left', right') = case compare m n of
       LT -> (left, right <<- n)
       GT -> (left <<- n, right)
       EQ -> (left, right)

-- Delete from set
infixl 5 ->>
(->>) :: Set t -> t -> Set t
Null ->> n = Null
(Set m left right) ->> n
   | m < n = Set m left (right ->> n)
   | m > n = Set m (left ->> n) right
   | otherwise = left <+> right

-- Set union
infixl 5 <+>
(<+>) :: Set t -> Set t -> Set t
Null <+> set = set
set <+> Null = set
(Set m left1 right1) <+> (Set n left2 right2) = Set m left' right' <+> res where
   (left', right', res) = case compare m n of
       LT -> (left1, right1 <+> right2 <<- n, left2)
       GT -> (left1 <+> left2 <<- n, right1, right2)
       EQ -> (left1 <+> left2, right1 <+> right2, Null)

-- Set transformation by unary function applied to all elements
setMap :: (Ord a, Ord b) => (a -> b) -> Set a -> Set b
setMap _ Null = Null
setMap f (Set n left right) = Set (f n) (setMap f left) (setMap f right)

-- Set Cartesian product
infixl 6 <**>
(<**>) :: (Ord a, Ord b) => Set a -> Set b -> Set (a, b)
Null <**> _ = Null
Set m left right <**> nset = setMap (\n -> (m, n)) nset <+> left <**> nset <+> right <**> nset

-- Set cardinality
card :: Integral i => Set t -> i
card Null = 0
card (Set n left right) = 1 + card left + card right

-- Set left fold
setFoldl :: (a -> t -> a) -> a -> Set t -> a
setFoldl _ seed Null = seed
setFoldl f seed (Set n left right) = setFoldl f (setFoldl f seed left `f` n) right

-- Set right fold
setFoldr :: (t -> a -> a) -> a -> Set t -> a
setFoldr _ seed Null = seed
setFoldr f seed (Set n left right) = setFoldr f (n `f` setFoldr f seed right) left

-- Set Cartesian product with binary operation applied to tuples
setZipWith :: (Ord a, Ord b, Ord c) => (a -> b -> c) -> Set a -> Set b -> Set c
setZipWith op mset nset = setMap (\(m,n) -> op m n) $ mset <**> nset

-- Least element of a set
setMin :: Set t -> Maybe t
setMin Null = Nothing
setMin (Set n left _) = case setMin left of
   Just m -> Just m
   Nothing -> Just n

-- Greatest element of a set
setMax :: Set t -> Maybe t
setMax Null = Nothing
setMax (Set n _ right) = case setMax right of
   Just m -> Just m
   Nothing -> Just n

-- List to set conversion
listToSet :: Ord t => [t] -> Set t
listToSet = foldr (\n set -> set <<- n) Null

-- Set to list conversion using right fold
setToList :: Set t -> [t]
setToList = setFoldr (:) []

-- Set to list conversion using left fold
setToList' :: Set t -> [t]
setToList' = setFoldl (\list n -> n:list) []

-- Singleton set
atom :: Ord t => t -> Set t
atom n = Set n Null Null

-- Set of consecutive integers
consInts :: Integral i => i -> i -> Set i
consInts a b
   | b < a = Null
   | otherwise = Set m (consInts a (m - 1)) (consInts (m + 1) b) where
       m = div (a + b) 2

-- Set of first n naturals
finNats :: Integral i => i -> Set i
finNats = consInts 1

-- Set of all naturals
nats :: Integral i => Set i
nats = Set 1 Null (setMap (+1) nats)

newtype Perm t = Perm {pList :: [t]} deriving (Eq, Ord)

-- Insert into permutation
permIns :: Eq t => Perm t -> t -> Perm t
permIns (Perm ps) n
   | n `elem` ps = Perm ps
   | otherwise = Perm (n:ps)

-- Safe permutation constructor
perm :: Eq t => [t] -> Perm t
perm = Perm . reverse . pList . foldl permIns (Perm [])

instance Show t => Show (Perm t) where
   show = show . pList

-- Reverse of a permutation
revPerm :: Eq t => Perm t -> Perm t
revPerm = Perm . reverse . pList

-- Safe concatenation of permutations
addPerms :: Eq t => Perm t -> Perm t -> Perm t
addPerms (Perm ps) qperm = foldl (permIns) qperm $ reverse ps

-- List of all permutations of a set
perms :: Ord t => Set t -> [Perm t]
perms = map perm . perms' [[]] . setToList where
   perms' ps [] = ps
   perms' ps (n:ns) = perms' [first ++ [n] ++ rest | (first, rest) <- concat $ map lisa ps] ns
   lisa [] = [([], [])]
   lisa (p:ps) = ([], p:ps) : [(p:first, rest) | (first, rest) <- lisa ps]

-- Set of all permutations of a set
permSet :: Ord t => (Set t) -> Set (Perm t)
permSet = listToSet . perms

While exporting the module, we hide the unsafe constructors Set and Perm.


DISQUSsion
Thoughts, suggestions, questions, criticism…

Note
You can use HTML tags and syntax highlighting in your comments. To get syntax highlighting, use 
<pre><code class='haskell'> </code></pre>
(just copy and paste the above, and insert your code between the code tags). Unfortunately, Disqus does not presently support MathJax. So we have to either use a math pastebin, or just type \(\LaTeX\) code and hope everyone can read it, or… 
  V×W-ϕ->V⊗W
    \     |
    y\    |ỹ
      \   |
        ↘ ↓
         L
use ASCII math?!