/* File: turing9.pl
   Author: Mihaela Malita
   Title: Turing Machine for COPY (DUPLICATE). Input= e w e;  Output= e w e w e
   Method: 
   read first leftmost and delete it
   copy it on second blank right
   go back left to second blank (skip in between blank) and write the symbol you deleted
   go right next symbol 
   if it is blank then HALT (it is the in between blank)
   if not go to beginning
   Tape Alphabet={a,e,$} States={q0-q8} Final=q8 Start=q0  e= blank 
   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
            ?- start.
            Turing Machine for COPY (DUPLICATE) a string
            String to duplicate: [a,a].
                                q0-[e]-[a, a, e, e, e, e]
            tm-q0-a-q1-e        q1-[e]-[e, a, e, e, e, e]
            tm-q1-e-q2- (->)    q2-[e, e]-[a, e, e, e, e]
            tm-q2-a-q2- (->)    q2-[e, e, a]-[e, e, e, e]
            tm-q2-e-q3- (->)    q3-[e, e, a, e]-[e, e, e]
            tm-q3-e-q4-a        q4-[e, e, a, e]-[a, e, e]
            tm-q4-a-q4- <-      q4-[e, e, a]-[e, a, e, e]
            tm-q4-e-q5- <-      q5-[e, e]-[a, e, a, e, e]
            tm-q5-a-q5- <-      q5-[e]-[e, a, e, a, e, e]
            tm-q5-e-q6-a        q6-[e]-[a, a, e, a, e, e]
            tm-q6-a-q7- (->)    q7-[e, a]-[a, e, a, e, e]
            tm-q7-a-q0-a        q0-[e, a]-[a, e, a, e, e]
            tm-q0-a-q1-e        q1-[e, a]-[e, e, a, e, e]
            tm-q1-e-q2- (->)    q2-[e, a, e]-[e, a, e, e]
            tm-q2-e-q3- (->)    q3-[e, a, e, e]-[a, e, e]
            tm-q3-a-q3- (->)    q3-[e, a, e, e, a]-[e, e]
            tm-q3-e-q4-a        q4-[e, a, e, e, a]-[a, e]
            tm-q4-a-q4- <-      q4-[e, a, e, e]-[a, a, e]
            tm-q4-a-q4- <-      q4-[e, a, e]-[e, a, a, e]
            tm-q4-e-q5- <-      q5-[e, a]-[e, e, a, a, e]
            tm-q5-e-q6-a        q6-[e, a]-[a, e, a, a, e]
            tm-q6-a-q7- (->)    q7-[e, a, a]-[e, a, a, e]
            tm-q7-e-q8-e        q8-[e, a, a]-[e, a, a, e]
            YES
            Continue(y/n)?= n.
***********************************************************************/     
start(q0). final(q8). % start and final states 

tm((q0,a),(q1,e)).    % start with first 'a' and delete it
tm((q1,e),(q2,->)).   % go right to find first e
tm((q2,a),(q2,->)).   % go right to find first e
tm((q2,e),(q3,->)).   % (in between e) is found 
tm((q3,a),(q3,->)).   % go till next e 
tm((q3,e),(q4,a)).    % overright 'a'

tm((q4,a),(q4,<-)).     % find leftmost blank
tm((q4,e),(q5,<-)).     % skip in between blank
tm((q5,a),(q5,<-)).     % find leftmost  put 'a' back
tm((q5,e),(q6,a)).      %  put 'a' back

tm((q6,a),(q7,->)).    % go to next character to copy
tm((q7,e),(q8,e)).     % if next char is the in_between e then HALT
tm((q7,a),(q0,a)).     % if next char is 'a', start all over

start:- write('Turing Machine for COPY (DUPLICATE) a string\n'),
    write('String to duplicate: '),read(W),
    Left=[e],append(W,[e,e,e,e],Right),start(S), % put as many e's as |w| 
    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.

% Turing Machine halts when in final state
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).