Witam
Jak w temacie. Napisałem program który ma za zadanie liczyć odległość między dwoma punktami poprzez wszystkie inne, a następnie miał wybierać najkrótszą z nich. Po oddaniu projektu dostałem drugą część która miała za zadanie nakreślenie grafu niezorientowanego. Ponieważ nie mogłem sobie z nim poradzić to wykładowca kazał mi wstawić do programu byle jaką strukturę dynamiczną. I tutaj jest problem. Mianowicie nie wiem co tutaj można zrobić. Jeśli byłby ktoś w stanie mi podrzucić pomysł a w szczególności pomóc w napisaniu byłbym niezwykle wdzięczny.
Kod programu.
program Projekt;
{$APPTYPE CONSOLE}
uses
SysUtils,
modul in 'Modul.pas';
begin
writeln('Prosze podaj wspolrzedne punktow:');
writeln;
wczytaj_punkty;
kalkuluj_sciezki;
kalkuluj_dlugosci;
wypisz_sciezki;
wypisz_najkrotsza;
readln;
end.
I moduł z procedurami:
unit modul;
interface
type
punkt = record
x, y: real;
end;
sciezka = array[1..5] of byte;
var
mozliwe_sciezki: array[1..6] of sciezka;
dlugosci_sciezek: array[1..6] of real;
punkty: array[1..5] of punkt;
start, koniec, najkrotsza: byte;
procedure wczytaj_punkty;
procedure wypisz_sciezki;
procedure kalkuluj_sciezki;
procedure kalkuluj_dlugosci;
procedure wypisz_najkrotsza;
implementation
procedure wczytaj_punkty;
var
i: integer;
begin
for i := 1 to 5 do
begin
writeln('Punkt ',i);
write('Podaj x: ');
readln(punkty[i].x);
write('Podaj y: ');
readln(punkty[i].y);
writeln;
end;
write('Podaj numer punktu startowego: ');
readln(start);
write('Podaj numer punktu koncowego (inny niz startowy): ');
readln(koniec);
writeln;
end;
procedure wypisz_sciezki;
var
i, j: integer;
begin
for i := 1 to 6 do
begin
write('Sciezka ',i,': ');
for j := 1 to 5 do
write(mozliwe_sciezki[i][j]);
writeln(' ',dlugosci_sciezek[i]:4:4)
end;
end;
function znajdz_w_sciezce(n, m: byte): boolean;
var
i: integer;
z: boolean;
begin
z := false;
for i := 1 to 5 do
if (mozliwe_sciezki[n][i] = m) then z := true;
znajdz_w_sciezce := z;
end;
function sciezka_sie_powtarza(n: byte): boolean;
var
z: boolean;
i: integer;
begin
z := false;
for i := 1 to 5 do
if (i <> n) then
if (mozliwe_sciezki[n][2] = mozliwe_sciezki[i][2]) and
(mozliwe_sciezki[n][3] = mozliwe_sciezki[i][3]) and
(mozliwe_sciezki[n][4] = mozliwe_sciezki[i][4]) then
z := true;
sciezka_sie_powtarza := z;
end;
procedure zamieszaj(n: byte);
var
z: boolean;
t: byte;
begin
z := true;
while sciezka_sie_powtarza(n) do
if z then
begin
t := mozliwe_sciezki[n][2];
mozliwe_sciezki[n][2] := mozliwe_sciezki[n][3];
mozliwe_sciezki[n][3] := t;
z := false;
end
else
begin
t := mozliwe_sciezki[n][3];
mozliwe_sciezki[n][3] := mozliwe_sciezki[n][4];
mozliwe_sciezki[n][4] := t;
z := true;
end;
end;
procedure kalkuluj_sciezki;
var
i, j, k: integer;
begin
for i := 1 to 6 do
begin
mozliwe_sciezki[i][1] := start;
mozliwe_sciezki[i][2] := 0;
mozliwe_sciezki[i][3] := 0;
mozliwe_sciezki[i][4] := 0;
mozliwe_sciezki[i][5] := koniec;
end;
for i := 1 to 6 do
for j := 2 to 4 do
for k := 1 to 5 do
if not znajdz_w_sciezce(i,k) then
begin
mozliwe_sciezki[i][j] := k;
zamieszaj(i);
end;
end;
procedure kalkuluj_dlugosci;
var
i, j: integer;
begin
for i := 1 to 6 do
for j := 1 to 4 do
dlugosci_sciezek[i] := dlugosci_sciezek[i]+sqrt(
sqr(punkty[mozliwe_sciezki[i][j]].x-punkty[mozliwe_sciezki[i][j+1]].x)+
sqr(punkty[mozliwe_sciezki[i][j]].y-punkty[mozliwe_sciezki[i][j+1]].y));
end;
procedure wypisz_najkrotsza;
var
i: integer;
t: real;
begin
najkrotsza := 1;
t := dlugosci_sciezek[1];
for i := 2 to 6 do
if (dlugosci_sciezek[i] < t) then
begin
najkrotsza := i;
t := dlugosci_sciezek[i];
end;
writeln;
write('Najkrotsza sciezka wiedzie przez punkty: ');
for i := 1 to 5 do
write(mozliwe_sciezki[najkrotsza][i]);
writeln;
end;
end.
Z góry dzięki za pomoc i pozdrawiam Arek