turingAutomaton/tmUtils.rkt

#lang racket

; utils - wont change

(define def-symbol '())
(define start-state '())
(define input '())

(define (set-def! x)
   (set! def-symbol x))

(define (set-start! x)
   (set! start-state x))

(define (set-input! x)
   (set! start-state x))

(define (pre t)
   (car t))

(define (cur t)
   (cadr t))

(define (aft t)
   (caddr t))

(define (shiftr t)
  (let* [(c (cur t))
         (p (pre t))
         (a (aft t))
         (a (if (null? a)
                (list def-symbol)
                a))]
  `(,(append p (list c))
    ,(car a)
    ,(cdr a))))

(define (shiftl t)
  (let* [(c (cur t))
         (p (pre t))
         (a (aft t))
         (p (if (null? p)
                (list def-symbol)
                p))]
  `(,(reverse (cdr (reverse p)))
    ,(car (reverse p))
    ,(cons c a))))

(define (write-sym s t)
   (let [(p (pre t))
         (a (aft t))]
   `(,p ,s ,a)))

(define (list->tape l)
   `(() ,(car l) ,(cdr l)))

(define trans-map (make-hash))

(define (transition current-state tape)
   (let [(f (hash-ref trans-map `(,current-state ,(cur tape)) #f))]
      (if (eq? f #f)
          `(,current-state ,tape)
          (let* [(new-sym   (first f))
                 (dir       (second f))
                 (new-state (third f))
                 (dir-op    (if (eq? 'L dir)
                                shiftl
                                shiftr))
                 (new-tape  (dir-op (write-sym new-sym tape)))]
             (transition new-state new-tape)))))

(define (tape->list t)
   (let [(flat-tape (append (pre t) (list (cur t)) (aft t)))
         (f (lambda (x) (eq? x def-symbol)))]
      (reverse (drop-while f (reverse (drop-while f flat-tape))))))

(define (drop-while f l)
   (if (null? l)
       l
       (if (f (car l))
           (drop-while f (cdr l))
           l)))

(define (display-result input)
   (let* [(res (transition start-state (list->tape input)))
          (fin-state (car res))
          (fin-tape  (tape->list (cadr res)))]
     (void
         (printf "Initial State: ~a~nInitial Tape:~n~a~nFinal State: ~a~nFinal Tape:~n~a~n" start-state input fin-state fin-tape))))

(provide trans-map)
(provide display-result)
(provide set-def!)
(provide set-start!)

;; per machine - will change
;
;(define def-symbol 'e)
;(define start-state '1)
;
;(hash-set! trans-map '(1 a) '(b R 2))
;(hash-set! trans-map '(1 c) '(c R 4))
;
;(hash-set! trans-map '(2 a) '(a R 2))
;(hash-set! trans-map '(2 c) '(c R 2))
;(hash-set! trans-map '(2 e) '(c L 3))
;
;(hash-set! trans-map '(3 a) '(a L 3))
;(hash-set! trans-map '(3 c) '(c L 3))
;(hash-set! trans-map '(3 b) '(b R 1))
;
;(hash-set! trans-map '(4 c) '(c R 4))
;(hash-set! trans-map '(4 e) '(e L 5))
;
;(hash-set! trans-map '(5 c) '(a L 5))
;(hash-set! trans-map '(5 b) '(a L 5))
;(hash-set! trans-map '(5 e) '(e R F))
;
;; fin
;
;(display-result '(a a a a a))