program Jarvis;
uses crt;
type TPoint = record
x,y:longint;
end;
PNode = ^TNode;
TNode = record
data:TPoint;
prev:PNode;
next:PNode;
end;
TList = record
head:PNode;
tail:PNode;
end;
procedure Init(var L:TList);
begin
L.head := NIL;
L.tail := NIL;
end;
function IsEmpty(L:TList):boolean;
begin
IsEmpty := L.head = NIL;
end;
procedure InsertLast(var L:TList;key:TPoint);
var newNode:PNode;
begin
new(newNode);
newNode^.data := key;
newNode^.next := NIL;
if IsEmpty(L) then
L.head := newNode
else
L.tail^.next := newNode;
newNode^.prev := L.tail;
L.tail := newNode;
end;
procedure DeleteFirst(var L:TList);
var temp:PNode;
begin
if not IsEmpty(L) then
begin
temp := L.head;
if L.head^.next = NIL then
L.tail := NIL
else
L.head^.next^.prev := NIL;
L.head := L.head^.next;
dispose(temp);
end;
end;
procedure DisplayForward(L:TList);
var current:PNode;
begin
write('Lista (pierwszy-->ostatni): ');
current := L.head;
while current <> NIL do
begin
write('(',current^.data.x,',',current^.data.y,')',' ');
current := current^.next;
end;
writeln;
end;
procedure DisplayBackward(L:TList);
var current:PNode;
begin
write('Lista (ostatni-->pierwszy): ');
current := L.tail;
while current <> NIL do
begin
write('(',current^.data.x,',',current^.data.y,')',' ');
current := current^.prev;
end;
writeln;
end;
function equals(a1,a2:TPoint):boolean;
begin
equals := (a1.x = a2.x)and(a1.y = a2.y);
end;
function vect(a1,a2,b1,b2:TPoint):longint;
begin
vect := (a2.x - a1.x)*(b2.y-b1.y)-(b2.x-b1.x)*(a2.y-a1.y);
end;
function dist2(a1,a2:TPoint):longint;
begin
dist2 := sqr(a2.x-a1.x)+sqr(a2.y-a1.y);
end;
procedure Solve(var A:TList;var B:TList);
var p,q,m,min:PNode;
begin
if not IsEmpty(A) then
begin
m := A.head;
p := m^.next;
Init(B);
while p <> NIL do
begin
if (p^.data.y < m^.data.y)or
((p^.data.y = m^.data.y)and(p^.data.x > m^.data.x))then
m := p;
p := p^.next;
end;
if m^.prev = NIL then
A.head := m^.next
else
m^.prev^.next := m^.next;
if m^.next = NIL then
A.tail := m^.prev
else
m^.next^.prev := m^.prev;
if IsEmpty(A)then
A.tail := m
else
A.head^.prev := m;
m^.next := A.head;
m^.prev := NIL;
A.head := m;
insertLast(B,A.head^.data);
if A.head^.next <> NIL then
min := A.head^.next
else
min := A.head;
repeat
q := A.head^.next;
while q <> NIL do
begin
if(vect(B.tail^.data,min^.data,B.tail^.data,q^.data) < 0)or
((vect(B.tail^.data,min^.data,B.tail^.data,q^.data) = 0)and
(dist2(B.tail^.data,min^.data)<dist2(B.tail^.data,q^.data)))then
min := q;
q := q^.next;
end;
insertLast(B,min^.data);
min := A.head;
until equals(B.tail^.data,B.head^.data);
DeleteFirst(B);
end;
end;
var A,B:TList;
p:TPoint;
ch:char;
esc:char;
begin
Init(A);
repeat
writeln('Czy chcesz wczytac wspolrzedne punktu');
readln(ch);
while upcase(ch) <> 'N' do
begin
readln(p.x,p.y);
insertLast(A,p);
writeln('Czy chcesz wczytac wspolrzedne nastepnego punktu');
readln(ch);
end;
Solve(A,B);
writeln('Lista A :');
DisplayForward(A);
DisplayBackward(A);
writeln('Lista B :');
DisplayForward(B);
DisplayBackward(B);
while not IsEmpty(A)do
DeleteFirst(A);
while not IsEmpty(B)do
DeleteFirst(B);
esc := readkey;
until esc = #27;
end.
Jak napisać równoważny program nie allokując pamięci na węzły listy B
2.
Diks i Rytter w swojej książce proponują użycie cyklicznej listy dwukierunkowej
Jak wyglądałby kod takiego programu z użyciem cyklicznej listy dwukierunkowej
3.
U Cormena znalazłem pseudokod algorytmu Grahama i najwięcej kłopotu sprawia mi drugi punkt
tego pseudokodu
Pewną próbę przetłumaczenia tego pseudokodu podjęli na ważniaku
http://wazniak.mimuw.edu.pl/index.php?title=Zaawansowane_algorytmy_i_struktury_danych/Wyk%C5%82ad_11
Jeśli chodzi o algorytm sortujący to koleś na innym forum próbował mi wytłumaczyć
sortowanie przez łączenie naturalne i chyba nawet udało mi się poprawić jego pseudokod
ale pewnie trzeba jeszcze zdefiniować typ proceduralny i napisać własną funkcję porównującą