/********************************************
   File: turing2.pl     System: SWI-Prolog  5.2.8
   Author: Mihaela Malita
   Date: 11/13/2003
   Title:  A Turing machine for recognizing a^nb^n
   Tape Alphabet={a,b,e,$} States={q0,q1,2,q3,q4,q5,q6,q7,q8} Final=q5 Start=q0 
   Interpretation for q4 (Error state)
    t((OldState,LetterRead),(NewState,Move)).
    Move is: <- (left) or -> (right). Move=e means it writes blank(e) that is: deletes.
    Head stays: if Move = Letter.
        Types of transitions are:
    t((s,a),(q,b)).   OldState=s, reads an a, jumps to state q and overwrites b
    t((s,a),(q,->)).  OldState=s, reads an a, jumps to state q and moves right
    t((s,a),(q,<-)).  OldState=s, reads an a, jumps to state q and moves left

    Input tape is [$, a, a, a, b, b, e]  Output tape is [$, e, e, e, e, e]
    Head is on $ 
    We assume there are no blanks in the data on the input tape 
    Example:   ?- start.
            Turing Machine for recognizing a^nb^n 
            String to compute: [a,a,b,b].
                                    q0-[]-[$, a, a, b, b, e]
            tm-q0- $ -q1- (->)      q1-[$]-[a, a, b, b, e]
            tm-q1-a-q2-e            q2-[$]-[e, a, b, b, e]
            tm-q2-e-q3- (->)        q3-[$, e]-[a, b, b, e]
            tm-q3-a-q3- (->)        q3-[$, e, a]-[b, b, e]
            tm-q3-b-q3- (->)        q3-[$, e, a, b]-[b, e]
            tm-q3-b-q3- (->)        q3-[$, e, a, b, b]-[e]
            tm-q3-e-q4- <-          q4-[$, e, a, b]-[b, e]
            tm-q4-b-q7-e            q7-[$, e, a, b]-[e, e]
            tm-q7-e-q8- <-          q8-[$, e, a]-[b, e, e]
            tm-q8-b-q0-b            q0-[$, e, a]-[b, e, e]
            tm-q0-b-q0- <-          q0-[$, e]-[a, b, e, e]
            tm-q0-a-q0- <-          q0-[$]-[e, a, b, e, e]
            tm-q0-e-q1- (->)        q1-[$, e]-[a, b, e, e]
            tm-q1-a-q2-e            q2-[$, e]-[e, b, e, e]
            tm-q2-e-q3- (->)        q3-[$, e, e]-[b, e, e]
            tm-q3-b-q3- (->)        q3-[$, e, e, b]-[e, e]
            tm-q3-e-q4- <-          q4-[$, e, e]-[b, e, e]
            tm-q4-b-q7-e            q7-[$, e, e]-[e, e, e]
            tm-q7-e-q8- <-          q8-[$, e]-[e, e, e, e]
            tm-q8-e-q5-e            q5-[$, e]-[e, e, e, e]
            YES
            Continue(y/n)?= y.
            Turing Machine for recognizing a^nb^n 
            String to compute: [a].
                                    q0-[]-[$, a, e]
            tm-q0- $ -q1- (->)      q1-[$]-[a, e]
            tm-q1-a-q2-e            q2-[$]-[e, e]
            tm-q2-e-q3- (->)        q3-[$, e]-[e]
            tm-q3-e-q4- <-          q4-[$]-[e, e]
            NO
            Continue(y/n)?= n.
***********************************************************************/
start(q0).
final(q5).

% find the left end of the input
tm((q0,a),(q0,<-)).     % go to leftside 
tm((q0,b),(q0,<-)).     % go to leftside 
tm((q0,$),(q1,->)).     % We assume at the beginning head is on $
tm((q0,e),(q1,->)).     % found e go right where the leftside is 

% if leftmost =a erase it, if b then fail
tm((q1,a),(q2,e)).        % erase a
tm((q2,e),(q3,->)).       % look for right end
tm((q1,b),(q6,b)).        % if b fail

% find the right end of the input
tm((q3,a),(q3,->)).      % read a or b go right
tm((q3,b),(q3,->)).     
tm((q3,e),(q4,<-)).      % first blank (means end), go back

% Erase the b at the left end of the input
tm((q4,b),(q7,e)).       % delete b 
tm((q7,e),(q8,<-)).      % look for leftside
tm((q8,e),(q5,e)).       % final YES
tm((q8,a),(q0,a)).
tm((q8,b),(q0,b)).    

start:- write('Turing Machine for recognizing a^nb^n \n'),
                    write('String to compute: '),read(W),
                    Left=[],append([$|W],[e],Right),start(S),  
                    tab(15),write(S-Left-Right),nl,
                    (compute(S,Left,Right)->write('YES');write('NO')),
                    (yesorno -> start).
        
    yesorno:- nl,write('Continue(y/n)?= '),read(R),R=y.

% configuration: State-WordLeft-WordRight, WordRight=[$,Read,...,e]
        compute(Q,_,_):- final(Q).   % halt when final state
                
% tm((q,A),(s,->)).       Move to next symbol on the tape and go to new state                      
        compute(State,Left,Right):- Right=[A|T],tm((State,A),(NewState,->)),
                                    append(Left,[A],NewLeft),NewRight=T,
                                    write(tm-State-A-NewState-(->)),tab(5),
                                    write(NewState-NewLeft-NewRight),nl,
                                    compute(NewState,NewLeft,NewRight).    
                                                    
% tm((q,A),(s,<-)).       Move to previous symbol on the tape and go to new state                      
        compute(State,Left,Right):- Right=[A|T],tm((State,A),(NewState,<-)),
                                    append(NewLeft,[X],Left),NewRight=[X,A|T],
                                    write(tm-State-A-NewState-(<-)),tab(5),
                                    write(NewState-NewLeft-NewRight),nl,
                                    compute(NewState,NewLeft,NewRight).    

% tm((s,a),(q,b)).       If a is read then overwrite b, go to Newstate                      
compute(State,Left,Right):- Right=[A|T],tm((State,A),(NewState,B)),
                            not(member(B, [->,<-])),
                            NewRight=[B|T],
                            write(tm-State-A-NewState-B),tab(5),
                            write(NewState-Left-NewRight),nl,
                            compute(NewState,Left,NewRight).