Posted in:

My initial attempt at solving the Advent of Code day 11 challenge proved a failure because my depth-first search didn’t return in a reasonable time.

What was needed for this problem was a breadth-first search instead. This is much more memory intensive, but has the advantage that the first solution found is the shortest solution.

To implement it, we need a queue of states. For each item on the queue, we get all the valid child states, check if it is the solution and if so exit, and otherwise add all the child states to the queue. Obviously this can cause a vast number of items to get queued up.

I tried at first to implement this in a purely functional way, using list concatenation to add the children to the list of states. However, that turned out to be horribly inefficient.

But I did eventually get some code out that solved day 11. Let’s start from the outside this time, and look at the breadth first solver:

let solve startState =
    let seen = new HashSet<State>()
    let statesQueue = new Queue<State*int>()
    let rec solveBreadthFirst() =
        if statesQueue.Count = 0 then
            failwith "no solution"
        else
            let (head,n) = statesQueue.Dequeue()
            if isSolution head then n
            else 
                for c in getUnseenNextStates seen head do
                    statesQueue.Enqueue (c, n+1)
                solveBreadthFirst()
    statesQueue.Enqueue (startState,0)
    solveBreadthFirst()

Here you can see that we have a HashSet of states that we’ve seen. This is important to prevent infinite loops (where we keep moving the same item up and down), but also is a big optimization since if one already discovered path contains a given state, then no other path that contains that state can have a quicker solution. (In our code state is basically what’s on what floor)

Then we have our breadth-first queue, which contains tuples of state and int. The int is how many steps it’s taken to get this far.

Then we just need to loop around processing items from the queue, exiting if we reach the solution, and adding on all unseen states otherwise.

My domain model looks like this:

type Item = Gen of string | Chip of string
type State = { floor: int; items: Map<Item, int>  }

And we need helpers to find what items are on a floor, if we’ve reached the solution, and if a given state is valid or not. Probably these functions would benefit from optimization to speed up the overall algorithm.

let isValid items =
    let hasGenerator t = Seq.contains (Gen t) items
    let noGenerators = Seq.forall (function | Chip _ -> true | _ -> false)
    let allMicrochipsMatch = Seq.forall (function | Chip m -> hasGenerator m | _ -> true) 
    noGenerators items || allMicrochipsMatch items

let isSolution state = state.items |> Map.forall (fun _ floor -> floor = 4)

let itemsOnFloor n state = state.items |> Map.toSeq |> Seq.filter (fun (item,floor) -> floor = n) |> Seq.map fst |> Seq.toArray

let stateIsValid (state:State) = Seq.forall (fun n -> isValid (itemsOnFloor n state))

The remaining piece of the algorithm is determining the next states. Here’s what I came up with after a few iterations:

let getNextStates st = seq {
    let onThisFloor = itemsOnFloor st.floor st
    let canGoInElevator = function | Gen g, Chip m -> g = m | Chip m, Gen g -> m = g | _ -> true

    let pairs = [for i in 0..onThisFloor.Length-1 do 
                 for j in i+1..onThisFloor.Length-1 do
                 let a,b =onThisFloor.[i],onThisFloor.[j]
                 if canGoInElevator (a,b) then yield [a;b]
                 ]
    let getStates newFloor moves = seq {
        for move in moves do 
            let newItems = move |> List.fold (fun (items:Map<Item,int>) move -> items.Add(move,newFloor)) st.items
            let newState = {  floor = newFloor; items = newItems  }
            if stateIsValid newState [st.floor;newFloor] then
                yield newState
    }

    // todo: restore can go in elevator? maybe irrelevant
    if st.floor < 4 then
        yield! getStates (st.floor+1) pairs
        yield! getStates (st.floor+1) (onThisFloor |> Seq.map (fun a -> [a]))
    if st.floor > 1 then
        yield! getStates (st.floor-1) (onThisFloor |> Seq.map (fun a -> [a]))
        yield! getStates (st.floor-1) pairs
}

It’s a bit ugly, but the basic idea is to find all pairs and individual items that can go up or down a floor, and yield all the possible states with those moves. This is the function that we need to aggressively optimise to prevent us from checking any more states than are absolutely necessary.

Now we can run it through our solver:

let startState = { floor = 1; items = [
                                        Gen "promethium", 1
                                        Chip "promethium", 1
                                        Gen "cobalt", 2
                                        Gen "curium", 2
                                        Gen "ruthenium", 2
                                        Gen "plutonium", 2
                                        Chip "cobalt", 3
                                        Chip "curium", 3
                                        Chip "ruthenium", 3
                                        Chip "plutonium", 3
                                    ] |> Map.ofList}

solve startState |> printfn "Part a: %d"

And it does the job in about 15 seconds. Part b was much slower, but my answer came out after 12 minutes (and you need to run fsianycpu to get a 64 bit process to solve this or it will run out of memory). I then tried to speed things up by removing what I thought were redundant states in the getNextStates method (e.g. if there are two or more pairs that could be moved up or down, it shouldn’t matter which one you do first, both would result in an equally short solution). However, I got different answers when I added these optimisations in, so I need to give it more thought.

So whilst I did end up solving day 11, the code is far from ideal. It would be nice to revisit this (yet again) in the future and see if I can get it running faster. But for now at least it’s very pleasing to have finally got the answers, and learned about breadth-first search in the process. It turned out to be very useful for day 13, which I’ll blog about soon.