Dwa błędy w sporym programie.

0

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:

1) W procedurze iniciate zawsze wczytuje ostatni element pliku do zmiennej BestWay. Nie pomaga ustawienie wskaźnika pliku na pierwszym elemencie

seek(CurrentGenerationFile,0);

2) 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.
0

Co to jest ?

TabPoints[i,0]:=random(99)+random;
TabPoints[i,1]:=random(99)+random;

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0