[racket] htdp/2e: exercise 197, a solution, feedback welcome

I had a lot of difficulties with exercise 195, 196, 197. I'm posting my
solution to exercise 197 to get a chance to get feedback. How would have
you represented the FSM from exercise 100?

;Exercise 197. Consider the following data representation for finite state
machines:
(define-struct fsm (initial transitions final))
(define-struct transition (current key next))

; An FSM.v2 is a structure:
;   (make-fsm FSM-State LOT FSM-State)
; A LOT is one of:
; – empty
; – (cons Transition.v3 LOT)
; A Transition.v3 is a structure:
;   (make-transition FSM-State KeyEvent FSM-State)

;Represent the FSM from exercise 100 in this context.
;Design the function fsm-simulate, which accepts an FSM.v2 and runs it on a
player’s key strokes. If the sequence of key strokes force the FSM.v2 to
reach a final state, fsm-simulate stops. Hint The function uses the initial
field of the given fsm structure to keep track of the current state.

;(*) Solution

(define-struct fsm (initial transitions final))
(define-struct transition (current key next))

; An FSM.v2 is a structure:
;   (make-fsm FSM-State LOT FSM-State)
; A LOT is one of:
; – empty
; – (cons Transition.v3 LOT)
; A Transition.v3 is a structure:
;   (make-transition FSM-State KeyEvent FSM-State)

; a(b|c)*d

(define AA "start, expect to see an 'a' next")
(define BC "expect to see: 'b', 'c', or 'd'")
(define DD "encountered a 'd', finished")
(define ER "error, user pressed illegal key")

(define fsm-exe100
  (make-fsm AA
            (list (make-transition AA "a" BC)
                  (make-transition BC "b" BC)
                  (make-transition BC "c" BC)
                  (make-transition BC "d" DD)
                  (make-transition AA "d" DD))
            DD))

; code begins

(define CANVAS (empty-scene 300 20))

(define (show-state a-fsm)
  (place-image (text (fsm-initial a-fsm) 14 "black")
               100 10 CANVAS))

; FSM -> SimulationState.v2
; match the keys pressed by a player with the given FSM
(define (fsm-simulate a-fsm)
   (big-bang a-fsm
             (to-draw show-state)
             (on-key find-next-state)
             (stop-when last-state?)))

; SimulationState.v2 -> Boolean
(define (last-state? world-fsm)
  (string=? (fsm-initial world-fsm) (fsm-final world-fsm)))

(check-expect (not (last-state? fsm-exe100)) true)

; Transition.v3 Transition.v3 -> Boolean
(define (transition=? t1 t2)
  (and
   (string=? (transition-current t1) (transition-current t2))
   (string=? (transition-key t1) (transition-key t2))
   (string=? (transition-next t1) (transition-next t2))))

; FSM.v2 KeyEvent -> FSM.v2
; produces the machine with the next state associated with ke
(define (find-next-state a-fsm ke)
  (make-fsm (find (fsm-transitions a-fsm) (fsm-initial a-fsm) ke)
            (fsm-transitions a-fsm)
            (fsm-final a-fsm)))

; [List-of transition] FSM-State KeyEvent -> FSM-State
; finds the next FSM-State in the transition where 'current' is located
(define (find ls current ke)
  (cond
    [(empty? ls) (error (string-append "not found: " ke " " current))]
    [else (cond
            [(and (string=? current (transition-current (first ls)))
                  (key=? ke (transition-key (first ls))))
             (transition-next (first ls))]
            [else
             (find (rest ls) current ke)])]))

(check-error (find (fsm-transitions fsm-exe100) AA "b"))
(check-expect (find (fsm-transitions fsm-exe100) AA "a") BC)
(check-expect (find (fsm-transitions fsm-exe100) BC "b") BC)
(check-expect (find (fsm-transitions fsm-exe100) BC "c") BC)
(check-expect (find (fsm-transitions fsm-exe100) BC "d") DD)

(check-error (find-next-state fsm-exe100 "b"))
(check-expect (find-next-state fsm-exe100 "a") (make-fsm BC
(fsm-transitions fsm-exe100) DD))

(check-expect (find-next-state
               (find-next-state fsm-exe100 "a") "b")
              (make-fsm BC (fsm-transitions fsm-exe100) DD))

(check-expect (find-next-state
               (find-next-state
                (find-next-state fsm-exe100 "a") "b") "c")
              (make-fsm BC (fsm-transitions fsm-exe100) DD))

(check-expect (find-next-state
               (find-next-state
                (find-next-state
                 (find-next-state fsm-exe100 "a") "b") "c") "d")
              (make-fsm DD (fsm-transitions fsm-exe100) DD))

(check-expect (find-next-state
                 (find-next-state fsm-exe100 "a") "d")
              (make-fsm DD (fsm-transitions fsm-exe100) DD))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20150121/39a0b8ef/attachment.html>