MLASERP - Laser Phones

Tác giả: ll931110

Ngôn ngữ: Pascal

Program MLASERP;
        Type
                rec = record
                        x: integer;
                        y: integer;
                end;
        Const
                input  = '';
                output = '';
        Var
                        a: array[0..101,0..101] of boolean;
                        d: array[1..100,1..100] of longint;
                    queue: array[1..20000] of rec;
                    dx,dy: array[1..4] of longint;
          h,w,sx,sy,fx,fy: longint;
               front,rear: longint;
                    check: boolean;
                      num: longint;

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

                Fillchar(a, sizeof(a), false);
                Readln(f, w, h);
                count:= 0;

                For i:= 1 to h do
                    Begin
                        For j:= 1 to w do
                                Begin
                                        Read(f, ch);
                                        If ch = '.' then a[i,j]:= true
                                   else if ch = 'C' then
                                        Begin
                                                inc(count);
                                                if count = 1 then
                                                        Begin
                                                                sx:= i;
                                                                sy:= j;
                                                        End;
                                                If count = 2 then
                                                        Begin
                                                                fx:= i;
                                                                fy:= j;
                                                        End;
                                                a[i,j]:= true;
                                        End;
                                End;
                                Readln(f);
                        End;

                Close(f);
          End;

Procedure gens;
          Begin
                dx[1]:= -1;     dx[2]:= 0;      dx[3]:= 1;      dx[4]:= 0;
                dy[1]:= 0;      dy[2]:= 1;      dy[3]:= 0;      dy[4]:= -1;
          End;

Procedure BFS;
          Var
                           rearc: longint;
                     u,v,k,m,n,i: longint;
          Begin
                rearc:= rear;
                For i:= front to rearc do
                    Begin
                         u:= queue[i].x;
                         v:= queue[i].y;

                         For k:= 1 to 4 do
                             Begin
                                   m:= u + dx[k];
                                   n:= v + dy[k];

                                   While a[m,n] do
                                         Begin
                                              If d[m,n] = -1 then
                                                 Begin
                                                      d[m,n]:= num;
                                                      inc(rear);
                                                      queue[rear].x:= m;
                                                      queue[rear].y:= n;

                                                      If (m = fx) and (n = fy) then
                                                        Begin
                                                                check:= false;
                                                                exit;
                                                        End;
                                                 End;

                                              m:= m + dx[k];
                                              n:= n + dy[k];
                                         End;
                             End;
                    End;

                front:= rearc + 1;
          End;

Procedure solve;
          Var
                  f: text;
                i,j: longint;
          Begin
                For i:= 1 to h do
                    For j:= 1 to w do d[i,j]:= -1;

                d[sx,sy]:= 0;
                check:= true;

                front:= 1;      rear:= 1;
                queue[1].x:= sx;        queue[1].y:= sy;

                num:= 0;
                While check do
                        Begin
                                BFS;
                                inc(num);
                        End;

                Assign(f, output);
                        Rewrite(f);
                        Writeln(f, d[fx,fy]);
                Close(f);
          End;

Begin
        init;
        gens;
        solve;
End.

Download