program t; uses dos,crt; const max = 20; er1 = 'Ошибка: файл не найден'; er2 = 'Ошибка: символов входного алфавита слишком много или слишком мало'; er3 = 'Ошибка: состояний слишком мало или слишком много'; er4 = 'Ошибка: в ленте присутствуют символы не соответствующие входному алфавиту'; er5 = 'Ошибка: лента кончилась справа'; er6 = 'Ошибка: лента кончилась слева'; type tcom = record move : char; new : integer; out : char; end; talphabet = char; tstate = 0..max; var table : array [talphabet,tstate] of tcom; tablefile : text; k1,k2 : integer; filename : string; curstate : tstate; maxalphabet : 0..max; maxstate : tstate; endstate : tstate; tape : string; curpos : integer; curcom : tcom; symbol : char; alphabet : array [1..max] of talphabet; symbolfind : boolean; alphabetend : boolean; begin clrscr; writeln('Некое подобие машины Тьюринга.'); writeln('Сначала введите имя файла с управляющей таблицей.'); writeln('Затем количество символов входного алфавита и количество состояний, они могут быть в пределах от 1 до ',max,'.'); writeln('Не ошибитесь. Иначе я могу неверно интерпретировать управляющую таблицу!'); writeln('Для продолжения нажмите клавишу Enter.'); readln; clrscr; write('файл с управляющей таблицей: '); readln(filename); if (fsearch(filename,'') = '') then begin writeln(er1); exit; end; write('количество символов входного алфавита: '); readln(maxalphabet); if (maxalphabet > max) or (maxalphabet <= 0) then begin writeln(er2); exit; end; write('количество состояний: '); readln(maxstate); if (maxstate > max) or (maxstate <= 0) then begin writeln(er3); exit; end; write('лента: '); readln(tape); assign(tablefile,filename); reset(tablefile); alphabetend := false; for k1 := 1 to maxstate do begin writeln('##состояние ',k1); for k2 := 1 to maxalphabet do begin readln(tablefile,symbol); if not alphabetend then alphabet[k2] := symbol; with table[symbol,k1] do begin readln(tablefile,out); readln(tablefile,move); readln(tablefile,new); readln(tablefile); writeln('##',symbol,' -> ',out,' ',move,' ',new); end; end; alphabetend := true; writeln; end; write('##входной алфавит: '); for k1 := 1 to maxalphabet do write(alphabet[k1]); writeln; writeln; for k1 := 1 to length(tape) do begin symbolfind := false; for k2 := 1 to maxalphabet do begin if tape[k1] = alphabet[k2] then symbolfind := true; end; if not symbolfind then begin writeln(er4); exit; end; end; curstate := 1; endstate := 0; curpos := length(tape); while (curstate <> endstate) do begin curcom := table[tape[curpos],curstate]; writeln('##текущее состояние ',curstate); writeln('##заменяем символ ',tape[curpos],' на ',curcom.out); tape[curpos] := curcom.out; case curcom.move of 'r' : begin if curpos = length(tape) then begin writeln(er5); exit; end else begin inc(curpos); writeln('##сдвигаемся вправо'); end; end; 'n' : begin writeln('##стоим на месте'); end; 'l' : begin if curpos = 1 then begin writeln(er6); exit; end else begin dec(curpos); writeln('##сдвигаемся влево'); end; end; end; curstate := curcom.new; writeln('##переходим в состояние ',curstate); writeln('##текущая лента ',tape); writeln; end; writeln('Результат: ',tape); end.