bridge-zombie-problem

solution.scm

#| Problem statement
 | =================
 |
 | You, a lab assistant in a remote mountain facility, accidentally release a
 | horde of zombies. You, the lab technician, professor and student intern need
 | to flee the laboratory across a rope bridge. The bridge carries a maximum of
 | two people, it's dark and you only managed to grab one lantern.
 | 
 | Each of you takes a different time to cross the bridge:
 |
 | | who         | travel time (min) |
 | | ----------- | ----------------- |
 | | assistant   | 1                 |
 | | intern      | 2                 |
 | | technician  | 5                 |
 | | professor   | 10                |
 |
 | The lantern always has to go with the people crossing the bridge. You have
 | to reach the other side in 17 minutes.
 |
 | It is entirely feasible to find a solution by sheer brain power, however
 | we undertake the endeavour to find the best solution computationally.
 |
 | Method
 | ------
 |
 | With all people and the lantern being on either side of the bridge, we
 | count 32 number of states. We'll define a function that checks if a
 | transition between two states is allowed and if so, compute the time
 | it will take. This gives us a weighted graph of all states and transitions.
 | To find the shortest path within that weighted graph, we will apply
 | Dijkstra's algorithm.
 |#

(import (rnrs (6))
        ; guile specific import (uncomment to run with guile)
        ; (only (ice-9 format) format)
        
        ; chezscheme specific import
        (only (chezscheme) format))

;;; Generic functions =========================================================

#| Only apply function f if all arguments are non-false
 |#
(define (maybe f)
  (lambda args
    (if (memp not args)
      #f
      (apply f args))))

#| List numbers between 0 and n
 |#
(define (range n)
  (let loop ((i n)
             (tgt '()))
    (if (zero? i)
      tgt
      (loop (- i 1) (cons (- i 1) tgt)))))

#| Repeat an action n times
 |#
(define (repeat f n)
  (unless (zero? n)
    (f)
    (repeat f (- n 1))))

#| Path record
 |#
(define-record-type path
  (fields distance route))

#| Dijkstra's algorithm
 | --------------------
 |
 |   arguments:
 |     N      - Number of nodes in the graph.
 |     weight - Function (weight i j) should return weight of directed edge
 |              from i to j. If edge does not exist, should return #f
 |     start  - Starting node.
 |     target - Stop iterating when target is reached, set to #f to find
 |              shortest route to all nodes.
 |
 |   returns:
 |     Vector containing shortest path from start node to every other node.
 |     The paths are stored in `path` records containing both the distance
 |     and the reversed list of nodes traveled.
 |#
(define (dijkstra N weight start target)
  ; find new paths
  (define (new-path paths current i)
    (let* ((new-distance ((maybe +)
                          (path-distance (vector-ref paths current))
                          (weight current i))))
      (cond
        ; no new path, keep the old one
        ((not new-distance)
         (vector-ref paths i))

        ; new path is shorted, take the new one
        ((< new-distance (path-distance (vector-ref paths i)))
         (make-path new-distance
                    (cons i (path-route (vector-ref paths current)))))

        ; new path is longer, keep the old one
        (else (vector-ref paths i)))))

  ; look for next node to search
  (define (find-next visited paths)
    (fold-left
      (lambda (acc i)
        (cond
          ; node already visited, skip
          ((vector-ref visited i) acc)

          ; no node was yet selected, take
          ((not acc) i)

          ; node is closer, take
          ((< (path-distance (vector-ref paths i))
              (path-distance (vector-ref paths acc)))
           i)
          
          ; node is further away, skip
          (else acc)))

      #f (range N)))

  (let loop ((visited  (make-vector N #f))
             (paths    (let ((x (make-vector N (make-path +inf.0 #f))))
                         (vector-set! x start (make-path start (list start)))
                         x))
             (current  start))

    ; generate new paths, update visited, find next, repeat
    (let* ((new-paths (list->vector
                        (map (lambda (i)
                               (new-path paths current i))
                             (range N))))
           (_         (vector-set! visited current #t))
           (next      (find-next visited new-paths)))

      (if (or (not next) (eq? next target))
        new-paths
        (loop visited new-paths next)))))

#| State description
 | -----------------
 |
 | The 32 possible states are encoded in a bit-pattern using integers from
 | 0 to 31. The highest bit encodes the state of the lantern, lower bits the
 | state of each person involved, sorted such that the lowest bit corresponds
 | to the fastest person.
 |#

(define (state-lantern s)
  (if (zero? (bitwise-and s 16))
    'zombie
    'safe))

(define state-mask 15)

(define crossing-times '#(0 1 2 5 10))

(define (state-safe-side s)
  (bitwise-and s
               state-mask))

(define (state-zombie-side s)
  (bitwise-and (bitwise-not s)
               state-mask))

#| Transition rules
 | ----------------
 |
 | Depending on the initial state of the lantern, we assume a crossing
 | has taken place from that side of the bridge to the other. If the
 | crossing was from the safe side to the zombie side, we swap the
 | ingoing and outgoing states before we do comparison.
 |
 | We use the bit-pattern of the four least significant bits in the state
 | integer to identify who has crossed the bridge. People that crossed the
 | bridge will be on the safe side in one instance and on the zombie side
 | in the other. By taking the bitwise-and of these states we find all persons
 | that crossed the bridge.
 |
 | R6RS Scheme contains routines to count the number of bits set
 | (`bitwise-bit-count`), as well as finding the position of the most
 | significant bit (`bitwise-lenght`). Because we sorted the bit-pattern on
 | the travel time of each person, we find the travel time of the maximum
 | of two people crossing the bridge easily.
 |#
(define (weight s1 s2)
  (define (may-swap)
    (if (eq? (state-lantern s1) 'zombie)
      ; moving from zombie to safe side
      (values s1 s2)
      ; moving from safe to zombie side
      (values s2 s1)))

  (define (calc-weight sz ss)
    (let ((not-allowed (bitwise-and (state-safe-side sz)
                                    (state-zombie-side ss)))
          (allowed     (bitwise-and (state-safe-side ss)
                                    (state-zombie-side sz))))
      (cond
        ((not (zero? not-allowed))         #f)
        ((> (bitwise-bit-count allowed) 2) #f)
        ((< (bitwise-bit-count allowed) 1) #f)
        (else (vector-ref crossing-times
                          (bitwise-length allowed))))))

  (if (eq? (state-lantern s1) (state-lantern s2))
    #f
    (call-with-values may-swap calc-weight)))

#| Run the algorithm ======================================================= |#
(let ((f (open-input-file "solution.scm")))
  (repeat
    (lambda ()
      (let ((line (get-line f)))
        (format #t "~a~%"
                (substring line (min (string-length line) 3)
                           (string-length line)))))
    32)
  (close-port f)
  (format #t "~%Answer~%------~%~%"))

(let ((paths (dijkstra 32 weight 0 31)))
  (format #t "| time   | people | lantern |~%")
  (format #t "| ------:| ------:| ------- |~%")
  (for-each
    (lambda (i)
      (let ((bit-pattern (number->string (state-safe-side i) 2)))
        (format #t "| ~2@a min |   ~4,,,'0@a | ~7s |~%"
          (path-distance (vector-ref paths i))
          bit-pattern
          (state-lantern i))))
    (reverse (path-route (vector-ref paths 31)))))