Rešitev: Turingov stroj Zapis besede na trak (Mathematica)

Iz MaFiRaWiki

Naloga: Turingov stroj Zapis besede na trak

 Clear[TS, turingovStroj, d, q0, q1, q2, q3, qY, qN]
 TS = turingovStroj[{q0, q1, q2, q3, qY, qN}, {"a", "b"}, {"a", "b", "0", "1", "$"}, "$", d, q0, qY, qN];
 d[q0, "a"] = {q1, "0", -1};
 d[q0, "b"] = {q2, "1", -1};
 d[q0, "0"] = {q0, "0", 1};
 d[q0, "1"] = {q0, "1", 1};
 d[q0, "$"] = {q3, "$", -1};
 d[q1, "0"] = {q1, "0", -1};
 d[q1, "1"] = {q1, "1", -1};
 d[q1, "$"] = {q0, "0", 1};
 d[q2, "0"] = {q2, "0", -1};
 d[q2, "1"] = {q2, "1", -1};
 d[q2, "$"] = {q0, "1", 1};
 d[q3, "0"] = {q3, "a", -1};
 d[q3, "1"] = {q3, "b", -1};
 d[q3, "$"] = {qY, "$", 0}; 

Preverimo delovanje Turingovega stroja:

Clear[prazenZnak,prehodnaFunkcija,zacetnoStanje,sprejemnoStanje,zavrnitvenoStanje]
prazenZnak[s_turingovStroj]:=s[[4]];
prehodnaFunkcija[s_turingovStroj]:=s[[5]];
zacetnoStanje[s_turingovStroj]:=s[[6]];
sprejemnoStanje[s_turingovStroj]:=s[[7]];
zavrnitvenoStanje[s_turingovStroj]:=s[[8]];

Clear[sprejema,novTrak]
sprejema[s_turingovStroj,w_]:=sprejema[s,zacetnoStanje[s],w];
sprejema[s_turingovStroj,qt_,""]:=sprejema[s, qt, {"",prazenZnak[s],""}];
sprejema[s_turingovStroj,qt_,w_String]:=sprejema[s, qt, {"",StringTake[w,1],StringDrop[w,1]}];
sprejema[s_turingovStroj, qt_, {t1_,tt_,t2_}]/;sprejemnoStanje[s]==qt := {True, {t1,tt,t2}};
sprejema[s_turingovStroj, qt_, {t1_,tt_,t2_}]/;zavrnitvenoStanje[s]==qt := {False, {t1,tt,t2}};
sprejema[s_turingovStroj, qt_, {t1_,tt_,t2_}]:=sprejema[s, First[prehodnaFunkcija[s][qt,tt]], novTrak[s,prehodnaFunkcija[s]
   [qt,tt],t1,t2]]
sprejema::usage="Funkcija sprejema[s,q,b] vrne True, če stroj s, ki je v stanju q, sprejema besedo b in False sicer.";

novTrak[s_turingovStroj, {_,nz_,0}, t1_, t2_]:={t1,nz,t2};
novTrak[s_turingovStroj, {_,nz_,1}, t1_, ""]:={StringJoin[t1,nz], prazenZnak[s], ""};
novTrak[s_turingovStroj, {_,nz_,1}, t1_, t2_]:={StringJoin[t1,nz], StringTake[t2,1], StringDrop[t2,1]};
novTrak[s_turingovStroj, {_,nz_,-1}, "", t2_]:={"", prazenZnak[s], StringJoin[nz,t2]};
novTrak[s_turingovStroj, {_,nz_,-1}, t1_, t2_]:={StringDrop[t1,-1], StringTake[t1,-1], StringJoin[nz,t2]};
novTrak::usage="Funkcija novTrak[s,p,lt,dt] vrne trak po prehodu glave stroja s, ki je predstavljen s trojico {levi del traku, 
   trenutni znak pod glavo, desni del traku}, če stroj s, naredi prehod p in je levo od glave na traku zapisano lt ter desno 
   od glave na traku zapisano dt.";

In[37]:= Map[{sprejema[TS,#],#}&, {"","a","b","aa","ba","ab","bb","aaa","baa","aba","bba","aab","bab","abb","bbb"}]
Out[37]:= {{{True,{,$,$}},}, {{True,{,$,aa$}},a}, {{True,{,$,bb$}},b}, {{True,{,$,aaaa$}},aa}, {{True,{,$,abba$}},ba}, 
           {{True,{,$,baab$}},ab}, {{True,{,$,bbbb$}},bb}, {{True,{,$,aaaaaa$}},aaa}, {{True,{,$,aabbaa$}},baa}, 
           {{True,{,$,abaaba$}},aba}, {{True,{,$,abbbba$}},bba}, {{True,{,$,baaaab$}},aab}, {{True,{,$,babbab$}},bab}, 
           {{True,{,$,bbaabb$}},abb}, {{True,{,$,bbbbbb$}},bbb}}

Glej tudi

Osebna orodja