Блок-схемы
Тело программы
Процедура rename_p1_p2
Процедура delete_povtor
Процедура multi_b_p1(ij)
Процедура delete_vrm
Процедура INI_P1
Процедура INI_B
Программный код
Содержимое файла gamcycl.pas
Uses
dos,crt;
VAR a,b:array[1..100,1..100] of integer;
i,j,n,ij:integer;
stro:text;
procedureini_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;
procedureini_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;
proceduremulti_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;
procedurerename_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;
procedureviv_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;
procedureviv_P2; // запись в файлexample.txtпромежуточных матриц
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;
procedureviv_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;
proceduredelete_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;
functionprov_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;
proceduredelete_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)thenbegin;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.