Witam, piszę właśnie projekt. Niestety natrafiłem (znowu) na błędy, których sam nie potrafię zlokalizować i naprawić. Prosiłbym o pomoc, jeśli to możliwe. Wiem, że program jest chaotyczny i niezbyt zgrabny, ale ważne, żeby działał...
Dwa problemy:
- W procedurze iniciate zawsze wczytuje ostatni element pliku do zmiennej BestWay. Nie pomaga ustawienie wskaźnika pliku na pierwszym elemencie
seek(CurrentGenerationFile,0);
- W procedurze SeekBestWay jest jakiś błąd, który powoduje zakończenie programu z exitcode 204, czyli z tego co wyczytałem, przekroczenie pojemności zmiennej. Ale szczerze mówiąc, nie wiem co tam może być źle.
program projekt;
uses
crt,UTypes;
type
matrix=array of array of real;
var
N:integer;
TabPoints:TPoints;
TabOfDistance:matrix;
BestWay:TRoad;
LengthOfBestWay,TemporaryLength:real;
TempRoad:TRoad;
procedure ReadN(var N:integer);
var
key:char;
begin
repeat
write('Podaj ilosc punktow (N): ');
read(N);
if (N<=0) then
begin
clrscr;
write('N musi byc wieksze od 0! [d - dalej]: ');
repeat
key:=readkey;
until (key='d');
clrscr;
end;
until (N>0);
end;
procedure RandomizingPointsCoordinates(N:integer; var TabPoints:TPoints);
var
i:integer;
begin
randomize;
setlength(TabPoints,N);
for i:=0 to N-1 do
begin
TabPoints[i,0]:=random(99)+random;
TabPoints[i,1]:=random(99)+random;
end;
end;
procedure CreatingArrayOfDistance(N:integer; TabPoints:TPoints; var TabOfDistance:matrix);
var
i,k:integer;
begin
setlength(TabOfDistance,N,N);
for i:=0 to N-1 do
for k:=0 to N-1 do
TabOfDistance[i,k]:=sqrt(sqr(TabPoints[i,0]-TabPoints[k,0])+sqr(TabPoints[i,1]-TabPoints[k,1]));
end;
procedure SavePointsCooridnates(N:integer; TabPoints:TPoints);
var
i,k:integer;
key:char;
PointsCoordinatesFile:text;
begin
clrscr;
write('Czy chcesz zapisac wspolrzedne punktow do pliku? [t/n]: ');
repeat
key:=readkey;
until (key='t') or (key='n');
if key='t' then
begin
assign(PointsCoordinatesFile,'PointsCoordinates.txt');
rewrite(PointsCoordinatesFile);
for i:=0 to N-1 do
writeln(PointsCoordinatesFile,i,'. x=',TabPoints[i,0]:0:2,' y=',TabPoints[i,1]:0:3);
close(PointsCoordinatesFile);
end;
clrscr;
end;
procedure SaveArrayOfDistance(N:integer; TabOfDistance:matrix);
var
i,k:integer;
ArrayOfDistanceFile:text;
key:char;
begin
write('Czy chcesz zapisac tablice odleglosci do pliku? [t/n]: ');
repeat
key:=readkey;
until (key='t') or (key='n');
if key='t' then
begin
assign(ArrayOfDistanceFile,'ArrayOfDistance.txt');
rewrite(ArrayOfDistanceFile);
write(ArrayOfDistanceFile,' ');
for i:=0 to N-1 do
write(ArrayOfDistanceFile,' [',i,'] ');
writeln(ArrayOfDistanceFile,'');
for i:=0 to N-1 do
begin
write(ArrayOfDistanceFile,' [',i,'] ');
for k:=0 to N-1 do
begin
write(ArrayOfDistanceFile,TabOfDistance[i,k]:0:2,' ');
end;
writeln(ArrayOfDistanceFile,'');
end;
close(ArrayOfDistanceFile);
end;
end;
//Zawsze odczytuje ostatni element pliku
procedure Iniciate(N:integer; var BestWay:TRoad; var LengthOfBestWay:real; var TemporaryLength:real; TabOfDistance:matrix);
var
CurrentGenerationFile:file of TRoad;
i:integer;
plik:text;
begin
assign(CurrentGenerationFile,'CurrentGeneration.gen');
reset(CurrentGenerationFile);
seek(CurrentGenerationFile,0);
read(CurrentGenerationFile,BestWay);
TemporaryLength:=0;
for i:=1 to N-1 do
begin
TemporaryLength:=TemporaryLength+TabOfDistance[BestWay[i-1],BestWay[i]];
end;
LengthOfBestWay:=TemporaryLength;
close(CurrentGenerationFile);
assign(plik,'Iniciate.txt');
rewrite(plik);
writeln(plik,TemporaryLength:0:2);
writeln(plik,'');
for i:=0 to N-1 do
write(plik,BestWay[i],' ');
close(plik);
end;
procedure SeekBestWay(N:integer; var BestWay:TRoad; var LengthOfBestWay:real; var TemporaryLength:real; TabOfDistance:matrix; var TempRoad:TRoad);
var
i:integer;
CurrentGenerationFile:file of TRoad;
begin
assign(CurrentGenerationFile,'CurrentGeneration.gen');
reset(CurrentGenerationFile);
while not eof(CurrentGenerationFile) do
begin
read(CurrentGenerationFile,TempRoad);
TemporaryLength:=0;
for i:=1 to N-1 do
begin
TemporaryLength:=TemporaryLength+TabOfDistance[TempRoad[i-1],TempRoad[i]];
end;
if TemporaryLength<LengthOfBestWay then
begin
LengthOfBestWay:=TemporaryLength;
for i:=0 to N-1 do
BestWay[i]:=TempRoad[i];
end;
end;
close(CurrentGenerationFile);
end;
procedure CreatingFirstGeneration(N:integer; var TempRoad:TRoad);
var
i,k,RandomValue,Temp,EndOfOperation:integer;
CurrentGenerationFile:file of TRoad;
CurrentGenerationTextFile:text;
begin
setlength(TempRoad,N);
if (N mod 2)=0 then
EndOfOperation:=(N div 2)
else
EndOfOperation:=(N div 2)+1;
assign(CurrentGenerationFile,'CurrentGeneration.gen');
rewrite(CurrentGenerationFile);
assign(CurrentGenerationTextFile,'Generations.txt');
rewrite(CurrentGenerationTextfile);
randomize;
writeln(CurrentGenerationTextFile,'Generation: 1');
writeln(CurrentGenerationTextFile,'');
for i:=1 to EndOfOperation do
begin
for k:=0 to N-1 do
TempRoad[k]:=k;
for k:=0 to N-1 do
begin
RandomValue:=random(N-1);
Temp:=TempRoad[RandomValue];
TempRoad[RandomValue]:=TempRoad[N-1];
TempRoad[N-1]:=Temp;
end;
write(CurrentGenerationFile,TempRoad);
for k:=0 to N-1 do
write(CurrentGenerationTextFile,TempRoad[k],' ');
writeln(CurrentGenerationTextFile,'');
end;
close(CurrentGenerationFile);
close(CurrentGenerationTextFile);
end;
procedure result(N:integer; var BestWay:TRoad; LengthOfBestWay:real);
var
i:integer;
plik:text;
begin
assign(plik,'Result.txt');
rewrite(plik);
writeln(plik,LengthOfBestWay:0:2);
writeln(plik,'');
for i:=0 to N-1 do
write(plik,BestWay[i],' ');
close(plik);
end;
begin
clrscr;
ReadN(N);
RandomizingPointsCoordinates(N,TabPoints);
CreatingArrayOfDistance(N,TabPoints,TabOfDistance);
SavePointsCooridnates(N,TabPoints);
SaveArrayOfDistance(N,TabOfDistance);
CreatingFirstGeneration(N,TempRoad);
Iniciate(N,BestWay,LengthOfBestWay,TemporaryLength,TabOfDistance);
//SeekBestWay(N,BestWay,LengthOfBestWay,TemporaryLength,TabOfDistance,TempRoad); Nie działa! (???)
result(N,BestWay,LengthOfBestWay);
end.
Jakby ktoś chciał uruchomić u siebie program, dołączam kod Utypes:
unit UTypes;
interface
type
TPoint = array[0..1] of Real;
TPoints = array of TPoint;
TRoad = array of Integer;
implementation
end.
