wrzucam zamiast starego programu - poprawiony, ostateczny, ktory dla 10 miast, przy czym, gdy ustawilem, ze kazde miasto polaczone jest z kazdym, oblicza w ciagu okolo 2 sekund najkrotsza sciezke, jak bedzie dzialal dla wiekszej nie wiem.
program xyz; {komiwojazer, drogi symetryczne}
uses
crt,graph;
const
dys=10; {ilosc miast}
type
miasto = record
nazwa:string;
x,y:byte;
odwiedzone:byte;
end;
tab_miast = array [1..dys] of miasto;
sasiedztwo = record
krawedz:byte;
odleglosc:real;
end;
macierz = array [1..dys,1..dys] of sasiedztwo;
macierz2 = array [1..dys*dys] of sasiedztwo;
var
i:byte;
tablica_miast:tab_miast;
m_s:macierz;
matrix:macierz2;
path:string[dys+1];
dystans:real;
magiczna_liczba,ujemna:integer;
m_w:array[1..dys] of byte;
m_s2:macierz;
procedure inicjalizuj;
var
v,grdriver,grmode,kod:integer;
begin
grdriver:=detect;
initgraph(grdriver,grmode,'d:\tp\bgi'); {wprowadzic, bo nie bedzie dzialac}
kod:=graphresult;
if kod<>grOK then
begin
grapherrormsg(kod);
readln;
halt(1);
end;
end;
procedure wprowadzanie; {wczytuje dane}
var
f:text;
str,str1,str2:string;
i,j,k,l:integer;
begin
assign(f,'d:\graf.txt'); {wprowadzic, bo nie bedzie dzialac }
reset(f);
for i:=1 to dys do
begin
readln (f,str);
str1:=copy(str,1,pos('(',str)-1);
tablica_miast[i].nazwa:=str1;
str2:=copy(str,pos('(',str)+1,pos(',',str)-1-pos('(',str));
val(str2,k,l);
tablica_miast[i].x:=k;
str2:=copy(str,pos(',',str)+1,pos(')',str)-1-pos(',',str));
val(str2,k,l);
tablica_miast[i].y:=k;
end;
for i:=1 to dys do
begin
readln(f,str);
for j:=1 to dys do
begin
str1:=copy(str,j,1);
val(str1,k,l);
m_s[i,j].krawedz:=k;
if m_s[i,j].krawedz=1 then
m_s[i,j].odleglosc:=sqrt
(sqr(tablica_miast[i].x-tablica_miast[j].x)+
sqr(tablica_miast[i].y-tablica_miast[j].y))
else m_s[i,j].odleglosc:=0;
end;
end;
close(f);
end;
procedure licz;
var
i,su,uj:integer;
begin
su:=0;
uj:=0;
for i:=1 to dys do
su:=su+i;
for i:=1 to dys-1 do
uj:=uj+dys*i;
magiczna_liczba:=su;
ujemna:=uj;
end;
procedure splaszczaj; {konwertuje tablice 2 wymiarowa w 1 wymiar}
var
i,j,k:byte;
begin
k:=0;
for i:=1 to dys do
for j:=1 to dys do
begin
k:=k+1;
matrix[k].odleglosc:=m_s[i,j].odleglosc;
matrix[k].krawedz:=m_s[i,j].krawedz;
end;
end;
procedure dekoduj; {okresla sciezke na podstawie liczb i,j..}
var i:byte;
begin
for i:=1 to dys do
case m_w[i] of
1: path[i]:='a';
2: path[i]:='b';
3: path[i]:='c';
4: path[i]:='d';
5: path[i]:='e';
6: path[i]:='f';
7: path[i]:='g';
8: path[i]:='h';
9: path[i]:='i';
10: path[i]:='j';
end;
path[dys+1]:=path[1];
end;
procedure revers; {uzywa magicznej liczby i reszty do sprawdzenia poprawnosci}
var
a,b,c,d,e,f,g,h,i,j :integer;
dyst:real;
begin
for a:=1 to dys do
begin
if matrix[a].odleglosc = 0 then continue;
for b:=dys+1 to dys*2 do
begin
if matrix[b].odleglosc = 0 then continue;
if b-dys=a then continue;
for c:=dys*2+1 to dys*3 do
begin
if matrix[c].odleglosc = 0 then continue;
if (c-dys=b) or (c-dys*2=a) then continue;
for d:=dys*3+1 to dys*4 do
begin
if matrix[d].odleglosc = 0 then continue;
if (d-dys=c) or (d-dys*2=b) or (d-dys*3=a) then continue;
for e:=dys*4+1 to dys*5 do
begin
if matrix[e].odleglosc = 0 then continue;
if (e-dys=d) or (e-dys*2=c) or (e-dys*3=b) or (e-dys*4=a) then continue;
for f:=dys*5+1 to dys*6 do
begin
if matrix[f].odleglosc = 0 then continue;
if (f-dys=e) or (f-dys*2=d) or (f-dys*3=c) or (f-dys*4=b) or (f-dys*5=a) then continue;
for g:=dys*6+1 to dys*7 do
begin
if matrix[g].odleglosc = 0 then continue;
if (g-dys=f) or (g-dys*2=e) or (g-dys*3=d) or (g-dys*4=c) or (g-dys*5=b)
or (g-dys*6=a) then continue;
for h:=dys*7+1 to dys*8 do
begin
if matrix[h].odleglosc = 0 then continue;
if (h-dys=g) or (h-dys*2=f) or (h-dys*3=e) or (h-dys*4=d) or (h-dys*5=c)
or (h-dys*6=b) or (h-dys*7=a) then continue;
for i:=dys*8+1 to dys*9 do
begin
if matrix[i].odleglosc = 0 then continue;
if (i-dys=h) or (i-dys*2=g) or (i-dys*3=f) or (i-dys*4=e) or (i-dys*5=d)
or (i-dys*6=c) or (i-dys*7=b) or (i-dys*8=a) then continue;
for j:=dys*9+1 to dys*10 do
begin
if matrix[j].odleglosc = 0 then continue;
if (j-dys=i) or (j-dys*2=h) or (i-dys*3=g) or (i-dys*4=f) or (i-dys*5=e)
or (i-dys*6=d) or (i-dys*7=c) or (i-dys*8=b) or (i-dys*9=a) then continue;
{ 2 strike }
if a+b+c+d+e+f+g+h+i+j-ujemna <> magiczna_liczba then continue;
dyst:=matrix[a].odleglosc+matrix[b].odleglosc+matrix[c].odleglosc+matrix[d].odleglosc+matrix[e].odleglosc
+ matrix[f].odleglosc+matrix[g].odleglosc+matrix[h].odleglosc+matrix[i].odleglosc+matrix[j].odleglosc;
if dystans < dyst then
begin
dystans:=dyst;
m_w[1]:=a; m_w[2]:=b-dys; m_w[3]:=c-dys*2; m_w[4]:=d-dys*3; m_w[5]:=e-dys*4;
m_w[6]:=f-dys*5; m_w[7]:=g-dys*6; m_w[8]:=h-dys*7; m_w[9]:=i-dys*8; m_w[10]:=j-dys*9;
dekoduj;
end;
end;end;end;end;end;end;end;end;end;end;
end;
procedure reszta; { przypisuje najkrotsza droge}
var i:byte;
begin
for i:=1 to dys do
begin
m_s2[i,m_w[i]].krawedz:=2;
m_s2[m_w[i],i].krawedz:=2;
end;
end;
procedure rysuj; { rysuje wszystkie sciezki}
var
i,j:integer;
begin
inicjalizuj;
for i:=1 to dys do
begin
setcolor(white);
circle(55*(tablica_miast[i].x),480-(55*tablica_miast[i].y),8);
for j:=1 to dys do
if m_s[i,j].krawedz=1 then
line(55*(tablica_miast[i].x),
480-(55*tablica_miast[i].y),
55*(tablica_miast[j].x),480-(55*tablica_miast[j].y));
setcolor(red);
outtextxy((55*(tablica_miast[i].x)-2),458-(55*tablica_miast[i].y),tablica_miast[i].nazwa);
end;
end;
procedure finalizuj; {rysuje najkrotsza sciezke}
var
i,j:integer;
begin
inicjalizuj;
for i:=1 to dys do
begin
setcolor(green);
circle(55*(tablica_miast[i].x),480-(55*tablica_miast[i].y),8);
for j:=1 to dys do
if m_s2[i,j].krawedz=2 then
line(55*(tablica_miast[i].x),
480-(55*tablica_miast[i].y),
55*(tablica_miast[j].x),480-(55*tablica_miast[j].y));
setcolor(blue);
outtextxy((55*(tablica_miast[i].x)-2),458-(55*tablica_miast[i].y),tablica_miast[i].nazwa);
end;
end;
begin
m_s2:=m_s;
clrscr;
writeln('jesli zaczyna sie z dowolnego miasta i odwiedza sie wszystkie pozostale');
writeln('miasta oraz wraca sie do punktu poczatku a drogi sa symetryczne, to nie ma');
writeln('znaczenia z ktorego miasta sie rozpoczelo, oraz nie ma znaczenia w jakim');
writeln('kierunku zaczniemy isc, jesli bedziemy trzymac sie tego kierunku, tzn nie');
writeln('bedziemy zawracac');
readkey;
clrscr;
{ wprowadzone dane
A(2,2)
B(8,3)
C(3,6)
D(5,4)
E(4,1)
F(7,4)
G(2,2)
H(4,8)
I(1,4)
J(6,3)
0111111111
1011111111
1101111111
1110111111
1111011111
1111101111
1111110111
1111111011
1111111101
1111111000
}
wprowadzanie;
splaszczaj;
licz;
revers;
write('dystans: ', dystans:4:4, ' sciezka: ');
for i:=1 to dys+1 do
write(path[i]);
readkey;
clrscr;
rysuj;
readkey;
reszta;
clrscr;
finalizuj;
readkey;
end.