Приложение 1. Подпрограммы реализации операций

НАД ЦИФРОВЫМИ АВТОМАТАМИ

program openadca;

{$M 64000,0,4000}

uses printer,crt;

{ oпеpации над автоматами }

label 1,2;

type cu=string[6];

pok=packed array[1..5] of cu;

{ pok=packed array[1..200] of cu; }

mca=packed array[1..10,1..10] of cu;

mas=packed array[1..20] of char;

st=string[20];

var s,f1:text; sim:char; fam:string[20];

poka,pokb,pokc,pokd,poke,pof:pok;

{ var pokc,pokc1,pokz:pok;}

cub,cub1,cud9,cub99:cu;

var mcaa1,mcaa2,mcaa3,mcaa4,mcab1,mcab2,mcab3,mcab4,

mcac1,mcac2,mcac3,mcac4,mcad1,mcad2,mcad3,mcad4,

mcae1,mcae2,mcae3,mcae4,mcaf1,mcaf2,mcaf3,mcaf4,

mcag1,mcag2,mcag3,mcag4,mcah1,mcah2,mcah3,mcah4,

mcau1,mcau2,mcal1,mcal2,mcal3,mcal4,mcap1,mcap2,

mca11,mcap12,mcap13,mcap14,mcap21,mca22,mcap23,

mcap24:mca; { mca }

ya,yb,yc,yd,ye,yf,yg,yh,y0,y1,yu,yl:mas; { сост-я S }

mya,myb,myc,myd,mye,myf,myg,myh,myl,my0,my1,myu,myab,myba,mya1,

myb1,{ мощности множеств}

mpemca,nva,ngr,nlstc,nlstd,nlscc,nlscd,nsccc1,nscdc1, nstcc1,nstdc1,

i,j,k,l,g,h,m,n,k1,kk,prpusca,pravm,pravc,pravp,prava, prravca, protca, pperm,pperc,ppera,

nlst,nlsc,p1lst,p1lsc,nsc1,nst1,ns,sc,nc,nx,km,sp, pvx,pzp:integer;

const st1='a';st2='b';st3='c';st4='d';st5='e';st6='f';st7='g';

st8='h';st9='m';st10='n';st11=' группа ';st12=' вариант '; st13='u';st14='l';

{ опрации над множествами }

{1 - пересечение множеств }

procedure perm(p1,p2:mas;mp1,mp2:integer;var p:mas; var mp:integer);

label 1;

var i,j:integer; begin mp:=0;

for i:=1 to mp1 do begin for j:=1 to mp2 do if p1[i]=p2[j]

then begin mp:=mp+1;p[mp]:=p1[i]; goto 1; end; 1:end; end;

{2 - ‘закачка’ множества во множество }

procedure zakm(p1:mas;mp1:integer; var p:mas; var mp:integer);

var i:integer;

begin mp:=0; for i:=1 to mp1 do begin mp:=i;p[i]:=p1[i];end;end;

{3 - вычитание множеств }

procedure vicm(p1,p2:mas;mp1,mp2:integer;var p:mas;var mp:integer);

label 1; var i,j:integer; begin

for j:=1 to mp1 do begin for i:=1 to mp2 do begin if p2[i]=p1[j]

then goto 1; end; mp:=mp+1;p[mp]:=p1[j]; 1:end ; end;

{4 - объединение множеств }

procedure obm(p1,p2:mas;mp1,mp2:integer;var p:mas;var mp:integer);

begin zakm(p1,mp1,p,mp);vicm(p2,p1,mp2,mp1,p,mp); end;

{5 - упорядочение множествa }

procedure yporm(var p:mas; var mp:integer);

label 1;

var i,j:integer; sim:char; begin

for i:=1 to mp-1 do begin for j:=i+1 to mp do if p[i]>p[j]

then begin sim:=p[j];p[j]:=p[i];p[i]:=sim;goto 1; end; 1:end; end;

{6 - проверка равенства множеств p1 и p2 }

procedure ravm(p1,p2:mas;mp1,mp2:integer);

var mf,me:integer;f,e:mas;

begin mf:=0; me:=0; vicm(p1,p2,mp1,mp2,f,mf);

vicm(p2,p1,mp2,mp1,e,me);writeln(lst); if(me=0) and (mf=0)

then begin pravm:=1;write(lst,'равны ') end else begin pravm:=0;

write(lst,'не равны '); end; end;

{7 - печать множества, его мощности}

procedure pecm(p:mas;mp:integer;pst:st);

var i:integer;

begin writeln(lst);write(lst,'my',pst,'=',mp,' y',pst,'=(');

for i:=1 to mp do write(lst,' y',p[i]); write(lst,' )'); end;

{ oперации над кубами и покрытиями }

{8 - ‘закачка’ куба в куб c признаком}

procedure zakc(var pcub:cu;pcub1:cu);

var i1:integer;

begin pcub:=' ';for i1:=1 to ns do pcub[i1]:=pcub1[i1];

end;

{9 - ‘закачкa' куба в куб без признака}

procedure zakc1(var pcub:cu;pcub1:cu);

var i1:integer;

begin pcub:=' ';for i1:=2 to ns do pcub[i1]:=pcub1[i1];

end;

{10 - печать куба }

procedure pecc(pcub:cu);

var i2:integer; begin

for i2:=1 to ns do write(pcub[i2]);write(' '); end;

{11 - ‘закачкa’ покрытия pok1 в pokp }

procedure zakp(var pokp:pok;var mpp:integer;pokp1:pok; mpp1:integer);

var i3:integer;

begin mpp:=0;

for i3:=1 to mpp1 do begin mpp:=i3;pokp[i3]:=' ';

pokp[i3]:=pokp1[i3];end; end;

{12 - oпределение равенства кубов }

procedure ravc(pcub1,pcub2:cu);

label 1; var i4:integer;

begin pravc:=0; writeln(lst); for i4:=1 to ns do

if pcub1[i4]<>pcub2[i4] then begin pravc:=1;write(lst,'не paвны');

goto 1;end; write(lst,'pавны');1:end;

{13 - ‘подстыковкa’ куба к покрытию }

procedure stpc(var pokp:pok;var mpp:integer;pcub:cu);

begin mpp:=mpp+1;pokp[mpp]:=' ';pokp[mpp]:=pcub; end;

{14 - ‘стыковкa’ pokp2 с pokp1 }

procedure stpp(var pokp1:pok;var mpp1:integer;pokp2:pok;mpp2

:integer);

var i6:integer; begin

for i6:=1 to mpp2 do begin mpp1:=mpp1+1;pokp1[mpp1]:=' ';

pokp1[mpp1]:=pokp2[i6];end;end;

{15 - пересечение кубов }

procedure perc(pcub1,pcub2:cu;var pcub:cu);

label 1; var i7:integer; begin pperc:=0;pcub:=' ';

for i7:=1 to ns do if (pcub1[i7]=pcub2[i7]) or (pcub2[i7]='X')

then pcub[i7]:=pcub1[i7] else if pcub1[i7]='X' then

pcub[i7]:=pcub2[i7] else begin pperc:=1; goto 1;end; 1:end;

{16 - вычитание кубов }

procedure vicc(pcub1,pcub2:cu;var pokp:pok;var mpp:integer);

label 1; var i9,kv,ko1:integer;cub9:cu;

begin

mpp:=0;kv:=0;ko1:=0; cub9:=' ';for i9:=1 to ns do

begin if (pcub2[i9]='X') or (pcub1[i9]=pcub2[i9]) then begin

cub9[i9]:='v'; kv:=kv+1;;end else if pcub1[i9]<>'X' then begin

ko1:=ko1+1;if ko1>0 then begin stpc(pokp,mpp,pcub1) ;goto 1;end;

end else if pcub2[i9]='0' then cub9[i9]:='1' else cub9[i9]:='0';

end; if kv=ns then goto 1 else

begin for i9:=1 to ns do begin cub99:=' ';cub99:=pcub1;

if cub9[i9]<>'v' then begin cub99[i9]:=cub9[i9];

stpc(pokp,mpp,cub99);end;end; end; 1:end;

{17 - звездчатое произведение кубов }

procedure zpc(pcub1,pcub2:cu;var pcub:cu;var pzp:integer);

var i10,ky:integer; label 1;

begin ky:=0;pzp:=0;pcub:=' ';

for i10:=1 to ns do begin if pcub1[i10]=pcub2[i10] then

pcub[i10]:=pcub1[i10] else if pcub2[i10]='X'then pcub[i10]:=

pcub1[i10] else if pcub1[i10]='X' then pcub[i10]:=pcub2[i10]

else begin pcub[i10]:='X';ky:=ky+1;if ky>1

then begin pzp:=1;goto 1;end;end;end; 1: end;

{18 определение стоимости куба }

procedure osc(pcub:cu);

var i14:integer; begin sc:=0;

for i14:=1 to ns do if pcub[i14]<>'X' then sc:=sc+1;nx:=ns-sc;end;

{19 - oпределение стоимости покрытия }

procedure osp(pokp:pok;mpp:integer;pst:st);

var i15:integer;cub15:cu; begin sp:=0;

for i15:=1 to mpp do begin cub15:=' ';

cub15:=pokp[i15];osc(cub15); sp:=sp+sc;

if sc>1 then sp:=sp+1;end;if (mpp=1) and (sc>1) then sp:=sp-1;

writeln(lst,'sp',pst,sp); end;

{20 - печать покрытия , его стоимости}

procedure pecp(pokp:pok;mpp,nsp:integer;pst:st);

var i16:integer; begin

writeln(lst);writeln(lst,'покрытие',pst); for i16:=1 to mpp do

pecc(pokp[i16]); osp(pokp, mpp,pst) ; end;

{21 - oпределение вхождения куба в куб }

procedure vxgc(pcub1,pcub2:cu);

label 1; var i17:integer;

begin for i17:=1 to ns do if (pcub1[i17]=pcub2[i17]) or

(pcub2[i17] ='X') then pvx:= 1 else begin pvx:=0 ; goto 1;end;

1: end;

{22 - сжатие покрытия }

procedure sgp(var pokp:pok;var mpp:integer);

label 1; var i18,j18,k18:integer;

begin 1: for i18:=1 to mpp do for j18:=1 to mpp do if i18<>j18

then begin vxgc(pokp[i18],pokp[j18]);if pvx=1 then begin for

k18:=i18 to mpp do begin pokp[k18]:=' '; pokp[k18]:=

pokp[k18+1];end;mpp:=mpp- 1;goto 1;end; end; end;

{23 - пересечение покрытий }

procedure perpp(pokp1,pokp2:pok;mpp1,mpp2:integer;var pokp:pok;

var mpp:integer);

var i8,j8:integer;cub8:cu; begin mpp:=0;

for i8:=1 to mpp1 do for j8:=1 to mpp2 do begin perc(pokp1[i8],

pokp2[j8],cub8);if pperc =0 then begin stpc(pokp,mpp,cub8);

sgp(pokp,mpp);end; end;end;

{24 - сжатие покрытия засчет другого покрытмя }

procedure sgpp(var pokp:pok;var mpp:integer;pokp1:pok;mpp1:integer);

label 1; var i19,j19,k19:integer;

begin 1:for i19:=1 to mpp do for j19:=1 to mpp1 do begin

vxgc(pokp[i19],pokp1[j19]);if pvx=1 then begin for k19:=i19 to

mpp do pokp[k19]:=pokp[k19+1]; mpp:=mpp-1;goto 1;end;end; end;

{25 - поиск простых импликант }

procedure ppi(pokc1:pok;mpc1:integer;var pokz:pok;var mpz:integer);

label 1,2; var pokd:pok;pcub20:cu;i20,j20,mpd,pzp:integer;

begin nc:=1; mpz:=0;

2:mpd:=0;sgp(pokc1,mpc1);for i20:=1 to mpc1-1 do begin for j20:=

i20+1 to mpc1 do begin zpc(pokc1[i20],pokc1[j20],pcub20,pzp);

if pzp=0 then begin

osc(pcub20);if nx>=nc then stpc(pokd,mpd,pcub20);end;end;end;

if mpd=0 then goto 1 else sgp(pokd,mpd);

sgpp(pokd,mpd,pokc1,mpc1);

if mpd=0 then goto 1;sgpp(pokc1,mpc1,pokd,mpd);

stpp(pokc1,mpc1,pokd,mpd);nc:=nc+1;goto 2;

1:stpp(pokz,mpz,pokc1,mpc1);end;

{26 - вычитание покрытий }

procedure vipp(pokp1,pokp2:pok;mpp1,mpp2:integer;var pokp:pok;

var mpp:integer);

label 1,2,3; var pokv1,pokv2,pokv3:pok;mpv1,mpv2,mpv3,i12,j12,

k12:integer;

begin

mpp:=0; if (mpp1=0) or (pokp2[1]='XXXXXXXXXX') then goto 2 else

if mpp2=0 then begin stpc(pokp,mpp,'XXXXXXXXXX'); goto 2;end;

for i12:=1 to mpp1 do begin mpv1:=0;stpc(pokv1,mpv1,pokp1[i12]);

for j12:=1 to mpp2 do begin mpv3:=0;for k12:=1 to mpv1 do begin

vicc(pokv1[k12],pokp2[j12],pokv2,mpv2); if mpv2=0 then goto 3;

stpp(pokv3,mpv3,pokv2,mpv2);

sgp(pokv3,mpv3);

3: end;if mpv3=0 then goto 1 else mpv1:=0;

stpp(pokv1,mpv1,pokv3,mpv3);end;

stpp(pokp,mpp,pokv3,mpv3);sgp(pokp,mpp);1: end; 2: end;

{27 - проверка равенства покрытий }

procedure ravp(pokp1,pokp2:pok;mpp1,mpp2:integer);

var pok26,pok62:pok;mp26,mp62:integer;

begin vipp(pokp1,pokp2,mpp1,mpp2,pok26,mp26);

vipp(pokp2,pokp1,mpp2,mpp1,pok62,mp62);writeln(lst);

if(mp26=0) and (mp62=0) then write(lst,'равны') else

write(lst,'не равны'); end;

{28 - проверка отношения между покрытиями }

procedure otp(pokp1,pokp2:pok;mpp1,mpp2:integer);

var pok27,pok72,pok272:pok;mp27,mp72,mp272:integer;

begin vipp(pokp1,pokp2,mpp1,mpp2,pok27,mp27);

vipp(pokp2,pokp1,mpp2,mpp1,pok72,mp72);

perpp(pokp1,pokp2,mpp1,mpp2,pok272,mp272);writeln(lst);

if(mp27=0) and (mp72=0) then write(lst,'равны ') else if

mp27=0 then write(lst,' лч < пч') else if mp72=0 then

write(lst,'лч > пч') else if mp272=0 then write(lst,

'общее отношение ') else write(lst,'нет общего '); end;

{29 - объединение кубов}

procedure obc(pcub1,pcub2:cu;var pokp:pok;var mpp:integer);

var pok28:pok;mp28:integer;

begin mpp:=0;mp28:=0;stpc(pok28,mp28,pcub1);

stpc(pok28,mp28,pcub2);ppi(pok28,mp28,pokp,mpp); end;

{30 - дополнение покрытия}

procedure dopp(pokp1:pok;mpp1:integer;var pokp:pok;var mpp

:integer);

var pokun:pok;mpun:integer; label 1;

begin

mpp:=0;if mpp1=0 then begin mpp:=1; pokp[mpp]:='XXXXXXXXXX';

goto 1;end else if pokp1[1]='XXXXXXXXXX' then goto 1;mpun:=1;

pokun[mpun]:='XXXXXXXXXX';

vipp(pokun,pokp1,mpun,mpp1,pokp,mpp); 1: end;

{31 - объединение покрытий}

procedure obp(pokp1,pokp2:pok;mpp1,mpp2:integer;

var pokp:pok; var mpp:integer);

var pok30,pok31:pok;mp30,mp31,i:integer;

begin

mp30:=0;stpp(pok30,mp30,pokp1,mpp1);

stpp(pok30,mp30,pokp2,mpp2);dopp(pok30,mp30,pok31,mp31);

dopp(pok31,mp31,pokp,mpp); end;

{ операции над автоматами }

{ 32 - опаределение пустоты мса }

procedure pusсa(mcap1,mcap2,mcap3,mcap4:mca;myp:integer);

label 1,2; var i,j,k:integer;

begin prpusca:=0;

for i:=1 to myp do begin for j:=1 to myp do

if(mcap1[i,j]=' ') and (mcap2[i,j]=' ') {and

(mcap3[i,j]=' ') and (mcap4[i,j]=' ')} then goto 1

else begin prpusca:=1; writeln (lst,'mca непуста'); goto 2; end;1: end;

writeln(lst,'mca пуста'); 2:end;

{ 33 - обнуление мса }

procedure zakсa0(yp1:mas;myp1:integer;var mcap1,mcap2,mcap3,mcap4:mca;

var yp:mas;var myp:integer);

var i,j,k:integer;

begin zakm(yp1,myp1,yp,myp);

for k:=1 to kk*2 do for i:=1 to myp do for j:=1 to myp

do begin if k=1 then mcap1[i,j]:=' 'else if k=2

then mcap2[i,j]:=' ' else if k=3 then mcap3[i,j]:=' ' else

mcap4[i,j]:=' ';end; end;

{ 34 - ‘закачкa' мсар1 в однородную мсар }

procedure zakcao(mcap11,mcap12:mca;yp1:mas;myp1:integer;

var mcap1,mcap2,mcap3,mcap4:mca;var yp:mas;var myp:integer);

var i,j,k:integer;

begin zakm(yp1,myp1,yp,myp);

zakca0(yp1,myp1,mcap1,mcap2,mcap3,mcap4,yp,myp);for k:=1 to kk do for i:=1

to myp1 do for j:=1 to myp1 do begin if k=1 then mcap1[i,j]:=

mcap11[i,j] else if k=2 then mcap2[i,j]:=mcap12[i,j] else

mcap3[i,j]:=mcap13[i,j];end; end;

{ 35 - ‘закачкa’ мсар1 в неоднородную мсар }

procedure zakcan(yun:mas;myun:integer;mcap11,mcap12,mcap13,mcap14:mca;

yp1:mas;myp1:integer;

var mcap1,mcap2,mcap3,mcap4:mca;var yp:mas;var myp:integer);

var i,pi,j,pj,k:integer; label 1,2;

begin zakca0(yun,myun,mcap1,mcap2,mcap3,mcap4,yp,myp);for k:=1 to kk do

for i:=1 to myp1 do for j:=1 to myp1 do begin pj:=0;pi:=0;1:if

yp1[j+1]<>yp[j+1+pj] then begin pj:=pj+1;goto 1;end;

2:if yp1[i]<>yp[i+pi] then begin pi:=pi+1;goto 2;end; if k=1 then

mcap1[i+pi,j+pj]:=mcap11[i,j]

else if k=2 then mcap2[i+pi,j+pj]:=mcap12[i,j] else

mcap3[i+pi,j+pj]:=mcap13[i,j];end; end;

{36 - стыковкa mca }

procedure stca(var mcap1,mcap2,mcap3,mcap4:mca;yp:mas;myp:integer;

mcap11,mcap12,mcap13,mcap14:mca;var kk:integer);

var i,j,k:integer;

begin for k:=1 to kk do for i:=1

to myp do for j:=1 to myp do begin if k=1 then

mcap2[i,j]:=mcap11[i,j]

else if k=2 then mcap3[i,j]:=mcap12[i,j] else

mcap4[i,j]:=mcap13[i,j];end; kk:=kk*2; end;

{37 - упрощение мса за счет склеивания }

procedure sgca(var mcap1,mcap2,mcap3,mcap4:mca;myp,kk:integer);

var i,j,k:integer;pokp,pokp1:pok; mpp,mpp1:integer;cub,cubb1:cu;

sim:char;

begin for i:=1 to myp do for j:=1 to myp do begin

cub:=mcap1[i,j];cub1:=mcap2[i,j];sim:=cub[5];if (sim='E')or

(sim='F') or (sim='U') then cub[5]:=' ';

if(cub[1]=cub1[1]) and

(cub[1]<>' ') then begin mpp:=1;pokp[mpp]:=cub;mpp:=2;

pokp[mpp]:=cub1;ppi(pokp,mpp,pokp1,mpp1);if mpp1=1 then begin

mcap1[i,j]:=' ';mcap2[i,j]:=' ';cub:=pokp1[1];

cub[5]:=' ';if cub='XXXX ' then mcap1[i,j]:='1 1 ' else

mcap1[i,j]:=cub;cub:=mcap1[i,j];if (sim='E')or(sim='F') or (sim='U')

then cub[5]:=sim;mcap1[i,j]:=cub;end else for k:=1 to mpp1 do if k=1

then mcap1[i,j]:=pokp1[k] else if k=2 then mcap2[i,j]:=pokp1[2];

end;end; end;

{ 38 - проверка равенства автоматов }

procedure rava( mcap1,mcap2,mcap3,mcap4,mcap11,mcap12,mcap13,

mcap14:mca;myp,kk:integer);

var i,j,k:integer; label 1,2;

begin prava:=0; for i:=1

to myp do begin for j:=1 to myp do if (mcap1[i,j]=mcap11[i,j]) and

(mcap2[i,j]=mcap12[i,j]) then goto 1 else begin prava:=1;

writeln(lst,'mca неравны');goto 2 ; end;

1:end;writeln(lst,'мса равны'); 2:end;

{39 под-ма печати mpca с признаками }

procedure pecap(mcap1,mcap2,mcap3,mcap4:mca;yp:mas;myp:integer;

pst:st);

var i,j,k,l,l1:integer;cub:cu;

begin writeln(lst);write(lst,'mca',pst,' ');

for i:=1 to myp do write(lst,' y',yp[i]);

for i:=1 to myp do begin writeln(lst);write(lst,' y',yp[i],' ');

for k:=1 to kk do begin for j:=1 to myp do begin if k=1 then

zakc(cub,mcap1[i,j]) else if k=2 then zakc(cub,mcap2[i,j]) else

zakc(cub,mcap3[i,j]); pecc(cub);end; if kk>1 then begin writeln(lst);

write(lst,' ');end;end;end;

end;

{40 под-ма печати мса без признаков }

procedure peca(mcap1,mcap2,mcap3,mcap4:mca;yp:mas;myp:integer;

pst:st);

var i,j,k,l,l1:integer;cub:cu;

begin writeln(lst);write(lst,'mca',pst,' ');

for i:=1 to myp do write(lst,' y',yp[i]);

for i:=1 to myp do begin writeln(lst);write(lst,' y',yp[i],' ');

for k:=1 to kk do begin for j:=1 to l do begin if k=1 then

zakc1(cub,mcap1[i,j]) else if k=2 then zakc1(cub,mcap2[i,j]) else

zakc1(cub,mcap3[i,j]); pecc(cub);end; if kk>1 then begin writeln(lst);

write(lst,' ');end;end;end;

end;

{41 под-ма ввода мса }

procedure vvod(var mcap1:mca;var mcap2:mca;var mcap3:mca;myp:integer);

var i,j,k,l:integer; label 1;

begin 1:for k:=1 to kk do for i:=1 to myp do begin

readln(f1,sim);for j:=1 to myp do begin if k=1 then

read(f1, mcap1[i,j]) else if k=2 then read(f1,mcap2[i,j])

else read(f1,mcap3[i,j]); end;end;

end;

{ 42 под-ма объединения автоматов }

procedure oba(var mcap1,mcap2,mcap3,mcap4:mca;var myp:integer;var yp:mas;

mcap11,mca12,mcap21,mcap22:mca;

yp1:mca;myp1:integer);

var i,j:integer;

begin myp:=0;

for i:=1 to myp do for j:=1 to myp do begin cub:=mcap1[i,j];

if cub<>' ' then begin cub[5]:='0';mcap1[i,j]:=cub;end;

cub:=mcap2[i,j];if cub<>' ' then begin cub[5]:='0';

mcap2[i,j]:=cub;end;end;

for i:=1 to myp do for j:=1 to myp do begin cub:=mcap11[i,j];

if cub<>' ' then begin cub[5]:='1';mcap11[i,j]:=cub;end;

cub:=mcap12[i,j];if cub<>' ' then begin cub[5]:='1';

mcap12[i,j]:=cub;end;end;

staa(mcap1,mcap2,mcap3,mcap4,yp,myp,mcap11,mcap12,mcap13,mcap14,kk);

sga(mcap1,mcap2,mcap3,mcap4,myp,kk);

end;

{ 43 под-ма пересечения автоматов }

procedure pera(var mcar1,mcar2:mca;var yp:mas;var myp:integer;

mcap11,mcap12,mcap21,mcap22:mca);

var i,j:integer;

begin

for i:=1 to myp do for j:=1 to myp do begin if mcar1[i,j]<>mcap11[i,j]

then mcar1[i,j]:=' '; end; end;

{ 44 под-ма вычитания автоматов }

procedure vica(var mcar1,mcar2:mca;yp:mas;myp:integer;

mcap11,mcap12,mcap21,mcap22:mca);

var i,j:integer;

begin

for i:=1 to myp do for j:=1 to myp do begin if mcar1[i,j]=mcap11[i,j]

then mcar1[i,j]:=' '; end; end;

{ 45 под-ма дополнения автомата }

procedure dopca(mcap11:mca;myp1:integer;var mcap1,mcap2:mca;

var myp,kk:integer);

label 1,2,3; var i,j,l:integer;

begin for k:=1 to kk do for i:=1

to myp do for j:=1 to myp do begin cub1:=mcap11[i,j];

if k=1 then cub:=mcau1[i,j] else cub:=mcau2[i,j];

for l:=1 to ns-1 do begin

if cub[l]=cub1[l] then goto 1 else

3:begin if k=1 then mcap1[i,j]:=cub else mcap2[i,j]:=cub;goto 2 end;

1: end;if cub[5]=cub1[5] then begin cub:=' ';goto 3;end else

if cub[5]=' ' then if cub1[5]='0' then cub[5]:='1' else begin

cub[5]:='0';goto 3;end else

if cub1[5]=' ' then begin cub:=' '; goto 3;end else goto 3; 2:end;

end;

{Головная программа}

begin clrscr; assign(f1,'wca.dat'); reset(f1);

1: writeln(lst);read(f1,nva);if nva=0 then goto 2;

readln(f1,ngr,ns,kk,fam);writeln(lst,fam,st11,ngr);

writeln(lst,' вариант ',nva, ' ns=',ns,' kk=',kk );

read(f1,mya);read(f1,sim);

for i:=1 to mya do read(f1,ya[i]);{pecm(ya,mya,st1);}

vvod(mcaa1,mcaa2,mcaa3,mya);readln(f1,sim);

pecap(mcaa1,mcaa2,mcaa3,mcaa4,ya,mya,st1);

read(f1,myb);{peca(mcaa1,mcaa2,mcaa3,mcaa4,ya,mya,st1);}

read(f1,sim);for i:=1 to myb do read(f1,yb[i]);

{pecm(yb,myb,st2);}

vvod(mcab1,mcab2,mcab3,myb);readln(f1,sim);

pecap(mcab1,mcab2,mcab3,mcab4,yb,myb,st2);

{peca(mcab1,mcab2,mcab3,mcab4,yb,myb,st2);}

zakan(yu,myu,mcaa1,mcaa2,mcaa3,mcaa4,ya,mya,mcac1,mcac2,mcac3,mcac4,yc,myc);

{pecap(mcac1,mcac2,mcac3,mcac4,yc,myc,st3);}

zakan(yu,myu,mcab1,mcab2,mcab3,mcab4,yb,myb,mcad1,mcad2,mcad3,mcad4,yd,myd);

{pecap(mcad1,mcad2,mcad3,mcad4,yd,myd,st4);}

{omlv(yc,yd,myc,myd,yf,myf);pecm(yf,myf,st6);}

{omlv(yd,yc,myd,myc,yg,myg);pecm(yg,myg,st7); }

{obm(ya,yb,mya,myb,yu,myu);yporm(yu,myu); pecm(yu,myu,st13);}

{pusa(mcae1,mcae2,mcae3,mcae4,mye);}

{pecap(mcae1,mcae2,mcae3,mcae4,ye,mye,st5);}

zakan(yu,myu,mcaa1,mcaa2,mcaa3,mcaa4,ya,mya,mcae1,mcae2,mcae3,mcae4,

ye,mye);

pecap(mcae1,mcae2,mcae3,mcae4,ye,mye,st5);

zakan(yu,myu,mcab1,mcab2,mcab3,mcab4,yb,myb,mcaf1,mcaf2,mcaf3,mcaf4,

yf,myf);

pecap(mcaf1,mcaf2,mcaf3,mcaf4,yf,myf,st6); writeln(lst);

rava(mcae1,mcae2,mcae3,mcae4,mcaf1,mcaf2,mcaf3,mcaf4,myf,kk);

zakan(yu,myu,mcaa1,mcaa2,mcaa3,mcaa4,ya,mya,mcag1,mcag2,mcag3,mcag4,

yg,myg);

{rava(mcag1,mcag2,mcag3,mcag4,mcae1,mcae2,mcae3,mcae4,myg,kk);}

{staa(mcae1,mcae2,mcae3,mcae4,ye,mye,mcaf1,mcaf2,mcaf3,mcaf4,kk);}

{pecap(mcae1,mcae2,mcae3,mcae4,ye,mye,st5);

sga(mcae1,mcae2,mcae3,mcae4,mye,kk);

writeln(lst);writeln(lst,'упрощение автомата на основе тождеств');

pecap(mcae1,mcae2,mcae3,mcae4,ye,mye,st5);

ypa(mcae1,mcae2,mcae3,mcae4,mye,kk);

writeln(lst);writeln(lst,'упр-е авт-а на основе неиз-ти лу-й');

pecap(mcae1,mcae2,mcae3,mcae4,ye,mye,st5);}

pusa(mcae1,mcae2,mcae3,mcae4,mye);

oba(mcac1,mcac2,mcac3,mcac4,yc,myc,mcaf1,mcaf2,mcaf3,mcaf4,kk);

writeln(lst);writeln(lst,'объединение автоматов');

pecap(mcae1,mcae2,mcae3,mcae4,ye,mye,st5); kk:=1;

zakcao(mcaun1,mcaun2,spun,moi,mcac1,mcac2,moc);

pera(mcac1,mcac2,mcac3,mcac4,yc,myc,mcad1,mcad2,mcad3,mcad4);

writeln(lst);writeln(lst,'пересечение автоматов');

pecap(mcac1,mcac2,mcac3,mcac4,yc,myc,st3);

zakao(mcaa1,mcaa2,mcaa3,mcaa4,ya,mya,mcal1,mcal2,mcal3,mcal4,

yl,myl);

zakao(mcab1,mcab2,mcab3,mcab4,yb,myb,mcah1,mcah2,mcah3,mcah4,

yh,myh);

pecap(mcal1,mcal2,mcal3,mcal4,yl,myl,st14);

pecap(mcah1,mcah2,mcah3,mcah4,yh,myh,st8);

vica(mcal1,mcal2,mcal3,mcal4,yl,myl,mcah1,mcah2,mcah3,mcah4);

writeln(lst);writeln(lst,'прямая разность автоматов');

pecap(mcal1,mcal2,mcal3,mcal4,yl,myl,st14);

{zakao(mcaa1,mcaa2,mcaa3,mcaa4,ya,mya,mcal1,mcal2,mcal3,mcal4,

yl,myl);

zakao(mcab1,mcab2,mcab3,mcab4,yb,myb,mcah1,mcah2,mcah3,mcah4,

yh,myh);

pecap(mcal1,mcal2,mcal3,mcal4,yl,myl,st14);

pecap(mcah1,mcah2,mcah3,mcah4,yh,myh,st8);

vica(mcah1,mcah2,mcah3,mcah4,mcal1,mcal2,mcal3,mcal4,yh,myh,kk);

writeln(lst);writeln(lst,'обратная разность автоматов');

pecap(mcah1,mcah2,mcah3,mcah4,yh,myh,st8);

goto 1;

2:write(lst,' end');writeln(lst);

close(f1); end.