lab2001 / АИСД / лаба3

Program gamilton;
uses CRT,graph;
type
zap=record
n1:byte;
n2:byte
end;
var
masL:array [1..245] of zap;
mas:array [1..245,1..245] of byte;
Gd, Gm: integer;
b,k,n,nom,i,j:byte;
log:boolean;
g:longint;
strok:string;

procedure make;
var
xz:byte;
begin
for i:=1 to nom do
for j:= 1 to i do
begin
xz:=random(10);
if xz<5 then
begin
mas[i,j]:=0;
mas[j,i]:=0;
end
else
begin
mas[i,j]:=1;
mas[j,i]:=1;
end;
if i=j then mas[i,j]:=2;
end;
end;

function proverka:boolean;
begin
proverka:=TRUE;
b:=0;
for i:=1 to nom do
begin
for j:=1 to nom do
begin
if mas[i,j]=1 then
begin
if b<3 then b:=3;
b:=b+1;
if b=5 then b:=3;
end;
end;
if b<>3 then
begin
proverka:=false;
break;
end;
b:=0;
end;
end;

procedure vyvod;
begin
writeLn('ѓа д, 㤮ў«Ґвў®апойЁ© ­Ґ®Ўе®¤Ё¬®¬г гб«®ўЁо г¤ «®бм § ¤ вм б Ї®ЇлвЄЁ ­®¬Ґа ',g);
for i:=1 to nom do
begin
for j:= 1 to nom do
if mas[i,j] <> 2 then write(mas[i,j],' ')
else write('- ');
writeLn;
end;
end;

procedure poisk;
begin
i:=1;
j:=1;
n:=1;
for i:=1 to nom do
begin
for j:=1 to nom do
begin
if mas[i,j]=1 then
begin
log:=false;
if n>1 then
for k:=n-1 downto 1 do
if masl[k].n1=j then log:=true;
if log=false then
begin
masl[n].n1:=i;
masl[n].n2:=j;
mas[i,j]:=0;
mas[j,i]:=0;
i:=j-1;
if n>1 then
if (masl[n].n1<>masl[n-1].n2) then
begin
n:=n-1;
i:=masl[n].n1;
j:=masl[n].n2;
end;
n:=n+1;
if i<> nom then break;
end;
end;
end;
end;
end;

function proverka2:boolean;
begin
proverka2:=true;
for i:=1 to n do
begin
if masl[i+1].n1=0 then break;
if (masl[i].n2<>masl[i+1].n1) then proverka2:=false;
end;
if (mas[masl[1].n1,masl[n-1].n2]<>1) or (n<>nom) then proverka2:=false;
end;

procedure risunok;
var
x,y,x1,y1:integer;
begin
Gd := Detect;
InitGraph(Gd, Gm, '');
if GraphResult <> grOk then
begin
Textcolor(4);
WriteLn('ЌҐ ¬®Јг Ё­ЁжЁ «Ё§Ёа®ў вм Ја дЁЄг.');
WriteLn('Џа®б«Ґ¤ЁвҐ зв®Ўл д ©« EGAVGA.BGI ­ е®¤Ё«бп ў ¤ЁаҐЄв®аЁЁ Їа®Ја ¬¬л');
Writeln(' Ё Ї®Їа®Ўг©вҐ ҐйҐ а §. †Ґ« о гбЇҐе .');
Halt(1);
end;
Rectangle(1,1,639,479);
strok:='ѓ ¬Ё«мв®­®ў жЁЄ«';
setcolor(10);
outtextxy(256,35,strok);
setcolor(5);
for i:=1 to nom do
begin
x1:=round(150*cos(masl[i].n1*2*pi/nom)+320);
y1:=round(150*sin(masl[i].n1*2*pi/nom)+240);
x:=round(150*cos(masl[i].n2*2*pi/nom)+320);
y:=round(150*sin(masl[i].n2*2*pi/nom)+240);
line(x1,y1,x,y);
end;
x1:=round(150*cos(masl[1].n1*2*pi/nom)+320);
y1:=round(150*sin(masl[1].n1*2*pi/nom)+240);
x:=round(150*cos(masl[i-1].n2*2*pi/nom)+320);
y:=round(150*sin(masl[i-1].n2*2*pi/nom)+240);
line(x1,y1,x,y);
for i:=1 to nom do
begin
x:=round(150*cos(i*2*pi/nom)+320);
y:=round(150*sin(i*2*pi/nom)+240);
SetColor(5);
for j:=1 to 8 do
Circle(x,y,j);
Str(i,strok);
SetColor(10);
Outtextxy(round(165*cos(i*2*pi/nom)+320),round(165*sin(i*2*pi/nom)+240),strok);
end;
setcolor(5);
for i:=1 to nom do
begin
for j:=0 to 1 do
begin
x1:=round(150*cos(masl[i].n1*2*pi/nom)+320);
y1:=round(150*sin(masl[i].n1*2*pi/nom)+240);
x:=round(150*cos(masl[i].n2*2*pi/nom)+320);
y:=round(150*sin(masl[i].n2*2*pi/nom)+240);
if masl[i].n1=0 then
begin
x1:=round(150*cos(masl[1].n1*2*pi/nom)+320);
y1:=round(150*sin(masl[1].n1*2*pi/nom)+240);
x:=round(150*cos(masl[i-1].n2*2*pi/nom)+320);
y:=round(150*sin(masl[i-1].n2*2*pi/nom)+240);
end;
delay(5000);
if j<>1 then
begin
outtextxy(224,440,'„«п ўл室  ­ ¦¬ЁвҐ Enter');
setcolor(10)
end
else
begin
outtextxy(224,440,'„«п ўл室  ­ ¦¬ЁвҐ Enter');
setcolor(5);
end;
line(x1,y1,x,y);
end;
if i=nom then i:=0;
if keypressed then halt;
end;
end;

Begin
ClrScr;
Randomize;
WriteLn('Џа®Ја ¬¬  "Ќ е®¦¤Ґ­Ёп ў Ја дҐ ѓ ¬Ё«мв®­®ўле жЁЄ«®ў"');
Write('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® ўҐаиЁ­ Ја д : ');
ReadLn(nom);
writeLn('џ ­Ґ в®а¬®§, п Їа®бв® ¤®«Ј® ¤г¬ о...');
repeat
Make;
gotoxy(37,3);
if n=13 then n:=1;
if n=1 then write('|');
if n=4 then write('/');
if n=7 then write('-');
if n=10 then write('\');
n:=n+1;
g:=g+1;
until proverka;
writeLn;
Vyvod;
Poisk;
if proverka2 then
begin
writeLn('ѓ ¬Ё«мв®­®ў жЁЄ« г¤ «®бм Ї®бва®Ёвм:');
for i:=1 to n-1 do write('<',masl[i].n1,'> ');
writeln('<',masl[n-1].n2,'>');
Write('„«п Їа®б¬®ва  Ё§®Ўа ¦Ґ­Ёп жЁЄ«  ­ ¦¬ЁвҐ Enter');
end
else write('€§ўЁ­ЁвҐ, ­® Ј ¬Ё«мв®­®ў жЁЄ« Ї®бва®Ёвм ­Ґ г¤ «®бм');
repeat until keypressed;
read(strok);
if proverka2 then risunok;
readLn;
End.