;; Carlos Caleiro em 28/Fev/2003

;; autómato finito determinista D=(Q,I,delta,q0,F) representado por
;; Q     - lista de estados
;; I     - lista de símbolos do alfabeto
;; delta - lista de triplos (qx,a,qy) - delta(qx,a)=qy
;; q0    - estado inicial, por defeito o primeiro elemento da lista Q
;; F     - lista de estados finais

;; algumas funções auxiliares

(define (estados aut) (car aut))

(define (alfabeto aut) (cadr aut))

(define (trans aut) (caddr aut))

(define (delta aut q a) (pesq (trans aut) q a))
(define indef -1)
(define (de t) (car t))
(define (por t) (cadr t))
(define (para t) (caddr t))
(define (pesq trans q a) (cond 
                           ((null? trans) indef)
                           ((and (eq? (de (car trans)) q) (eq? (por (car trans)) a)) (para (car trans))) 
                           (else (pesq (cdr trans) q a))))

(define (inicial aut) (car (estados aut)))

(define (finais aut) (cadddr aut))

;; exemplo

(define aut1 '((q0 q1 q2) (a b) ((q0 a q1) (q1 a q1) (q1 b q2) (q2 a q1) (q2 b q2)) (q2)))
(display "aut1 - autómato que aceita as sequências do alfabeto {a,b} que começam por a e terminam em b") aut1

;; função de transição delta* representando cada sequência do alfabeto como a lista dos símbolos 

(define (delta* aut q w) (if (null? w) q (delta aut (delta* aut q (tira.ult w)) (ult w))))

(define (ult w) (if (null? (cdr w)) (car w) (ult (cdr w))))
(define (tira.ult w) (if (null? (cdr w)) null (cons (car w) (tira.ult (cdr w)))))

;; aceitação de sequências

(define (aceita aut w) (if (member (delta* aut (inicial aut) w) (finais aut)) #t #f))

;; exemplos

(display "aut1 aceita aabaab") (aceita aut1 '(a a b a a b))
(display "aut1 não aceita abba") (aceita aut1 '(a b b a))

;; função que torna total a função de transição directa de um autómato aut
;; acrescentando-le se necessário o novo estado qnovo

(define (total qnovo aut) (cond
                            ((member qnovo (estados aut)) (display "erro - estado existente"))
                            ((= (length (trans aut)) (* (length (estados aut)) (length (alfabeto aut)))) aut)
                            (else (list (append (estados aut) (list qnovo)) (alfabeto aut) 
                                        (tot (trans aut) qnovo (append (estados aut) (list qnovo)) (alfabeto aut)) (finais aut)))))

(define (tot trans qnovo est alf) (tot.aux trans qnovo alf est alf))
(define (tot.aux trans qnovo alf est c.alf) (cond ((null? est) trans)
                                            ((null? c.alf) (tot trans qnovo (cdr est) alf))
                                            ((eq? indef (pesq trans (car est) (car c.alf))) 
                                                   (tot.aux (append trans (list (list (car est) (car c.alf) qnovo))) qnovo alf est (cdr c.alf)))
                                            (else (tot.aux trans qnovo alf est (cdr c.alf)))))

;; exemplo

(display "autómato obtido totalizando aut1 com q3") (total 'q3 aut1)

;; complementação de linguagens regulares

(define (complem qnovo aut) (let ((tot (total qnovo aut))) (list (estados tot) (alfabeto tot) (trans tot) (excepto (estados tot) (finais tot)))))

(define (excepto u v) (cond
                        ((null? u) null)
                        ((member (car u) v) (excepto (cdr u) v))
                        (else (cons (car u) (excepto (cdr u) v)))))

;; exemplo

(display "autómato obtido por complementação de aut1 com q3 - aceita as sequências de {a,b} que não começam por a, ou não terminam em b, ou ambas") 
(complem 'q3 aut1)