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