Listing: HIGH.PAS const ni='input.txt'; no='output.txt'; mare=1000000.0; type punct=record x,y:Longint; mal:Byte end; list=array[1..4000] of Integer; listp=array[1..4000] of punct; var p:listp; q:^listp; t:list; i,j,k,l,m,n,e,f:Longint; tg,u,ctg,st,dr,ust,udr:Real; procedure citeste; begin Assign(input,ni); Reset(input); Readln(m,n); for i:=1 to m do with p[i] do begin Readln(x,y); mal:=1 end; for i:=m+1 to m+n do with p[i] do begin Readln(x,y); mal:=2 end end; procedure QuickSort(var A:List; Lo,Hi:Integer); procedure Sort(l,r:Integer); var i,j,x,y:Integer; begin i:=l; j:=r; x:=a[(l+r) div 2]; repeat while p[a[i]].y<p[x].y do Inc(i); while p[x].y<p[a[j]].y do Dec(j); if i<=j then begin y:=a[i]; a[i]:=a[j]; a[j]:=y; i:=i+1; j:=j-1 end until i>j; if l<j then Sort(l,j); if i<r then Sort(i,r) end; begin Sort(Lo,Hi) end; procedure gaseste(k,l:Integer); var e,f:Integer; begin if k=l-1 then begin t[k]:=l; Exit end; if p[k].x=p[l].x then u:=Pi/2 else begin tg:=(p[l].y-p[k].y)/(p[l].x-p[k].x); u:=Arctan(tg); if u<0 then u:=u+Pi end; st:=-mare; e:=0; dr:=mare; f:=0; for i:=k+1 to l-1 do if p[k].y<>p[i].y then begin ctg:=(p[i].x-p[k].x)/(p[i].y-p[k].y); if p[i].mal=1 then begin if ctg>=st then begin st:=ctg; e:=i end; end else if ctg<=dr then begin dr:=ctg; f:=i end end; if e=0 then ust:=Pi else if st=0 then ust:=Pi/2 else begin ust:=Arctan(1/st); if ust<0 then ust:=ust+Pi end; if f=0 then udr:=0 else if dr=0 then udr:=Pi/2 else begin udr:=Arctan(1/dr); if udr<0 then udr:=udr+Pi; end; if (ust>=u) and (udr<=u) then t[k]:=l else if ust>=u then begin gaseste(k,f); gaseste(f,l) end else if udr<=u then begin gaseste(k,e); gaseste(e,l) end else if e<f then begin gaseste(k,e); gaseste(e,l) end else begin gaseste(k,f); gaseste(f,l) end end; procedure rezolva; begin for i:=1 to m+n do t[i]:=i; quicksort(t,1,m+n); if t[2]=1 then begin t[2]:=t[1]; t[1]:=1 end; if t[m+n]<>m+n-1 then begin t[m+n-1]:=t[m+n]; t[m+n]:=m+n end; New(q); for i:=1 to m+n do q^[i]:=p[t[i]]; p:=q^; Dispose(q); gaseste(1,m+n); t[m+n]:=0; end; procedure scrie; begin Assign(output,no); Rewrite(output); i:=1; while i>0 do begin Writeln(p[i].x,' ',p[i].y); i:=t[i] end end; Begin citeste; rezolva; scrie End. [cuprins] |