HtDP exercise 476

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

; An FSM is a structure:
;   (make-fsm FSM-State [List-of 1Transition] FSM-State)
; A 1Transition is a structure:
;   (make-transition FSM-State 1String FSM-State)
; An FSM-State is String.

; data example: see exercise 109

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

; FSM String -> Boolean
; does an-fsm recognize the given string
; generative: if the first letter in a-string is a valid input for the initial state, creates a new
; FSM with the resulting state and checks that the next letter is a valid input for that, until it
; reaches the case where the remaining letter has to make the transition to the final state
(check-expect
 (fsm-match? fsm-a-bc*-d "ad") #true)
(check-expect
 (fsm-match? fsm-a-bc*-d "abcd") #true)
(check-expect
 (fsm-match? fsm-a-bc*-d "acbd") #true)
(check-expect
 (fsm-match? fsm-a-bc*-d "abcbcbcbcbcd") #true)
(check-expect
 (fsm-match? fsm-a-bc*-d "aa") #false)
(check-expect
 (fsm-match? fsm-a-bc*-d "d") #false)
(check-expect
 (fsm-match? fsm-a-bc*-d "da") #false)

(define (fsm-match? an-fsm a-string)
  (local ((define transitions (fsm-transitions an-fsm))
          (define current-state (fsm-initial an-fsm))
          (define current-key (substring a-string 0 1))
          ; [List-of 1Transition] -> [Maybe FSM-State]
          ; returns the FSM-State that results from pressing the current key in the current state
          ; if a transition is defined for it, #false otherwise
          (define (check-key tr)
            (cond
              [(empty? tr) #false]
              [else
               (local ((define fst (first tr)))
                 (if (and (string=? current-state (transition-current fst))
                          (string=? current-key (transition-key fst)))
                     (transition-next fst)
                     (check-key (rest tr))))]))
          (define maybe-next (check-key transitions)))
    (cond
      [(= 1 (string-length a-string))
       (equal? (fsm-final an-fsm) maybe-next)]
      [else
       (if (string? maybe-next)
           (fsm-match?
            (make-fsm maybe-next
                      transitions
                      (fsm-final an-fsm))
            (substring a-string 1 (string-length a-string)))
           #false)])))