Informatika gyűjtemény

Egy szinttel feljebb pt_nyak.pas

2004050607080910

<<  4. óra  >>

<<  NYÁK  >>

NézetNyomtat

pt_nyak.pas (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: utf-8
Méret: 2 KB
{$I+}{$R+}{$Q+}
program nyak;
const   maxN  = 10001;
        
type  TPont   = record
                  x,y:integer;
                end;
      TPontok = array[1..maxN]of TPont;

var   N:integer;
      p:TPontok;
      
function fir(P0,P1,P2:TPont):integer;
{Kimenet: +1 ha P1-P2 balra fordul,
0 ha P0,P1 és P2 kollineárisak,
-1 ha P1-P2 jobbra fordul.}
var xmul:Longint;
begin
  xmul:=(longint(P1.x)-longint(P0.x))*(longint(P2.y)-longint(P0.y))-(longint(P2.x)-longint(P0.x))*(longint(P1.y)-longint(P0.y));
  if xmul < 0 then
    fir:=-1
  else if xmul > 0 then
    fir:=1
  else
    fir:=0;
end;     

procedure load;
var be:text;
    i:integer;
begin
  assign(be,paramstr(1));
  reset(be);
  readln(be,N);
  for i:=1 to N do
    begin
      readln(be,P[i].x,P[i].y);
    end;
  P[N+1]:=P[1]; 
  close(be);
  //writeln(n);
end;


function ottvan(q,p:TPont):boolean;
begin
  ottvan:=(p.y=q.y)and(p.x>q.x);
end;

function szakaszon(p1,p2,q:TPont):boolean;
begin
  Szakaszon:= (fir(p1,p2,q)=0) And
              (Abs(P1.x-Q.x)<=Abs(P2.x-P1.x)) And
              (Abs(P2.x-Q.x)<=Abs(P2.x-P1.x)) And
              (Abs(P1.y-Q.y)<=Abs(P2.y-P1.y)) And
              (Abs(P2.y-Q.y)<=Abs(P2.y-P1.y));
end;

function metsz(p1,p2,p3,p4:TPont):boolean;
begin
  metsz:=(fir(p1,p2,p3)*fir(p1,p2,p4) = -1)and(fir(p3,p4,p1)*fir(p3,p4,p2)=-1);
end;

function belso(q:TPont):boolean;
var max:integer;
    i:integer;
    q0:TPont;
    ps:boolean;
begin                                                        //   ->
  max:=1;                                                    //  |  q0:jobbra van
  for i:=2 to N do if p[max].x<p[i].x then max:=i;           //  v
  q0.x:=p[max].x+1;
  q0.y:=q.y;
  ps:=true;
  for i:=1 to N do
    if szakaszon(p[i],p[i+1],q) then ps:=false;
  if ps then
    begin
      for i:=1 to N do
      begin
        //ez most az éleken megy
        if metsz(q,q0,p[i],p[i+1]) then ps:=not(ps);
        //ez meg a pontokon
        if ottvan(q,p[i])and(not(ottvan(q,p[i-1]))) then //azaz p[i] rajta van, de p[i-1] nincs
          begin
            if not(ottvan(q,p[i+1])) then
              ps:=(((p[i-1].y)-q.y)*(p[i+1].y-q.y)<0)xor ps
            else
              ps:=(((p[i-1].y)-q.y)*(p[i+2].y-q.y)<0)xor ps;
          end;
      end;
    end;
   belso:=not(ps);   
end;


var q:TPont;
    vege,res:boolean;
begin
  load;
  repeat
    {$I-}readln(q.x,q.y);{$I+}
    vege:= (ioresult<>0);
    if not(vege) then
      begin
        res:=belso(q);
        if res then writeln('IGEN') else writeln('NEM');
      end; 
  until vege;   
end.of.program
(Vissza)