Cod sursa(job #40966)

Utilizator andrewgPestele cel Mare andrewg Data 27 martie 2007 21:17:37
Problema Regiuni Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.4 kb
const maxn = 1001;

type punct = record
        x,y:longint;
     end;
     dreapta = record
        a,b,c:longint;
     end;

var f:text;
    n,m,i,j,k,sol,n1,n2:longint;
    p:array[1..maxn]of punct;
    d:array[1..maxn]of dreapta;
    a,c,c1,c2:array[1..maxn]of longint;

procedure readdata;
begin
   assign(f,'regiuni.in');
   reset(f);
   readln(f,n,m);
   for i:=1 to n do
   begin
      readln(f,d[i].a,d[i].b,d[i].c);
   end;
   for i:=1 to m do
   begin
      c[i]:=i;
      readln(f,p[i].x,p[i].y);
   end;
   close(f);
end;

procedure sort(l,r:longint);
var i,j,p,q:longint;
begin
   i:=l;
   j:=r;
   p:=a[(l+r) div 2];
   repeat
      while a[i]<p do i:=i+1;
      while p<a[j] do j:=j-1;
      if i<=j then
      begin
         q:=a[i];
         a[i]:=a[j];
         a[j]:=q;
         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;

function semn(j:longint):integer;
begin
   if ((d[i].a*p[j].x)+(d[i].b*p[j].y)+d[i].c<=0) then semn:=0
                                                  else semn:=1;
end;

procedure solve(x,y:longint);
begin
   n1:=0;
   n2:=0;
   for j:=x to y do
   begin
      if semn(c[j])=0 then
      begin
         inc(n1);
         c1[n1]:=c[j];
      end
         else
      begin
         inc(n2);
         c2[n2]:=c[j];
      end;
   end;
   if n1<n2 then
   begin
      if n1<>0 then
      begin
         inc(sol);
         a[sol]:=x+n1-1;
         if a[sol]=x-1 then dec(sol);
      end;
   end
      else
   begin
      if n2<>0 then
      begin
         inc(sol);
         a[sol]:=x+n2-1;
      end;
   end;
   if sol<>0 then sort(1,sol);
   for j:=1 to n1 do
   begin
      c[x+j-1]:=c1[j];
   end;
   for j:=1 to n2 do
   begin
      c[x+n1+j-1]:=c2[j];
   end;
end;

procedure rez;
var j:longint;
begin
   sol:=0;
   i:=1;
   solve(1,m);
   for i:=2 to n do
   begin
      if (a[1]<>1) and (a[1]<>0) then solve(1,a[1]);
      for j:=1 to sol-1 do
      begin
         if a[j]+1<>a[j+1] then solve(a[j]+1,a[j+1]);
      end;
      if sol<>0 then solve(a[sol]+1,m);
      if a[1]=0 then solve(1,m);
   end;
end;

procedure writedata;
begin
   assign(f,'regiuni.out');
   rewrite(f);
   if sol<>0 then writeln(f,sol+1)
             else writeln(f,sol);
   close(f);
end;

begin
   readdata;
   rez;
   writedata;
end.