Compositions

Consider the equation \[x_1 + \cdots + x_k = m\] where \(k\) and \(m\) are given positive integers and \(x_1,\ldots,x_k\) are nonnegative integer variables.

A classic problem in discrete math is to enumerate all solutions to the equation. A solution \((x_1,\ldots,x_k)\) is called a composition of \(m\) of length \(k\). It is well-known that the number of such compositions is given by \(\binom{m+k-1}{k-1}.\) For example, when \(k = 3\) and \(m = 2\), the formula gives \(\binom{2+3-1}{3-1} = \binom{4}{2} = 6\). The entire list can be easily obtained by hand: \((2,0,0)\), \((1,1,0)\), \((1,0,1))\), \((0,2,0)\), \((0,1,1)\), \((0,0,2)\).

We will be writing a number of Haskell functions that generate compositions satisfying different properties. We will be using QuickCheck under the Tasty framework to test our functions.

It should be noted that the combinat package contains a number of composition-related functions under the module Math.Combinat.Compositions. Since we want to develop our functions from scratch, the only function that we will use from this package is countCompositions :: Integral a => a -> a -> Integer which computes the number of compositions of a given length and a target sum. And we will only use it for testing.

Project setup with Cabal

We will set up our project as a library with a test suite.

We first create a directory named compositions. In this directory, we issue the following at the command line:

cabal init --lib --tests

It should create a couple of source files. We rename the source file for the testing code to Tests.hs and the source file under src to Compositions.hs. Our project directory structure is therefore as follows:

compositions
├── CHANGELOG.md
├── Tests.hs
├── compositions.cabal
└── src
    └── Compositions.hs

The file composition.cabal should contain the following:

test-suite compositions-test
    default-language: Haskell2010
    type:             exitcode-stdio-1.0

    main-is:          Tests.hs
    build-depends:    base ^>=4.14.3.0
                    , compositions
                    , combinat
                    , tasty
                    , tasty-quickcheck

No-frills compositions

We begin the file Compositon.hs with

module Compositions where

type Composition = [Int]

We create the type synonym Composition to make our code more readable.

Our first function is

compositions1 ::    Int -- length
                 -> Int -- target sum
                 -> [Composition]

Our goal is to have compositions k m generate all compositions of length \(k\) with sum \(m\) in lexicographically descending order. (Given two lists \(u=(u_1,\ldots,u_k)\) and \(v=(v_1,\ldots,v_k)\), \(u\) is lexicographically greater than \(v\) if there exists \(j \in \{1,\ldots,k\}\) so that \(u_i = v_i\) for \(i = 1,\ldots,j-1\) and \(u_j > v_j\).) For example, we want the output of compositions1 3 2 to be

[[2,0,0],[1,1,0],[1,0,1],[0,2,0],[0,1,1],[0,0,2]]

We can do this recursively. The base case is when the length is 1. In which case, there is unique composition given by the singleton list containing the sum:

compositions1 1 m = [[m]]

If the length is at least two, we note that the leading element, call it x, can be anything from 0 to the target sum, followed by a composition of length that is one less and target sum that is x less than the original target sum. This can be accomplished via a simple recursion:

compositions1 k m = [ x:ys |  x <- [m,m-1..0]
                           , ys <- compositions1 (k-1) (m-x) ]

Note that x goes from m down to 0 because we want to generate the compositions in lexicographically descending order. We will make sure that our code is correct later. In the meantime, we run this function with various inputs and check that it does what it is supposed to do.

λ> compositions1 4 1
[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]
λ> compositions1 3 3
[[3,0,0],[2,1,0],[2,0,1],[1,2,0],[1,1,1],[1,0,2],[0,3,0],[0,2,1],[0,1,2],[0,0,3]]

So far so good. Next, we develop a function that generate compositions with elements no greater than a given bound.

Bounded compositions

We can modify compositions1 to obtain

compositions2 ::    Int -- length
                 -> Int -- maximum
                 -> Int -- target sum
                 -> [Composition]

so that the output of compositions2 k m b is a lexicographically-descending list of all compositions of length k with target sum m so that each element is at most b.

The base case is still with k equal to 1. But now, we need to make sure that if the target sum exceeds the bound, an empty list is generated:

compositions2 1 m b
  | m > b = []
  | otherwise = [[b]]

For the recursion, we note that the leading element must be from 0 to the mininum of m and b:

compositions2 k m b = 
  let d = min m b
  in [ x:ys | x <- [d,d-1..0]
            , ys <- compositions2 (k-1) (m-x) b ]

Let’s give this a test run:

λ> compositions2 3 4 2
[[2,2,0],[2,1,1],[2,0,2],[1,2,1],[1,1,2],[0,2,2]]
*Compositions
λ> compositions2 3 3 1
[[1,1,1]]j
λ> compositions2 4 5 1
[]

Again, so far so good.

Maximum-leading element

The last function that we develop is the following:

compositions3 ::    Int -- length
                 -> Int -- target sum
                 -> [Composition]

We want compositions3 k m to generate a lexicographically-descending list of compositions of length k with sum m so that the leading element in each composition is no less than any of the remaining elements in the composition. The leading element x can be chosen from 0 to m. But now, the remaining elements must form a composition of length k-1 with target sum m-x so that each element is bounded by x. This is where compositions2 comes in handy.

Note that there is no need to run x down to 0 since the leading element must be at least m `div` k. Otherwise, x would be too small for a because the rest of the elements can only make a sum of at most (k-1)*x. The following implementation should work:

compositions3 1 m = [[m]]
compositions3 k m = 
  let low = m `div` k
  in [ x:ys | x <- [m,m-1..low]
            , ys <- compositions2 (k-1) (m-x) x]

Let’s give this a test run:

λ> compositions3 2 6
[[6,0],[5,1],[4,2],[3,3]]
λ> compositions3 4 2
[[2,0,0,0],[1,1,0,0],[1,0,1,0],[1,0,0,1]]

The outputs are as expected.

Testing with QuickCheck via Tasty

We now do some property testing on our functions.

First, observe that if an implementation of compositions1 is correct, each element in its output must satisfy the following:

1. All its elements must be nonnegative.
2. The sum of its elements must equal to the target sum.
3. Its length must equal the given length.

Once we know that every element in the output satisfies these properties, we just need to check that the output is in lexicographically-descending order and that the length of the output is exactly given by the binomial coefficient stated in the beginning of the article. These properties are now sufficient to guarantee that all the compositions have been generated which can be seen via a simple counting argument.

To this end, we can start our file Tests.hs with

module Main where

import Compositions
import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Math.Combinat.Compositions as MC hiding (Composition, compositions1)

smallPair :: Gen (Int, Int)
smallPair = do
  k <- elements [1..10]
  m <- elements [1..20]
  return (k, m)

-- Checks sum is m, length is k, all elements are nonnegative
propAreCompositions :: Property
propAreCompositions =
  forAll smallPair $
    \(k,m) -> all (\c -> sum c == m && length c == k && all (>= 0) c)
                  (compositions1 k m)

-- The number of compositions of length k with sum m is given by the binomial
-- coefficient binom(k+m-1,k-1). We use countComposition to compute this.
propCount :: Property
propCount =
  forAll smallPair $
    \(k,m) -> toInteger (length (compositions1 k m)) ==
              MC.countCompositions (toInteger k) (toInteger m)

isReverseSorted :: (Ord a) => [a] -> Bool
isReverseSorted xs = all (uncurry (>)) $ zip xs (tail xs) -- We disallow equality since there should be no duplicates

propSorted :: Property
propSorted =
  forAll smallPair $
    \(k,m) -> isReverseSorted $ compositions1 k m

tests1 :: TestTree
tests1 = testGroup "compositions1 tests"
  [ QC.testProperty "compositions1: sum, length, elem" propAreCompositions
  , QC.testProperty "compositions1: total count" propCount
  , QC.testProperty "compositions1: sorted in descending order" propSorted
  ]

main :: IO ()
main = defaultMain tests1

We use a custom generator smallPair to control the size of the test cases. We can now run the test suite by issuing the following at the command line:

cabal test

On my machine, the generated log file contains the following

Test suite compositions-test: RUNNING...
compositions1 tests
  compositions1: sum, length, elem:          OK (1.61s)
    +++ OK, passed 100 tests.
  compositions1: total count:                OK (3.40s)
    +++ OK, passed 100 tests.
  compositions1: sorted in descending order: OK (5.73s)
    +++ OK, passed 100 tests.

All 3 tests passed (10.75s)
Test suite compositions-test: PASS

At this point, we can be quite confident that compositions1 is correct.

We can of course write tests for compositions2 but we choose to jump right into writing tests for compositions3. Since compositions3 calls compositions2, if all the tests for compositions3 pass, we can be quite confident that compositions2 is also correct. Of course, if some tests fail, we should go back and test compositions2. (In any case, it is good software practice to write tests for compositions2 to avoid regression since one cannot anticipate what kind of refactoring is performed in the future.)

To test compositions3, we just use compositions1 to generate all the compositions and then filter out any composition that does not have a largest leading element. The following will do:

isGoodComposition :: Composition -> Bool
isGoodComposition (x:xs) = all (<= x) xs
isGoodComposition _ = error "This should never happen."

propComp3 :: Property
propComp3 =
  forAll smallPair $
    \(k,m) -> compositions3 k m == filter isGoodComposition (compositions1 k m)

We can now test this property by simply changing the line

main = defaultMain test1

to

main = defaultMain (QC.testProperty "compositions3" propComp3)

and issue once again the command

cabal test

Here are the test results on my machine:

Test suite compositions-test: RUNNING...
compositions3: OK (5.54s)
  +++ OK, passed 100 tests.

All 1 tests passed (5.54s)
Test suite compositions-test: PASS

Hooray! All tests passed. We can take a break and enjoy some tasty snacks.

Exercise

Write a test property for compositions2 and test it.