#lang racket

;;; 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)))