Курсовая работа - Гамильтоновы циклы / программа / gamcycl

Uses
dos,crt;
VAR a,b:array[1..100,1..100] of integer;
i,j,n,ij:integer;
stro:text;
procedure ini_b;
var i,j:integer;
begin;
for i:=1 to n do
for j:=1 to n do
b[i,j]:=a[i,j]*j;
end;

procedure ini_p1;
var i,j:integer;
s_i,s_j:string[3];
f1:text;
begin;
for i:=1 to n do
for j:=1 to n do
begin;
str(i,s_i); if i<10 then s_i:='00'+s_i else if i<100 then s_i:='0'+s_i;
str(j,s_j); if j<10 then s_j:='00'+s_j else if j<100 then s_j:='0'+s_j;
assign(f1,'vrm\p'+s_i+s_j+'.txt');
rewrite(f1);
if a[i,j]<>0 then writeln(f1,a[i,j]:4);
close(f1);
end;
end;

procedure multi_B_P1(nom:integer);
var ii,i,j,k,s,ip:integer;
s_i,s_j,s_k:string[3];
f1,f2:text;
label q1;
begin;
for i:=1 to n do
for j:=1 to n do
begin;
str(i,s_i); if i<10 then s_i:='00'+s_i else if i<100 then s_i:='0'+s_i;
str(j,s_j); if j<10 then s_j:='00'+s_j else if j<100 then s_j:='0'+s_j;
assign(f2,'vrm\p2'+s_i+s_j+'.txt');
rewrite(f2);
if i<>j then begin;
for k:=1 to n do
begin;
str(k,s_k); if k<10 then s_k:='00'+s_k else if k<100 then s_k:='0'+s_k;

if (b[i,k]=i) or (b[i,k]=j) or (b[i,k]=0) then goto q1;
assign(f1,'vrm\p'+s_k+s_j+'.txt');
reset(f1);
ii:=0;
ip:=0;
while not eof(f1) do begin;
ip:=0;ii:=0;
while not eoln(f1) do begin;
ip:=0;
read(f1,ip);
if (nom=1) and (ip<>0) then begin; {write(f2,ip:4);}ii:=2;end;
if (nom>1) and (ip<>0)then begin;
if ii=0 then begin;write(f2,b[i,k]:4);ii:=1;end; write(f2,ip:4);end;
end;
if ii=2 then begin;write(f2,b[i,k]:4);end;
if ii>0 then writeln(f2);
ii:=0;
readln(f1);
end;
close(f1);
q1: end;
end;
close(f2);
end;
end;
procedure rename_P1_P2;
var i,j,IP1,IP2:integer;
s_i,s_j:string[3];
f1,F2:text;
AA:ARRAY[1..100] OF INTEGER;
ia,k,li,llj:integer;
label mm,mm2;
begin;
for i:=1 to n do
for j:=1 to n do
begin;
str(i,s_i); if i<10 then s_i:='00'+s_i else if i<100 then s_i:='0'+s_i;
str(j,s_j); if j<10 then s_j:='00'+s_j else if j<100 then s_j:='0'+s_j;
assign(f1,'vrm\p'+s_i+s_j+'.txt');
erase(f1);
assign(f1,'vrm\p2'+s_i+s_j+'.txt');
reset(f1);
assign(f2,'vrm\p'+s_i+s_j+'.txt');
rewrite(f2);
ia:=1; llj:=0;
while not eof(f1) do begin;
ia:=1;
while not eoln(f1) do begin;
read(f1,aa[ia]); inc(ia);
end;
if ia=1 then goto mm;
dec(ia);
for k:=1 to ia do if (aa[k]=0) or (aa[k]=i) or (aa[k]=j) then goto mm;
for k:=1 to ia do begin;
for li:=1 to k-1 do if (aa[k]=aa[li]) then goto mm2;
write(f2,aa[k]:4);llj:=1; mm2:end;
mm: readln(f1);if llj>0 then writeln(f2);
end;
close(f1);close(f2);
erase(f1);
end;
end;

procedure viv_P;
var ii,jj,i,j,k,s,ip:integer;
s_i,s_j:string[3];
f1:text;
begin;
clrscr;
for i:=1 to n do
for j:=1 to n do
begin;
str(i,s_i); if i<10 then s_i:='00'+s_i else if i<100 then s_i:='0'+s_i;
str(j,s_j); if j<10 then s_j:='00'+s_j else if j<100 then s_j:='0'+s_j;
write('p[',i,',',j,']=');
assign(f1,'vrm\p'+s_i+s_j+'.txt');
reset(f1);
ii:=0;jj:=0;
while not eof(f1) do begin;
while not eoln(f1) do begin;
read(f1,ip);
if (ii=0) and (jj>0) then write('+');
if ii>0 then write('*'); write(ip);ii:=1;
end;
readln(f1); jj:=1; II:=0;
end;
readln;
close(f1);
end;
end;
procedure viv_P2;
var ii,jj,i,j,k,s,ip:integer;
s_i,s_j:string[3];
f1:text;
begin;
writeln(stro,'*********************************************');
for i:=1 to n do
for j:=1 to n do
begin;
str(i,s_i); if i<10 then s_i:='00'+s_i else if i<100 then s_i:='0'+s_i;
str(j,s_j); if j<10 then s_j:='00'+s_j else if j<100 then s_j:='0'+s_j;
write(stro,'p[',i,',',j,']=');
assign(f1,'vrm\p'+s_i+s_j+'.txt');
reset(f1);
ii:=0;jj:=0;
while not eof(f1) do begin;
while not eoln(f1) do begin;
read(f1,ip);
if (ii=0) and (jj>0) then write(stro,'+');
if ii>0 then write(stro,'*'); write(stro,ip);ii:=1;
end;
readln(f1); jj:=1; II:=0;
end; writeln(stro);

close(f1);
end;
end;

procedure viv_res;
var ii,jj,i,j,k,s,ip,iij:integer;
ss_i,ss_j, s_i,s_j:string[3];
f1:text;
begin;
clrscr;
for i:=1 to n do
for j:=1 to n do
begin;
str(i,s_i); if i<10 then s_i:='00'+s_i else if i<100 then s_i:='0'+s_i;
str(j,s_j); if j<10 then s_j:='00'+s_j else if j<100 then s_j:='0'+s_j;
str(j,ss_j);
str(i,ss_i);
assign(f1,'vrm\p'+s_i+s_j+'.txt');
reset(f1);
ii:=0;jj:=0;iij:=0;
while not eof(f1) do begin;
while not eoln(f1) do begin;
read(f1,ip);
if (ii=0) and (jj>0) then begin;write(' '); iij:=0;end;
if ii>0 then write('-');
if iij=0 then begin;
write('CHAIN p[',i,',',j,']=',ss_j,'-',ss_i,'-');
iij:=1;
end;
write(ip);ii:=1;
end;
readln(f1); jj:=1; II:=0;
end;
if iij>0 then readln;
close(f1);
end;
end;
procedure delete_povtor;
var ii,jj,i,j,k,s,ip,iij:integer;
s_i,s_j:string[3];
f1:text;
et1:array[1..100,0..100] of integer;
kol_et,i3:integer;

function prov_povtor:boolean;
var iaa,k2,l,l2:integer;
label ddd,ddd2;
begin;
for k2:=1 to et1[i,0]-1 do
if et1[i,k2]<>et1[j,k2] then goto ddd;
prov_povtor:=true;exit;
ddd:
for l:=1 to et1[i,0]-1 do
begin;
iaa:=et1[i,1];
for l2:=2 to et1[i,0]-1 do et1[i,l2-1]:=et1[i,l2];
et1[i,et1[i,0]-1]:=iaa;
for k2:=1 to et1[i,0]-1 do
if et1[i,k2]<>et1[j,k2] then goto ddd2;
prov_povtor:=true;exit;
ddd2:
end;
prov_povtor:=false;exit;
end;

label yyy;
begin;
kol_et:=1; s:=0;
for i:=1 to 100 do et1[i,0]:=1;
for i:=1 to n do
for j:=1 to n do
begin;
str(i,s_i); if i<10 then s_i:='00'+s_i else if i<100 then s_i:='0'+s_i;
str(j,s_j); if j<10 then s_j:='00'+s_j else if j<100 then s_j:='0'+s_j;
assign(f1,'vrm\p'+s_i+s_j+'.txt');
reset(f1);
while not eof(f1) do begin;
ii:=0;
while not eoln(f1) do begin;
read(f1,ip);
if ip>0 then begin;
if ii=0 then begin;
et1[kol_et,et1[kol_et,0]]:=j;
inc(et1[kol_et,0]);
et1[kol_et,et1[kol_et,0]]:=i;
inc(et1[kol_et,0]);
ii:=1;end;
et1[kol_et,et1[kol_et,0]]:=ip;
inc(et1[kol_et,0]);
end;
end;
readln(f1); ii:=0;
if (a[et1[kol_et,et1[kol_et,0]-1],et1[kol_et,1]]=1) and
(a[et1[kol_et,1],et1[kol_et,2]]=1) then inc(kol_et);
end;
close(f1);
end;
for i:=1 to kol_et-1 do begin;
for j:=1 to i-1 do begin;
if prov_povtor then goto yyy;
end;
if s=0 then begin
writeln;
writeln('Ќ ©¤Ґ­­лҐ ЇгвЁ:');end;
writeln;
s:=1;
for k:=1 to et1[i,0]-1 do write(et1[i,k],'-'); write(et1[i,1]);
yyy: end;


if s=0 then writeln('ЌҐв аҐиҐ­Ёп');

{ for i:=1 to kol_et-1 do begin;
writeln;
for j:=1 to et1[i,0]-1 do write(et1[i,j],'-');
end;
}

end;
procedure delete_vrm;
var i,j:integer;
s_i,s_j:string[3];
f1:text;
begin;
for i:=1 to n do
for j:=1 to n do
begin;
str(i,s_i); if i<10 then s_i:='00'+s_i else if i<100 then s_i:='0'+s_i;
str(j,s_j); if j<10 then s_j:='00'+s_j else if j<100 then s_j:='0'+s_j;
assign(f1,'vrm\p'+s_i+s_j+'.txt');
erase(f1);
end;
end;

BEGIN;
clrscr;
gotoxy(1,1);writeln('Џа®Ја ¬¬  Ї®ЁбЄ  Ј ¬Ё«мв®­®ўле жЁЄ«®ў Ђ­в®­®ў „.‚. ');

gotoxy(1,2);writeln('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® ўҐаиЁ­ Ја д  ');
gotoxy(1,3);readln(n);
if (n<3) or (n>100) then begin;writeln('ЏаҐўлиҐ­л ў®§¬®¦­®бвЁ Їа®Ја ¬¬л');readkey;exit;end;
gotoxy(1,4);writeln('‚ўҐ¤ЁвҐ ¬ ваЁжг ᬥ¦­®бвЁ Ја д ');

for i:=1 to n do begin
for j:=1 to n do begin
gotoxy(3*j,3+2*i+1);read(A[i,j]);
if not ((A[i,j]=0) or (A[i,j]=1)) then begin writeln('ЏаҐўлиҐ­л ў®§¬®¦­®бвЁ Їа®Ја ¬¬л');readkey;exit;end;
end;end;
ini_B;
ini_p1;
assign(stro,'vrm\example.txt');
rewrite(stro);
for ij:=1 to n-2 do begin;
multi_b_p1(ij);
rename_p1_p2;
viv_p2;
end;
close(stro);
// viv_p;
delete_povtor;
delete_vrm;
//viv_res;
readkey;
end.