/******************************************** File: turing1.pl System: SWI-Prolog 5.2.8 Author: Mihaela Malita Date: 11/13/2003 Title: A Turing machine for adding two unary numbers Tape Alphabet={1,e,0,$} States={q0,q1,2,q3,q4} Final=q4 Start=q0 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 [$ 1 1 1 0 1 1 e] Output tape is [1, 1, 1, 1, $, e, e] At first blank (e) we assume the string finishes. We assume there are no blanks in the data on the input tape Example: ?- start. Turing Machine that adds two unary numbers Strings to add separated by 0: [1,1,0,1,1,1]. q0-[]-[$, 1, 1, 0, 1, 1, 1, e] tm-q0-1-q1- (->) q1-[1]-[$, 1, 0, 1, 1, 1, e] tm-q1-1-q1- (->) q1-[1, 1]-[$, 0, 1, 1, 1, e] tm-q1-0-q2-1 q2-[1, 1]-[$, 1, 1, 1, 1, e] tm-q2-1-q2- (->) q2-[1, 1, 1]-[$, 1, 1, 1, e] tm-q2-1-q2- (->) q2-[1, 1, 1, 1]-[$, 1, 1, e] tm-q2-1-q2- (->) q2-[1, 1, 1, 1, 1]-[$, 1, e] tm-q2-1-q2- (->) q2-[1, 1, 1, 1, 1, 1]-[$, e] tm-q2-e-q3- <- q3-[1, 1, 1, 1, 1]-[$, 1, e] tm-q3-1-q4-e q4-[1, 1, 1, 1, 1]-[$, e, e] YES Continue(y/n)?= n. ***********************************************************************/ start(q0). final(q4). tm((q0,1),(q1,->)). % start (assume head is on first 1) tm((q1,1),(q1,->)). % move right when you have 1 tm((q1,0),(q2,1)). % read 0, put 1 instead tm((q2,1),(q2,->)). % move right when you have 1's tm((q2,e),(q3,<-)). % second blank (means end), go back tm((q3,1),(q4,e)). % delete the last 1 ( and you are done) start:- write('Turing Machine that adds two unary numbers\n'), write('Strings to add separated by 0: '),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).