Hej, troche ruszylem z programowaniem od ostatniego mojego postu tutaj :]
Mam kolejny problem: znajdowanie otoczki wypukłej algorytmem grahama. Wiem jak to dziala w teorii: sortowanie zbioru, szukany jest "najnizszy" punkt zbioru, potem wyznaczana polprosta do kolejnego punktu i sprawdza sie, czy na prawo jest jakis punkt, jesli jest, to do tego kolejna polprosta itd az do momentu, gdy nie ma zadnych pozostalych, wtedy ten punkt wlicza sie do otoczki i zaczyna od niego wszystko od nowa (te punkty przechowuje sie na stosie - przynajmniej tak wyczytalem na stronach). Czy ktos moglby mi to napisac w pascalu? Albo w pseudokodzie? Albo jakies wskazowki, zebym sam mogl napiasac? Implementacje stosu i szukania otoczki? Z gory thx.
0
0
uses graph, math, sysutils;
const
max=60;
type
tp = record
x,y:integer;
end;
ttab = array[1..max+1] of tp; {o jedno miejsce wiecej}
var
tab {tu spaly tygrysy, zostana slupki ogrodzenia}
:ttab;
function kat(p,k:tp):real;
begin
result:=arctan2(p.y-k.y, p.x-k.x); {arcus tangens -pi...pi, bĄd w dokumentacji FP}
end;
procedure sort(p,k :integer);
var i,j:integer; t:tp;
begin
for j:=1 to k-p+1 do
for i:=p to k-1 do
if kat(tab[i], tab[1]) < kat(tab[i+1], tab[1]) then begin
t:=tab[i]; tab[i]:=tab[i+1]; tab[i+1]:=t
end;
end;
function rozw(p,q,j:tp):real;
begin {iloczyn wektorowy, waľny tylko znak, kĄt mi©dzy QP a QJ}
result:= (p.x-q.x)*(j.y-q.y) -
(p.y-q.y)*(j.x-q.x)
end;
function ogrodzenie:integer;
var
p, i, j, mi
:integer;
t
:tp;
f: double;
begin f:=time;
{szukam najnizszego, przestawiam go na 1 pozycje}
p:=1;
for i:=2 to max do
if tab[i].y < tab[p].y then
p:=i;
t:=tab[p]; tab[p]:=tab[1]; tab[1]:=t;
tab[max+1]:=t; { na koncu wartownik, bo czapka musi si© zamknac}
{ pozostale punkty sortuje malejĄco wg. kata
jaki tworzy odcinek przechodzacy przez punkt
pierwszy i dany z osia x, punkty 1 i 2
to pierwszy odcinek plotu }
{ wrrrrr ;) babelki, przy kilku tysiĄcach
punktow juz trzeba chwile poczekac,
warto zmienic }
sort(2, max); { od 2 bo pierwszy juľ na miejscu}
writeln('sortowanie ', (time-f)*24*60*60:0:3); f:=time;
mi:=2;
p:=mi+1;
while p<=max do begin
if rozw(tab[p], tab[mi], tab[p+1])>=0
then inc(p) { P pomijam bo jest nie po tej stronie odcinka MI P+1}
else begin
inc(mi); { chwilowo dodam P }
{ ale dodanie tego punktu moze powodowac ze czesc }
{ ostatnio dodanych odpadnie }
while (rozw(tab[mi-1], tab[mi-2], tab[p]) >= 0) and (mi>3) do begin
dec(mi);
setcolor(8); { odcinamy }
line(tab[mi].x, getmaxy-tab[mi].y,
tab[mi-1].x, getmaxy-tab[mi-1].y);
end;
setcolor(4); { dodajemy }
moveto(tab[mi-1].x, getmaxy-tab[mi-1].y);
lineto(tab[p].x, getmaxy-tab[p].y);
tab[mi]:=tab[p];
end;
end;
tab[mi+1]:=tab[1]; { wartownik }
result:=mi; { w czapce jest mi punktow }
setcolor(1);
lineto(tab[1].x, getmaxy-tab[1].y);
setcolor(2);
lineto(tab[2].x, getmaxy-tab[2].y);
writeln('reszta ', (time-f)*24*60*60:0:3); f:=time;
end;
function dzwonek(z:longint):longint;
const n=3;
var i,s:longint;
begin
s:=0;
for i:=1 to n do
s:=s+random(z);
result:=s div n;
end;
var gd,gm:smallint;
begin
gd:=detect; initgraph(gd,gm,'');
for gd:=1 to 0000 do random(2);
writeln(max, ' punktow do otoczenia');
for gd:=1 to max do
with tab[gd] do begin
x:=dzwonek(getmaxx div 2-20)+10;
y:=dzwonek(getmaxy div 2-20)+10;
circle(x,getmaxy-y,2);
end;
gm:=ogrodzenie;
writeln('Zostalo ', gm,' punkt˘w.');
setcolor(5);
for gd:=1 to gm do begin
setcolor(5); fillellipse(tab[gd].x, getmaxy-tab[gd].y, 5, 5);
setcolor(7); circle(tab[gd].x, getmaxy-tab[gd].y, 2);
end;
readln;
end.
0
Amagad, ale bajerow dorzuciles ^^ Thx, wymiatasz :* Pytanie: czego uzyles z unitu "sysutils"? Nigdy nie uzywalem tego, wlasnie przegladam procedurki w nim zawarte, ale tego jest sporo. Heh, dopiero teraz zauwazylem, ze faktycznie tylko znak jest wazny :| I o co kaman z tymi tygrysami? xD
Btw. lubie babelki :]
0
Sysutils.time
Zadanie można sformułować tak: na łące śpią tygrysy, jak zbudować najkrótszy płot którym można je ogrodzić?
0
Uhh, brakowalo zmiennych do zwracania wartosci funkcji w 4 miejsach, ale nawet po dopisaniu w odpowiednich typach jedyne co otrzymalem to kilkadziesiat punktow i dwie polproste przechodzace przez srodek a w cmd: "zostalo -255 puntkow". Szukam bledu, ale nie moge znalezc, moglbys jeszcze rzucic okiem?
0
W Pascalu gdy funkcja powiedzmy FUN zwaraca pewną wartość piszemy w jej ciele FUN:=....., chyba od czasów Delphi wartość zwracana przez funkcję to zmienna RESULT tego samego typu co typ funkcji.
Zamiast function rozw(p,q,j:tp):real;
begin {iloczyn wektorowy, waľny tylko znak, kĄt mi©dzy QP a QJ}
result:= (p.x-q.x)(j.y-q.y) -
(p.y-q.y)(j.x-q.x)
end;
Napisz` function rozw(p,q,j:tp):real`code> Napisz` function rozw(p,q,j:tp):real;
begin {iloczyn wektorowy, waľny tylko znak, kĄt mi©dzy QP a QJ}
rozw:= (p.x-q.x)*(j.y-q.y) -
(p.y-q.y)*(j.x-q.x)
end;