/* File: turing11.pl 
   Author: Mihaela Malita
   Title: Turing Machine for COPY (DUPLICATE) with REGISTER. Input= e w e;  Output= e w e w e
   Method: 
   read first leftmost (load register) and delete it (load in register)
   copy it on second blank right
   go back left to second blank (skip in between blank) and write the symbol back (take from REgister)
   go right next symbol 
   if it is blank then HALT (it is the in_between blank)
   if not go to beginning.
   Tape Alphabet={a,b,e} States={q0-q8,q10,q20,q30,q40,q50,q60} Final=q8 Start=q0  e= blank 
   Types of transitions are:   
    t(OldReg,NewReg,(s,a),(q,b)).   OldState=s, reads an a, jumps to state q and overwrites b
    t(OldReg,NewReg,(s,a),(q,->)).  OldState=s, reads an a, jumps to state q and moves right
    t(OldReg,NewReg,(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,b].
                                    q0-[e]-[a, b, e, e, e, e]
                _G290-a-q0-a-q1-e   a-q1-[e]-[e, b, e, e, e, e]
                a-a-q1-e-q2- (->)   a-q2-[e, e]-[b, e, e, e, e]
                a-a-q2-b-q2- (->)   a-q2-[e, e, b]-[e, e, e, e]
                a-a-q2-e-q3- (->)   a-q3-[e, e, b, e]-[e, e, e]
                a-a-q3-e-q4-a       a-q4-[e, e, b, e]-[a, e, e]
                a-a-q4-a-q4- <-     a-q4-[e, e, b]-[e, a, e, e]
                a-a-q4-e-q5- <-     a-q5-[e, e]-[b, e, a, e, e]
                a-a-q5-b-q5- <-     a-q5-[e]-[e, b, e, a, e, e]
                a-a-q5-e-q6-a       a-q6-[e]-[a, b, e, a, e, e]
                a-a-q6-a-q7- (->)   a-q7-[e, a]-[b, e, a, e, e]
                a-a-q7-b-q0-b       a-q0-[e, a]-[b, e, a, e, e]
                a-b-q0-b-q1-e       b-q1-[e, a]-[e, e, a, e, e]
                b-b-q1-e-q2- (->)   b-q2-[e, a, e]-[e, a, e, e]
                b-b-q2-e-q3- (->)   b-q3-[e, a, e, e]-[a, e, e]
                b-b-q3-a-q3- (->)   b-q3-[e, a, e, e, a]-[e, e]
                b-b-q3-e-q4-b       b-q4-[e, a, e, e, a]-[b, e]
                b-b-q4-b-q4- <-     b-q4-[e, a, e, e]-[a, b, e]
                b-b-q4-a-q4- <-     b-q4-[e, a, e]-[e, a, b, e]
                b-b-q4-e-q5- <-     b-q5-[e, a]-[e, e, a, b, e]
                b-b-q5-e-q6-b       b-q6-[e, a]-[b, e, a, b, e]
                b-b-q6-b-q7- (->)   b-q7-[e, a, b]-[e, a, b, e]
                b-b-q7-e-q8-e       b-q8-[e, a, b]-[e, a, b, e]
                YES
                Continue(y/n)?= n.
***********************************************************************/     
start(q0). final(q8). % start and final states 

tm(_,X,(q0,X),(q1,e)).      % start with first letter, delete, and memorize in Reg

tm(R,R,(q1,e),(q2,->)).     % go right to find first e 
tm(R,R,(q2,a),(q2,->)).     % 
tm(R,R,(q2,b),(q2,->)).     % 

tm(R,R,(q2,e),(q3,->)).     % (in between e) is found 
 
tm(R,R,(q3,a),(q3,->)).     % go right till next  e 
tm(R,R,(q3,b),(q3,->)).     %

tm(X,X,(q3,e),(q4,X)).      % overright last e with Reg

tm(R,R,(q4,a),(q4,<-)).     % find leftmost blank 
tm(R,R,(q4,b),(q4,<-)).     %
tm(R,R,(q4,e),(q5,<-)).     % skip in between blank
tm(R,R,(q5,a),(q5,<-)).     % find leftmost  
tm(R,R,(q5,b),(q5,<-)).     %

tm(X,X,(q5,e),(q6,X)).      %  write whatever is in Reg 

tm(R,R,(q6,a),(q7,->)).     % go to next character to copy
tm(R,R,(q6,b),(q7,->)).     % 

tm(R,R,(q7,e),(q8,e)).      % if next char is in_between e then HALT
tm(R,R,(q7,a),(q0,a)).      % if next char is not ee, start all over
tm(R,R,(q7,b),(q0,b)).      %

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(R,Q,_,_):- final(Q).   % halt when final state
                
% tm((q,A),(s,->)).       Move to next symbol on the tape and go to new state                      
compute(R,State,Left,Right):- Right=[A|T],tm(R,NR,(State,A),(NewState,->)),
                    append(Left,[A],NewLeft),NewRight=T,
   write(R-NR-State-A-NewState-(->)),tab(5),write(NR-NewState-NewLeft-NewRight),nl,
                    compute(NR,NewState,NewLeft,NewRight).    
                                                    
% tm((q,A),(s,<-)).       Move to previous symbol on the tape and go to new state                      
compute(R,State,Left,Right):- Right=[A|T],tm(R,NR,(State,A),(NewState,<-)),
                     append(NewLeft,[X],Left),NewRight=[X,A|T],
    write(R-NR-State-A-NewState-(<-)),tab(5),write(NR-NewState-NewLeft-NewRight),nl,
                     compute(NR,NewState,NewLeft,NewRight).    
% tm((s,a),(q,b)).       If a is read then overwrite b, go to Newstate                      
compute(R,State,Left,Right):- Right=[A|T],tm(R,NR,(State,A),(NewState,B)),
                    not(member(B, [->,<-])),NewRight=[B|T],
    write(R-NR-State-A-NewState-B),tab(5),write(NR-NewState-Left-NewRight),nl,
                    compute(NR,NewState,Left,NewRight).