NKGUARD - Bảo vệ nông trang

Tác giả: ll931110

Ngôn ngữ: Pascal

Program NKGUARD;
        Type
                rec = record
                        x,y: longint;
                end;
        Const
                input  = '';
                output = '';
        Var
                      d: array[0..701,0..701] of longint;
                      a: array[0..701,0..701] of boolean;
                  dx,dy: array[1..8] of longint;
                  queue: array[1..50000] of rec;
              n,m,count: longint;

Procedure init;
          Var
                  f: text;
                i,j: longint;
          Begin
                Assign(f, input);
                        Reset(f);

                Readln(f, n, m);
                For i:= 1 to n do
                    For j:= 1 to m do read(f, d[i,j]);

                Close(f);
                Fillchar(a, sizeof(a), true);

                For i:= 0 to n + 1 do
                        Begin
                                d[i,0]:= -1;
                                d[i,m + 1]:= -1;
                        End;

                For i:= 0 to m + 1 do
                        Begin
                                d[0,i]:= -1;
                                d[n + 1,i]:= -1;
                        End;
          End;

Procedure enter;
          Begin
                dx[1]:= -1;             dy[1]:= -1;
                dx[2]:= -1;             dy[2]:= 0;
                dx[3]:= -1;             dy[3]:= 1;
                dx[4]:= 0;              dy[4]:= 1;
                dx[5]:= 1;              dy[5]:= 1;
                dx[6]:= 1;              dy[6]:= 0;
                dx[7]:= 1;              dy[7]:= -1;
                dx[8]:= 0;              dy[8]:= -1;
          End;

Procedure BFS(p,q: longint);
          Var
                  front,rear: longint;
                   u,v,i,j,k: longint;
                         top: boolean;
          Begin
                top:= true;

                front:= 1;      rear:= 1;
                queue[1].x:= p;         queue[1].y:= q;

                Repeat
                        u:= queue[front].x;
                        v:= queue[front].y;
                        inc(front);
                        a[u,v]:= false;

                        For k:= 1 to 8 do
                                Begin
                                        i:= u;
                                        j:= v;

                                        While d[i,j] = d[u,v] do
                                                Begin
                                                        i:= i + dx[k];
                                                        j:= j + dy[k];

                                                        If (d[i,j] = d[u,v]) and a[i,j] then
                                                                Begin
                                                                        inc(rear);
                                                                        queue[rear].x:= i;
                                                                        queue[rear].y:= j;
                                                                        a[i,j]:= false;
                                                                End;
                                                End;

                                        If d[i,j] > d[u,v] then top:= false;
                                End;
                Until front > rear;

                If top then inc(count);
          End;

Procedure solve;
          Var
                i,j: longint;
                  f: text;
          Begin
                count:= 0;
                For i:= 1 to n do
                    For j:= 1 to m do if a[i,j] then BFS(i,j);

                Assign(f, output);
                        Rewrite(f);
                        Writeln(f, count);
                Close(f);
          End;

Begin
        init;
        enter;
        solve;
End.

Download