Posts Tagged ‘permutation’

Solving the Countdown Numbers Problem with F#

Countdown Problem is a game from the UK TV described in the following link (PDF).  Basically, giving a set of numbers  and a single number, you have to use the arithmetic  operation to build a expression of the given numbers (in any subset and order) , that evaluate to the specified number.   I will call this task in this article “The Countdown Problem”, since using the word “Problem” makes it sounds more as an academic (or as a homework , see the first comment on my question on Stackoverflow).

 

I came across this Problem after watching the "Functional Programming Fundamentals” series on Channel9, with Erik Mejer. Graham Hutton (the author of Programming in Haskell) guest-hosted the 11th episode and showed how to solve this problem using brute force with Haskell. As I’m learning F# currently I started to implement the program in F# as well. Despite being heavily based on the Haskell solution from that episode, this code is not an accurate translation of the Haskell code. It just uses the same ideas.

 

At first let us make a structure to hold the possible operations:

type Op = Add | Sub | Mul | Div

This kind of types is called discriminated unions which means that an instance of this type is one of the named cases. An operation could be any of the following cases: Addition, Subtraction, multiplication or division.

The second type is an arithmetic expression, which may either be an integer or two expressions combined using an operation from the previous ones:

type Expr = Val of int 
            |  App of Op * Expr * Expr

Boy, I love discriminated unions ;)

 

Now we have the structures to hold the possible combinations, we still have to generate then in some way. For a set of numbers  we have to generate all possible subsets, and for each of those subsets all permutations have to be generated. Its obvious that this task can be composed from two separate functions: building subsets and permutating them.

The first function generate all subsets of the set of numbers:

let rec subSets items =

    match items with

    | [] -> seq{yield []}

    | x::xs -> seq{

                let sub = subSets xs

                yield! sub

                yield! sub |> Seq.map (fun l -> x::l) }

This exploits the simple idea that for each element of the set there are two almost identical categories of subsets;  subsets that include this element, and the matching subsets that don’t. This could be exploited using an inductive approach to generate the subsets of small sets and then adding new elements successively to those sets.  This function returns a sequence instead of an instance of Set because the number of subsets is exponential to the number of elements in the original set.  Sequences are lazy evaluated, and thus consume less memory. There are 2n subsets of any set of n elements.

The Second function generates for a giving set  alls possible permutations:

let rec permutations items =

    match items with

    | [] -> seq{yield []}

    | _ ->  seq{for x in items do

                let oth = [for c in items do if c <> x then yield c ]

                yield! permutations oth |> Seq.map (fun l -> x::l) }

This function returns n! different permutations for each set of n elements.

Now we can compose both methods to retrieve a method that generates all permutations of all subsets of a given set:

let choices items = 

    seq{for x in subSets items do   

         yield! permutations x }

Given a set of n elements, this function returns n!.2n different choices, which is a huge number. For n=6 choices yields  46080  elements.

After building all possible permutated subsets of the number set there is still many ways to combine them into an arithmetic expression.  An arithmetic could be represented as a binary tree. Each node in this tree is an operation and the leaves are numbers. Building a binary tree could be done by splitting combining both binary trees into one with a single root node. This could be repeated recursively for all possible sub trees and possible splitting points to generate all binary trees:

let rec generateExpressions nums =

    match nums with

    |[] -> Seq.empty

    |[a] -> seq{yield Val(a)}

    |_->seq{for posnum in choices nums do

            for (f,s) in split posnum do

            for first in generateExpressions f do

                 for second in generateExpressions s do

                    for op in [Add;Sub;Mul;Div] do

                        yield App(op,first,second)}

This yields an enormous number of binary trees. For a fixed number of leaves n one could construct (2n)! /((n+a)!n!) different trees.   We will see in a coming article how to reduce this number by avoiding redundant expressions because of the commutatively of adding and multiplication.   “split” is the function that splits a list into two non trivial list without changing the order of elements.

 

Now we move to the evaluating arithmetical expressions.  The function “eval” takes an expression and returns an list of integers. This is a common technique when programming in Haskell to express Null. If the expression is valid the function will evaluate it and return a singleton listing containing the result otherwise it will return an empty list.

let rec eval expr =

    match expr with

    |Val(n) -> [n]

    |App(op, left, right)  -> 

        [for l in eval left do

         for r in eval right do

             if valid op l r then

                yield apply op l r]

“valid” is a simple function that ensure that all intermediate results are natural numbers. If valid of sum expression returned false all tree containing the sub tree of this expression are invalid.:

let valid op f s  = 

    match op with

    |Add -> true       

    |Sub -> f >= s

    |Mul -> true  

    |Div -> (s <> 0) && (f % s = 0)  

Now we have all necessary tools to iterate thru all possible combinations and returning the  ones which matching result:

let solutions nums result =

    seq {for ex in generateExpressions nums do 

            if (eval ex |> Seq.to_list) = [result] then

                yield ex}

 

Running this function on the same input as the one presented in the Haskell lecture of Hutton returns the same result:

solutions [1; 3; 7; 10; 25; 50] 765   

    |> Seq.length

The only problem with this Algorithm is the runtime. It takes too much to calculate the result.

Finding one solution is relative fast, but finding all results takes for ever. In the coming article I will try to reduce the runtime by avoiding redundant arithmetic expressions.

The code exists on http://github.com/mouk/Countdown and will be updated to reflect the planed changes.