turingAutomaton/tmUtils.rkt
2020-03-31 09:35:50 +13:00

122 lines
2.8 KiB
Racket

#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))