Posted in:

Today’s Advent of Code challenge combined two distinct problems – maze solving, which we’ve already tackled before this year, and the “travelling salesman” problem (which we did actually see last year).

I decided to create a two phase solution. Phase 1 was to generate a map of the shortest distances between all the points of interest in the maze. And Phase 2 was then to solve the travelling salesman problem by searching for the shortest possible routes through those points of interest.

For phase 1, I was once again able to reuse an algorithm I’d created before – the breadth first search. One slight modification I needed to make was for it to keep searching after it had found a solution. This is because I needed to find the shortest route to all points of interest, and sometimes the shortest route from a to b goes through c, so we need to keep going until we’ve discovered all points of interest.

Here’s my generic breadth first searcher:

let bfs (isSolution:'a->bool) (getChildren:'a->seq<'a>) (start:'a) =
    let q = new Queue<'a>()
    q.Enqueue(start)
    let rec search() = seq {
        if q.Count > 0 then
            let s = q.Dequeue()
            if isSolution s then 
                yield s
            for c in getChildren s do
                q.Enqueue(c)
            yield! search()
    }
    search()

And this meant I could create a shortestFrom function which, given a starting point of interest (start), uses the breadth first search to find the distance to all other points of interest. It uses a dictionary to track which points in the maze have already been visited.

Another technique I tried was that the maze parameter to this function is a function that looks up a location in the maze rather than being the array of strings directly. This makes my function less dependent on the choice of data structure I used to represent the maze.

let shortestFrom maze start =
    let startc = maze start
    let dist = Dictionary<int*int,int>()
    let getChildren ((x,y),d) = 
        [(-1,0);(0,-1);(1,0);(0,1)]
        |> Seq.map (fun (i,j) -> (x+i,y+j) )
        |> Seq.filter (dist.ContainsKey >> not)
        |> Seq.filter (fun p -> maze p <> '#')
        |> Seq.map (fun p -> dist.[p] <- d+1; (p,d+1))
    let isSolution (pos,d) =
        let c = maze pos
        c >= '0' && c < '9' && c <> startc
    bfs isSolution getChildren (start,0) |> Seq.map (fun (p,d) -> maze p,d)

Now with the help of a couple more helper functions (mazeLookup and mazeFind) I created a buildShortestPathLookup which creates a map of distances between every pair of points. There was some optimization potential here because the distance from A to B is calculated twice (we also calculate B to A), but the size of the input data meant this was not a big performance concern.

let mazeLookup (maze:string[]) (x,y) = maze.[y].[x]
let mazeFind (maze:string[]) c = 
    [for y in 0..maze.Length-1 do 
        for x in 0 ..maze.[y].Length-1 do 
            if maze.[y].[x] = c then yield (x,y)]
            |> List.tryFind (fun _ -> true)

let buildShortestPathLookup maze =
    ['0'..'9'] 
    |> Seq.choose (mazeFind maze)
    |> Seq.collect (fun c -> 
                shortestFrom (mazeLookup maze) c
                |> Seq.map (fun (t,d)-> ((mazeLookup maze c,t),d)))
    |> Map.ofSeq

With that map in place, finding the shortest path was as simple as trying all the possible visiting orders. Since there were eight cities in my map, the number of routes is 7!, which is just 5040. So it can be easily brute forced. For more cities, we should do a depth first search and abandon any route that is longer than the current best one we’ve found.

My findShortestPath function uses a recursive internal search function which works through a list of cities still to visit. And since part b of the problem also asks us to return to our original location, we need the search function to return not only the distance but the ending point, so we can append the distance back to home onto each visiting order.

let findShortestPath maze ret =
    let lookup = buildShortestPathLookup maze
    let rec search (toVisit:char list) current (dist:int) = seq {
        match toVisit with
        | [] ->  yield dist, current
        | _ ->
            for v in toVisit do
                let d = lookup.[(current,v)]
                yield! search (toVisit |> List.filter ((<>) v)) v (dist+d)
    }
    let toVisit = ['1'..'9'] |> List.choose (mazeFind maze) |> List.map (mazeLookup maze)
    let paths = search toVisit '0' 0
    if ret then
        paths |> Seq.map (fun (d,c) -> d + lookup.[c,'0'])
    else
        paths |> Seq.map fst

Now we have all the pieces in place to solve both parts of the problem, as well as check our work by solving the test input, which I’ve done each day so far this year and has helped a lot with the correctness of my solutions:

let maze = System.IO.File.ReadAllLines (__SOURCE_DIRECTORY__ + "\\input.txt")
let testMaze = System.IO.File.ReadAllLines (__SOURCE_DIRECTORY__ + "\\testinput.txt")

findShortestPath testMaze false |> Seq.min |> printfn "Test: %d"
findShortestPath maze false |> Seq.min |> printfn "Part a: %d"
findShortestPath maze true |> Seq.min |> printfn "Part b: %d"

Hopefully tomorrow’s puzzle won’t be too taxing, as I don’t think I’ll be allowed to get away with a few hours of programming on Christmas Day! Full code for today’s answer is up on GitHub.