This post came from a short-lived blog I tried to run (tail-recursion.net) where I wanted to write up a short bit of code I'd written that week.

minimise-path takes a network path, which consists of a sequence of nodes, and produces the shortest path, cutting out any loops. It is assumed that the sequence of nodes coming into this function is already a valid path. The context in which this code appears checks this property before calling this function.

    (define (minimise-path nodes)

An equivalent path should start and end with the same nodes if it's a valid solution to the problem. Node labels are assumed to be unique in a network, as they serve as the means of identification for individual users. The path should also be a valid path; that is, each node should be connected to the next in sequence.

      (define (equivalent-path? path)
        (and (path? path)
             (equal? (node-label (first nodes))
                     (node-label (first path)))
             (equal? (node-label (last nodes))
                     (node-label (last path)))))

shorten-path does the work in this function.

      (define (shorten-path nodes path)

If there aren't any nodes left to search through, return what we have. Any returned path will be quality checked.

        (if (empty? nodes)
            path

If there is only a single node, we've reached the end of the path, and should return the path that we've built. The path, which started with the first node in the path and where each next node is consed onto the front of this list, should be reversed after adding this remaining node to the path.

            (if (empty? (rest nodes))
                (reverse (cons (first nodes) path))

Neighbours filters the list for all nodes connected to the first node in the list.

                (let* ([neighbours (filter (λ (o)
                                             (neighbours? (first nodes) o))
                                           (rest nodes))]

The farthest node is the last node that is a neighbour of this one. Normally, there will be only one node in the list. However, if there are loops, this will skip them by just going to the farthest node in the path that is still a neighbour of this one.

                       [farthest (last neighbours)])

Recursively continue along; memf will return the tail of the original nodes path, including the matching node, starting at the node whose label matches the farthest node's.

                  (shorten-path (memf (λ (o)
                                        (equal? (node-label o)
                                                (node-label farthest)))
                                      (rest nodes))
                                (cons (first nodes) path))))))

With the two helper functions defined, we attempt to build a shortened path. If the path is an equivalent path, return it. Otherwise, we failed and should just return the original list of nodes passed in.

      (let ([path (shorten-path nodes '())])
        (if (equivalent-path? path)
            path
            nodes)))

This accompanies some general graph code that I wrote while reading Networks, Crowds, and Markets. It is meant to accompany the BFS search I wrote for the library, and was tested on the 13-node ARPA network listed in the book:

    (define ARPA-NET
      (list
       (node 'sri  '(utah stan ucla ucsb))
       (node 'ucsb '(sri  ucla))
       (node 'ucla '(ucsb stan  sri rand))
       (node 'stan '(sri  ucla))
       (node 'utah '(sri  sdc  mit))
       (node 'sdc  '(utah rand))
       (node 'rand '(ucla bbn))
       (node 'mit  '(utah bbn  linc))
       (node 'bbn  '(rand mit  harv))
       (node 'harv '(bbn  carn))
       (node 'carn '(harv case))
       (node 'case '(carn linc))
       (node 'linc '(case mit))))

However, running the BFS search through this network looking for a path between SRI and Harvard showed a loop:

    > (bfs ARPA-NET 'sri 'harv)
    (list
     (node 'sri (set 'utah 'stan 'ucla 'ucsb))
     (node 'ucsb (set 'ucla 'sri))
     (node 'ucla (set 'rand 'stan 'ucsb 'sri))
     (node 'rand (set 'ucla 'bbn))
     (node 'bbn (set 'rand 'mit 'harv))
     (node 'harv (set 'bbn 'carn)))

Observing this path shows that the path needlessly travels through UCSB; it could go straight from SRI to UCLA. With the use of minimise-path, this extra hop is skipped:

    > (minimise-path (bfs ARPA-NET 'sri 'harv))
    (list
     (node 'sri (set 'utah 'stan 'ucla 'ucsb))
     (node 'ucla (set 'rand 'stan 'ucsb 'sri))
     (node 'rand (set 'ucla 'bbn))
     (node 'bbn (set 'rand 'mit 'harv))
     (node 'harv (set 'bbn 'carn)))

I also ran some tests on a simple directed graph, with a structure of

Consider this simple network:

       node-1 o---o node-5
             / \
     node-2 o---o node-3
                |
                o node-4

in which node-2 and node-3 are linked to node-1 and to each other, node-4 is linked to node-3, and node-5 is linked to node-1.

    (define test-network
      (list
       (node 'node-1 '())
       (node 'node-2 '(node-1 node-3))
       (node 'node-3 '(node-1 node-2))
       (node 'node-4 '(node-3))
       (node 'node-5 '(node-1))))

A BFS from node-4 to node-1 also took some unnecessary stops:

    (bfs test-network 'node-4 'node-1)
    (list
     (node 'node-4 (set 'node-3))
     (node 'node-3 (set 'node-1 'node-2))
     (node 'node-2 (set 'node-1 'node-3))
     (node 'node-1 (set)))

However, minimise-path is able to cut out the extra step again:

    > (minimise-path (bfs test-network 'node-4 'node-1))
    (list
     (node 'node-4 (set 'node-3))
     (node 'node-3 (set 'node-1 'node-2))
     (node 'node-1 (set)))

The code came about when I set out to figure out to cut out the extra step. It was a fun challenge, and it really got me thinking about how to think about these kinds of problems.

The untransformed code is available.