Discussion @ 1147. Shaping Regions @ Timus Online Judge

My alogorythm is O(n^2*log n), and I get Time Limit. Could anyone help me ? (+)

Posted by shitty.Mishka 24 Jan 2002 16:35

Here's my program:
Program ShapingRegions;
Const Max=1000;MaxB=10000; MaxC=2500;
Type TRec=Record
       X1,Y1,X2,Y2,C:Longint;
      End;
Var a,b,n,i:Longint;
     r:Array[0..Max] Of TRec;
     cy,cx,dy,dx:Array[1..3*Max] Of Longint;
     nx,ny:Longint;
     hy:Array[1..MaxB] Of Boolean;
     nc:Array[1..MaxC] Of Longint;
     lasty,lastx:Longint;
     pres:Array[0..Max] Of Longint;
     pr,pl:Array[0..Max+5] Of Longint;
     co,cp,ac,ad:Array[1..3*Max] Of Longint;
     hx:Array[0..3*Max] Of Boolean;
Procedure ReadData;
Var i:Longint;
Begin
Read(a,b,n);
With r[0] Do Begin
   x1:=0;
   y1:=0;
   x2:=a;
   y2:=b;
   c:=1;
End;
For i:=1 To n Do
   With r[i] Do
    Read(x1,y1,x2,y2,c);
End;
Procedure AddY(y:Longint);
Begin
If ((y>=1) And (y<=b)) Then
   If Not hy[y] Then Begin
    hy[y]:=True;
    Inc(ny);
    cy[ny]:=y;
   End;
End;
Procedure SortY(x,y:Longint);
Var z:Longint;
Procedure Merge;
   Var p,p1,p2:Longint;
Begin
   p1:=x; p2:=z+1; p:=0;
   While ((p1<=z) Or (p2<=y)) Do Begin
    Inc(p);
    If p1<=z Then Begin
     dy[p]:=cy[p1];
     Inc(p1);
     If p2<=y Then
      If cy[p2]<dy[p] Then Begin
       dy[p]:=cy[p2];
       Inc(p2);
       Dec(p1);
      End;
    End Else Begin
     dy[p]:=cy[p2];
     Inc(p2);
    End;
   End;
   For p:=x To y Do
    cy[p]:=dy[p-x+1];
End;
Begin
If x<y Then Begin
   z:=(x + y) Div 2;
   SortY(x,z);
   SortY(z+1,y);
   Merge;
End;
End;
Procedure SortX(x,y:Longint);
Var z:Longint;
Procedure Merge;
   Var p,p1,p2:Longint;
Begin
   p1:=x; p2:=z+1; p:=0;
   While ((p1<=z) Or (p2<=y)) Do Begin
    Inc(p);
    If p1<=z Then Begin
     dx[p]:=cx[p1];
     cp[p]:=co[p1];
     ad[p]:=ac[p1];
     Inc(p1);
     If p2<=y Then
      If cx[p2]<dx[p] Then Begin
       dx[p]:=cx[p2];
       cp[p]:=co[p2];
       ad[p]:=ac[p2];
       Inc(p2);
       Dec(p1);
      End;
    End Else Begin
     dx[p]:=cx[p2];
     cp[p]:=co[p2];
     ad[p]:=ac[p2];
     Inc(p2);
    End;
   End;
   For p:=x To y Do Begin
    cx[p]:=dx[p-x+1];
    co[p]:=cp[p-x+1];
    ac[p]:=ad[p-x+1];
   End;
End;
Begin
If x<y Then Begin
   z:=(x + y) Div 2;
   SortX(x,z);
   SortX(z+1,y);
   Merge;
End;
End;
Procedure AddX(x,act,col:Longint);
Begin
If ((x>=0) And (x<=a)) Then Begin
   Inc(nx);
   cx[nx]:=x;
   co[nx]:=col;
   ac[nx]:=act;
End;
End;
Procedure SolveLine(y,k:Longint);
Var i:Longint;
Function First:Longint;
   Var x,y,z:Longint;
Begin
   x:=0;
   y:=n;
   Repeat
    z:=(x+y) Div 2;
    If pr[z]>0 Then
     x:=z
    Else If pres[z]>0 Then Begin
     First:=z;
     Exit;
    End Else
     y:=z;
   Until y-x<=1;
   If pres[y]>0 Then
    First:=y
   Else If pres[x]>0 Then
    First:=x
End;
Procedure Add(v:Longint);
   Var x,y,z:Longint;
Begin
   Inc(pres[v]);
   x:=0;
   y:=n;
   Repeat
    z:=(x+y) Div 2;
    If z=v Then
     Exit;
    If v>z Then Begin
     Inc(pr[z]);
     x:=z;
    End Else Begin
     Inc(pl[z]);
     y:=z;
    End;
   Until y-x<=1;
End;
Procedure Del(v:Longint);
   Var x,y,z:Longint;
Begin
   Dec(pres[v]);
   x:=0;
   y:=n;
   Repeat
    z:=(x+y) Div 2;
    If z=v Then
     Exit;
    If v>z Then Begin
     Dec(pr[z]);
     x:=z;
    End Else Begin
     Dec(pl[z]);
     y:=z;
    End;
   Until y-x<=1;
End;
Begin
nx:=0;
For i:=0 To n Do
   With r[i] Do
   If ((y1<y) And (y2>=y)) Then Begin
    AddX(x1,1,i);
    AddX(x2,0,i);
   End;
SortX(1,nx);
lastx:=0;
FillChar(hx,SizeOf(hx),False);
FillChar(pres,SizeOf(pres),0);
lastx:=0;
hx[0]:=True;
For i:=1 To nx Do Begin
   If Not hx[cx[i]] Then
    Inc(nc[r[First].C],k*(cx[i]-lastx));

Re: My alogorythm is O(n^2*log n), and I get Time Limit. Could anyone help me ? (+)

Posted by Tran Nam Trung (trungduck@yahoo.com) 24 Jan 2002 20:17

> Here's my program:
> Program ShapingRegions;
> Const Max=1000;MaxB=10000; MaxC=2500;
> Type TRec=Record
>        X1,Y1,X2,Y2,C:Longint;
>       End;
> Var a,b,n,i:Longint;
>      r:Array[0..Max] Of TRec;
>      cy,cx,dy,dx:Array[1..3*Max] Of Longint;
>      nx,ny:Longint;
>      hy:Array[1..MaxB] Of Boolean;
>      nc:Array[1..MaxC] Of Longint;
>      lasty,lastx:Longint;
>      pres:Array[0..Max] Of Longint;
>      pr,pl:Array[0..Max+5] Of Longint;
>      co,cp,ac,ad:Array[1..3*Max] Of Longint;
>      hx:Array[0..3*Max] Of Boolean;
> Procedure ReadData;
>   Var i:Longint;
> Begin
>   Read(a,b,n);
>   With r[0] Do Begin
>    x1:=0;
>    y1:=0;
>    x2:=a;
>    y2:=b;
>    c:=1;
>   End;
>   For i:=1 To n Do
>    With r[i] Do
>     Read(x1,y1,x2,y2,c);
> End;
> Procedure AddY(y:Longint);
> Begin
>   If ((y>=1) And (y<=b)) Then
>    If Not hy[y] Then Begin
>     hy[y]:=True;
>     Inc(ny);
>     cy[ny]:=y;
>    End;
> End;
> Procedure SortY(x,y:Longint);
>   Var z:Longint;
>   Procedure Merge;
>    Var p,p1,p2:Longint;
>   Begin
>    p1:=x; p2:=z+1; p:=0;
>    While ((p1<=z) Or (p2<=y)) Do Begin
>     Inc(p);
>     If p1<=z Then Begin
>      dy[p]:=cy[p1];
>      Inc(p1);
>      If p2<=y Then
>       If cy[p2]<dy[p] Then Begin
>        dy[p]:=cy[p2];
>        Inc(p2);
>        Dec(p1);
>       End;
>     End Else Begin
>      dy[p]:=cy[p2];
>      Inc(p2);
>     End;
>    End;
>    For p:=x To y Do
>     cy[p]:=dy[p-x+1];
>   End;
> Begin
>   If x<y Then Begin
>    z:=(x + y) Div 2;
>    SortY(x,z);
>    SortY(z+1,y);
>    Merge;
>   End;
> End;
> Procedure SortX(x,y:Longint);
>   Var z:Longint;
>   Procedure Merge;
>    Var p,p1,p2:Longint;
>   Begin
>    p1:=x; p2:=z+1; p:=0;
>    While ((p1<=z) Or (p2<=y)) Do Begin
>     Inc(p);
>     If p1<=z Then Begin
>      dx[p]:=cx[p1];
>      cp[p]:=co[p1];
>      ad[p]:=ac[p1];
>      Inc(p1);
>      If p2<=y Then
>       If cx[p2]<dx[p] Then Begin
>        dx[p]:=cx[p2];
>        cp[p]:=co[p2];
>        ad[p]:=ac[p2];
>        Inc(p2);
>        Dec(p1);
>       End;
>     End Else Begin
>      dx[p]:=cx[p2];
>      cp[p]:=co[p2];
>      ad[p]:=ac[p2];
>      Inc(p2);
>     End;
>    End;
>    For p:=x To y Do Begin
>     cx[p]:=dx[p-x+1];
>     co[p]:=cp[p-x+1];
>     ac[p]:=ad[p-x+1];
>    End;
>   End;
> Begin
>   If x<y Then Begin
>    z:=(x + y) Div 2;
>    SortX(x,z);
>    SortX(z+1,y);
>    Merge;
>   End;
> End;
> Procedure AddX(x,act,col:Longint);
> Begin
>   If ((x>=0) And (x<=a)) Then Begin
>    Inc(nx);
>    cx[nx]:=x;
>    co[nx]:=col;
>    ac[nx]:=act;
>   End;
> End;
> Procedure SolveLine(y,k:Longint);
>   Var i:Longint;
>   Function First:Longint;
>    Var x,y,z:Longint;
>   Begin
>    x:=0;
>    y:=n;
>    Repeat
>     z:=(x+y) Div 2;
>     If pr[z]>0 Then
>      x

Thank you, but I changed my program to use sweep by verticals, and it still get Time Limit! Maybe something's wrong in my code so it's not n^2 log n ?

Posted by shitty.Mishka 24 Jan 2002 21:20

Here's my new code:
Program ShapingRegions;
Const Max=1000;MaxB=10000; MaxC=2500;
Type TRec=Record
       X1,Y1,X2,Y2,C,ID:Longint;
      End;
Var a,b,n,i:Longint;
     r1,r,q:Array[0..Max] Of TRec;
     cy,cx,dy,dx:Array[1..3*Max] Of Longint;
     nx,ny:Longint;
     hy:Array[1..MaxB] Of Boolean;
     nc:Array[1..MaxC] Of Longint;
     lasty,lastx:Longint;
     pres:Array[0..Max] Of Longint;
     pr,pl:Array[0..Max+5] Of Longint;
     co,cp,ac,ad:Array[1..3*Max] Of Longint;
     hx:Array[0..3*Max] Of Boolean;
Procedure ReadData;
Var i:Longint;
Begin
Read(b,a,n);
With r[0] Do Begin
   x1:=0;
   y1:=0;
   x2:=a;
   y2:=b;
   c:=1;
   id:=0;
End;
For i:=1 To n Do
   With r[i] Do Begin
    Read(y1,x1,y2,x2,c);
    id:=i;
   End;
Move(r,r1,SizeOf(r1));
End;
Procedure AddY(y:Longint);
Begin
If ((y>=1) And (y<=b)) Then
   If Not hy[y] Then Begin
    hy[y]:=True;
    Inc(ny);
    cy[ny]:=y;
   End;
End;
Procedure Sort(x,y:Longint);
Var z:Longint;
Procedure Merge;
   Var p,p1,p2:Longint;
Begin
   p1:=x; p2:=z+1; p:=0;
   While ((p1<=z) Or (p2<=y)) Do Begin
    Inc(p);
    If p1<=z Then Begin
     q[p]:=r[p1];
     Inc(p1);
     If p2<=y Then
      If r[p2].y1<q[p].y1 Then Begin
       q[p]:=r[p2];
       Inc(p2);
       Dec(p1);
      End;
    End Else Begin
     q[p]:=r[p2];
     Inc(p2);
    End;
   End;
   For p:=x To y Do
    r[p]:=q[p-x+1];
End;
Begin
If x<y Then Begin
   z:=(x + y) Div 2;
   Sort(x,z);
   Sort(z+1,y);
   Merge;
End;
End;
Procedure SortBack(x,y:Longint);
Var z:Longint;
Procedure Merge;
   Var p,p1,p2:Longint;
Begin
   p1:=x; p2:=z+1; p:=0;
   While ((p1<=z) Or (p2<=y)) Do Begin
    Inc(p);
    If p1<=z Then Begin
     q[p]:=r[p1];
     Inc(p1);
     If p2<=y Then
      If r[p2].id<q[p].id Then Begin
       q[p]:=r[p2];
       Inc(p2);
       Dec(p1);
      End;
    End Else Begin
     q[p]:=r[p2];
     Inc(p2);
    End;
   End;
   For p:=x To y Do
    r[p]:=q[p-x+1];
End;
Begin
If x<y Then Begin
   z:=(x + y) Div 2;
   Sort(x,z);
   Sort(z+1,y);
   Merge;
End;
End;
Procedure SortY(x,y:Longint);
Var z:Longint;
Procedure Merge;
   Var p,p1,p2:Longint;
Begin
   p1:=x; p2:=z+1; p:=0;
   While ((p1<=z) Or (p2<=y)) Do Begin
    Inc(p);
    If p1<=z Then Begin
     dy[p]:=cy[p1];
     Inc(p1);
     If p2<=y Then
      If cy[p2]<dy[p] Then Begin
       dy[p]:=cy[p2];
       Inc(p2);
       Dec(p1);
      End;
    End Else Begin
     dy[p]:=cy[p2];
     Inc(p2);
    End;
   End;
   For p:=x To y Do
    cy[p]:=dy[p-x+1];
End;
Begin
If x<y Then Begin
   z:=(x + y) Div 2;
   SortY(x,z);
   SortY(z+1,y);
   Merge;
End;
End;
Procedure SortX(x,y:Longint);
Var z:Longint;
Procedure Merge;
   Var p,p1,p2:Longint;
Begin
   p1:=x; p2:=z+1; p:=0;
   While ((p1<=z) Or (p2<=y)) Do Begin
    Inc(p);
    If p1<=z Then Begin
     dx[p]:=cx[p1];
     cp[p]:=co[p1];
     ad[p]:=ac[p1];
     Inc(p1);
     If p2<=y Then
      If cx[p2]<dx[p] Then Begin
       dx[p]:=cx[p2];
       cp[p]:=co[p2];
       ad[p]:=ac[p2];
       Inc(p2);
       Dec(p1);
      End;
    End Else Begin
     dx[p]:=cx[p2];
     cp[p]:=co[p2];
     ad[p]:=ac[p2];
     Inc(p2);
    End;
   End;
   For p:=x To y Do Begin
    cx[p]:=dx[p-x+1];
    co[p]:=cp[p-x+1];
    ac[p]:=ad[p-x+1];
   End;
End;
Begin
If x<y Then Begin
   z:=(x + y) Div 2;
   SortX(x,z);
   SortX(z+1,y);
   Merge;
End;
End;
Procedure AddX(x,act,col:Longint);
Begin
If ((x>=0) And (x<=a)) Then Begin
   Inc(nx);
   cx[nx]:=x;
   co[nx]:=col;
   ac[nx]:=act;
End;
End;
Procedure SolveLine(y,k:Longint);
Var i:Longint;
Function F

Re: My alogorythm is O(n^2*log n), and I get Time Limit. Could anyone help me ? (+)

Posted by Alec 2 Feb 2002 02:19

Here is my code
i got AC in USACO but URAL
Is anybody can tell me why?

Program RECT1;
const
maxn=10000;
type
recttype=record lx,ly,rx,ry,c:integer; end;
var
save:array [1..maxn] of recttype;
color:array [0..2500] of longint;
k,mc:integer;

Function check (rd,ru:recttype):boolean;
begin
if ((rd.lx>=ru.rx) or (rd.rx<=ru.lx) or
     (rd.ly>=ru.ry) or (rd.ry<=ru.ly)) then check:=false else
check:=true;
end;

Procedure add (r:recttype;var u:integer; w:integer);
begin
if u=0 then begin save[w]:=r; u:=1; end
         else begin inc(k); save[k]:=r; end;
end;

Procedure cut (rd,ru:recttype;w:integer);
var
tem:recttype;
u:integer;
begin
u:=0;

if check (rd,ru) then
    if (ru.lx<=rd.lx) and (ru.ly<=rd.ly) and (ru.rx>=rd.rx) and
(ru.ry>=rd.ry) then save[w].c:=0 else
    begin
      if rd.lx<ru.lx then
      begin
        tem:=rd;
        tem.rx:=ru.lx;
        add (tem,u,w);
        rd.lx:=ru.lx;
      end;
      if rd.rx>ru.rx then
      begin
        tem:=rd;
        tem.lx:=ru.rx;
        add (tem,u,w);
        rd.rx:=ru.rx;
      end;
      if rd.ry>ru.ry then
      begin
        tem:=rd;
        tem.ly:=ru.ry;
        add (tem,u,w);
        rd.ry:=ru.ry;
      end;
      if rd.ly<ru.ly then
      begin
        tem:=rd;
        tem.ry:=ru.ly;
        add (tem,u,w);
        rd.ly:=ru.ly;
      end;
    end;
end;

Procedure solve;
var
i,n,i1,t:integer;
begin
k:=1; save[1].c:=1; mc:=0;

assign (input,'rect1.in'); reset (input);
readln (save[1].rx,save[1].ry,n);

for i:=1 to n do
begin
    inc(k);
    t:=k;
    with save[k] do begin readln (lx,ly,rx,ry,c); if c>mc then mc:=c;
end;
    for i1:=1 to k-1 do cut (save[i1],save[t],i1);
end;

close (input);
end;

Function area (a:recttype):longint;
begin
area:=abs((a.rx-a.lx)*(a.ly-a.ry));
end;

Procedure print;
var
i:integer;
begin
fillchar (color,sizeof(color),0);
for i:=1 to k do inc(color[save[i].c],area(save[i]));

assign (output,'rect1.out'); rewrite (output);
for i:=1 to mc do if color[i]>0 then writeln (i,' ',color[i]);
close (output);
end;

begin
solve;
print;
end.

Re: My alogorythm is O(n^2*log n), and I get Time Limit. Could anyone help me ? (+)

Posted by Marek Kiszkis 30 Sep 2002 22:38

> > Here's my program:
> > Program ShapingRegions;
> > Const Max=1000;MaxB=10000; MaxC=2500;
> > Type TRec=Record
> >        X1,Y1,X2,Y2,C:Longint;
> >       End;
> > Var a,b,n,i:Longint;
> >      r:Array[0..Max] Of TRec;
> >      cy,cx,dy,dx:Array[1..3*Max] Of Longint;
> >      nx,ny:Longint;
> >      hy:Array[1..MaxB] Of Boolean;
> >      nc:Array[1..MaxC] Of Longint;
> >      lasty,lastx:Longint;
> >      pres:Array[0..Max] Of Longint;
> >      pr,pl:Array[0..Max+5] Of Longint;
> >      co,cp,ac,ad:Array[1..3*Max] Of Longint;
> >      hx:Array[0..3*Max] Of Boolean;
> > Procedure ReadData;
> >   Var i:Longint;
> > Begin
> >   Read(a,b,n);
> >   With r[0] Do Begin
> >    x1:=0;
> >    y1:=0;
> >    x2:=a;
> >    y2:=b;
> >    c:=1;
> >   End;
> >   For i:=1 To n Do
> >    With r[i] Do
> >     Read(x1,y1,x2,y2,c);
> > End;
> > Procedure AddY(y:Longint);
> > Begin
> >   If ((y>=1) And (y<=b)) Then
> >    If Not hy[y] Then Begin
> >     hy[y]:=True;
> >     Inc(ny);
> >     cy[ny]:=y;
> >    End;
> > End;
> > Procedure SortY(x,y:Longint);
> >   Var z:Longint;
> >   Procedure Merge;
> >    Var p,p1,p2:Longint;
> >   Begin
> >    p1:=x; p2:=z+1; p:=0;
> >    While ((p1<=z) Or (p2<=y)) Do Begin
> >     Inc(p);
> >     If p1<=z Then Begin
> >      dy[p]:=cy[p1];
> >      Inc(p1);
> >      If p2<=y Then
> >       If cy[p2]<dy[p] Then Begin
> >        dy[p]:=cy[p2];
> >        Inc(p2);
> >        Dec(p1);
> >       End;
> >     End Else Begin
> >      dy[p]:=cy[p2];
> >      Inc(p2);
> >     End;
> >    End;
> >    For p:=x To y Do
> >     cy[p]:=dy[p-x+1];
> >   End;
> > Begin
> >   If x<y Then Begin
> >    z:=(x + y) Div 2;
> >    SortY(x,z);
> >    SortY(z+1,y);
> >    Merge;
> >   End;
> > End;
> > Procedure SortX(x,y:Longint);
> >   Var z:Longint;
> >   Procedure Merge;
> >    Var p,p1,p2:Longint;
> >   Begin
> >    p1:=x; p2:=z+1; p:=0;
> >    While ((p1<=z) Or (p2<=y)) Do Begin
> >     Inc(p);
> >     If p1<=z Then Begin
> >      dx[p]:=cx[p1];
> >      cp[p]:=co[p1];
> >      ad[p]:=ac[p1];
> >      Inc(p1);
> >      If p2<=y Then
> >       If cx[p2]<dx[p] Then Begin
> >        dx[p]:=cx[p2];
> >        cp[p]:=co[p2];
> >        ad[p]:=ac[p2];
> >        Inc(p2);
> >        Dec(p1);
> >       End;
> >     End Else Begin
> >      dx[p]:=cx[p2];
> >      cp[p]:=co[p2];
> >      ad[p]:=ac[p2];
> >      Inc(p2);
> >     End;
> >

Discussion of Problem 1147. Shaping Regions