On this page:
Supplemental Materials

Module 09

Last updated: Mon, 9 Mar 2015 16:19:54 -0400

Supplemental Materials
  1. Read the Readings and Supplemental Materials.


We will practice writing generative recursive functions using the famous Towers of Hanoi puzzle. Make sure to specify a termination argument if you use generative recursion.
The puzzle:
  • consists of three pegs,

  • has an initial stack of discs on one peg,

  • where the discs are sorted such that the widest peg is at the bottom and the smallest at the top.

The goal is to move the stack of discs to another peg, one top disc at a time, without ever breaking the sorted invariant. The third peg may be used as a helper peg.
To ensure that you are able to complete the puzzle, we give you the eureka! part of the puzzle. The key is to view the pegs in terms of their logical roles (source, target, helper) rather than their physical position (left, middle, right).
Concretely, use the following data definitions to implement the solve-hanoi function, which returns a list of Moves that if applied, moves all the discs from the given "source" peg to the "target" peg.
; An PegLabeling is a (make-pegs Peg Peg Peg)
; Represents a labeling of the physical Hanoi pegs (left, middle, right)
; as logical "source", "target", or "helper" pegs.
(define-struct pegs (src tgt help))
; A Peg is one of:
; - LEFT
; Represents a physical Hanoi peg.
; A Move is a (make-move Peg Peg)
(define-struct move (from to))
; Represents the movement of a the top Disc from the first peg to the second.
; solve-hanoi : PegLabeling Natural -> ListOf<Move>
; Computes the moves required to relocate n stacked Hanoi discs,
; from (pegs-src ps) to (pegs-tgt ps)
; Strategy: ???
(define (solve-hanoi pegs n) ...)
Implement solve-hanoi using the following algorithm. To move n discs from a "source" to "target":
  • first move the top n-1 discs from the "source" to the "helper" peg,

  • then move the bottom disc from the "source" to the target" peg,

  • and finally move the original n-1 discs from the "helper" to the "target".

To check if you’ve properly implemented a solution to the puzzle, here is a big-bang program that visualizes the puzzle.
; Data Definitions -
(define LEFT 'left)
(define MIDDLE 'middle)
(define RIGHT 'right)
; <peg pred> : Peg -> Boolean
(define (l? p) (symbol=? p LEFT))
(define (m? p) (symbol=? p MIDDLE))
(define (r? p) (symbol=? p RIGHT))
(define INIT-PEGS (make-pegs LEFT MIDDLE RIGHT))
; A World is a (make-world Towers ListOf<Move> ListOf<Move>)
(define-struct world (towers moves-left moves-done))
; A Towers is one of: (list Tower Tower Tower)
; Represents a state of the Hanoi game.
; WHERE: there is one each of left, middle, right towers
(define mk-towers list)
(define get-tower assq)
(define EMPTY-TOWERS '((left ()) (middle ()) (right ())))
; mk-init-towers : PegLabeling Natural -> Towers
; Makes an initial Hanoi state from a peg labeling ps and n discs
(define (mk-init-towers ps n)
  (replace-tower EMPTY-TOWERS (mk-tower (pegs-src ps) (build-list n add1))))
; replace-tower : Towers Tower -> Towers
; Replaces the discs of Peg p in ts with ds.
(define (replace-tower ts t)
  (local ((define old-tower (get-tower (tower-peg t) ts)))
    (cons t (remove old-tower ts))))
; A Tower is a (list Peg Discs)
; Represents one physical tower in a Hanoi game.
(define mk-tower list)
(define tower-peg first)
(define tower-discs second)
; A Discs is a Listof<Disc>
; WHERE: the Discs are sorted on ascending order.
; A Disc is a PosInt
; The ratio of two Discs is the ratio of their widths.
; get-discs : Towers -> Discs
(define (get-discs ts)
  (map second ts))
; tower-top-disc : Tower -> Disc
; Returns the top Disc in t
(define (tower-top-disc t)
  (first (second t)))
; tower-rest-discs : Tower -> Discs
; Returns all Discs in t except the top.
(define (tower-remove-disc t)
  (mk-tower (first t) (rest (second t))))
; tower-add-disc : Disc Tower -> Tower
; Adds disc d to the top of t.
(define (tower-add-disc d t)
  (mk-tower (first t) (cons d (second t))))
; run
; run : Natural -> World
; n = number of discs in the puzzle
(define (run n)
    (mk-init-towers INIT-PEGS n)
    (solve-hanoi INIT-PEGS n)
   (on-key key-handler)
   (on-draw render)))
; render
(define DISC-HEIGHT 10) ; pixels
(define DISC-WIDTH-RATIO 10)
; max-disc : Towers -> Disc
; Returns the highest numbered Disc in ts.
(define (max-disc ts)
  (apply max (map (λ (t) (apply max 0 t)) (get-discs ts))))
; render : World -> Image
(define (render w)
    ((define towers (world-towers w))
     (define max-d (max-disc towers))
     (define width (* (add1 (length towers)) (add1 max-d) DISC-WIDTH-RATIO))
     (define height width))
     (world-moves-left w)
      (empty-scene width height)))))
; render-moves-left : ListOf<Move> Image -> Image
; Renders the number of moves left onto the given image.
(define (render-moves-left mvs img)
   "left" "top"
    (string-append "MOVES REMAINING: " (number->string (length mvs))) 18 'black)
; render-towers : Towers Image -> Image
; Renders the given towers onto the given image.
(define (render-towers ts img)
  (local ((define max-d (max-disc ts)))
     (beside (tower->img (get-tower 'left ts) max-d)
             (tower->img (get-tower 'middle ts) max-d)
             (tower->img (get-tower 'right ts) max-d))
; tower->img : Tower Disc -> Image
; Converts t into an image with dimensions determined by max-disc.
(define (tower->img t max-disc)
  (local ((define width (* DISC-WIDTH-RATIO (add1 max-disc)))
          (define height (* DISC-HEIGHT (add1 max-disc))))
     "center" "bottom"
     (apply above empty-image empty-image (map render-disc (tower-discs t)))
     (empty-scene width height))))
; disc->img : Disc -> Image
; Converts d into a rectangle image.
(define (render-disc d)
  (rectangle (* d DISC-WIDTH-RATIO) DISC-HEIGHT 'solid (disc-color d)))
; shuffle : ListOf<X> -> ListOf<X>
; Returns a random permutation of lst.
(define (shuffle lst)
  (sort lst (λ (x y) (zero? (random 2)))))
  (shuffle '("red" "blue" "yellow" "green" "orange" "purple")))
; disc-color : Disc -> Color
; Returns a color for d.
(define (disc-color d)
  (list-ref DISC-COLORS (modulo (sub1 d) (length DISC-COLORS))))
; key-handler
; key-handler : World KeyEvent -> World
; "right" applies a Move in the forward direction.
; "left" applies a Move in the reverse direction.
(define (key-handler w kev)
    [(key=? kev "right") (world-forward w)]
    [(key=? kev "left") (world-backward w)]
    [else w]))
; world-forward : World -> World
; Applies one move from the moves remaining in w.
(define (world-forward w)
  (if (empty? (world-moves-left w))
      (make-world (apply-move (world-towers w) (first (world-moves-left w)))
                  (rest (world-moves-left w))
                  (cons (first (world-moves-left w)) (world-moves-done w)))))
; world-backward : World -> World
; Reverses the most recently applied move in w.
(define (world-backward w)
  (if (empty? (world-moves-done w))
      (make-world (apply-move (world-towers w) (rev-move (first (world-moves-done w))))
                  (cons (first (world-moves-done w)) (world-moves-left w))
                  (rest (world-moves-done w)))))
; apply-move : Towers Move -> Towers
; Applies move mv to Tower ts and returns the resulting Towers
(define (apply-move ts mv)
    ((define from-tower (get-tower (move-from mv) ts))
     (define to-tower (get-tower (move-to mv) ts))
     (define next-from-tower (tower-remove-disc from-tower))
     (define next-to-tower (tower-add-disc (tower-top-disc from-tower) to-tower)))
    (replace-tower (replace-tower ts next-from-tower) next-to-tower)))
; rev-move : Move -> Move
; Reverses Move m.
(define (rev-move m)
  (make-move (move-to m) (move-from m)))


Problem Set 09