Cod sursa(job #1539001)

Utilizator uchihamxbMai Xuan Bach uchihamxb Data 30 noiembrie 2015 04:20:29
Problema Barbar Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.91 kb
{$H+}
Uses  math;
Const tfi='BARBAR.in';
      tfo='BARBAR.out';
      rr:array[1..4]of longint=(-1,0,1,0);
      cc:array[1..4]of longint=(0,-1,0,1);
Var   r,c,nh,mx,my,lq,rq,x1,x2,y1,y2:longint;
      a,dd,d,pos:array[1..1000,1..1000]of longint;
      hx,hy,qx,qy:array[1..1000000]of longint;
      free:array[1..1000,1..1000]of boolean;
Procedure swap(Var x,y:longint);
    Var mid:longint;
    Begin
        mid:=x; x:=y; y:=mid;
    End;
Procedure up(i:longint);
    Begin
        If (i=1) or (dd[hx[i],hy[i]]<=dd[hx[i div 2],hy[i div 2]]) then Exit;
        swap(hx[i],hx[i div 2]);
        swap(hy[i],hy[i div 2]);
        swap(pos[hx[i],hy[i]],pos[hx[i div 2],hy[i div 2]]);
        up(i div 2);
    End;
Procedure down(i:longint);
    Var j:longint;
    Begin
        j:=2*i;
        If (j>nh) then Exit;
        If (j<nh) and (dd[hx[j],hy[j]]<dd[hx[j+1],hy[j+1]]) then inc(j);
        If dd[hx[i],hy[i]]<dd[hx[j],hy[j]] then
            Begin
                swap(hx[i],hx[j]);
                swap(hy[i],hy[j]);
                swap(pos[hx[i],hy[i]],pos[hx[j],hy[j]]);
                down(j);
            End;
    End;
Procedure push(x,y:longint);
    Begin
        inc(nh);
        hx[nh]:=x; hy[nh]:=y;
        pos[x,y]:=nh;
        up(nh);
    End;
Procedure pop;
    Begin
        mx:=hx[1]; my:=hy[1];
        hx[1]:=hx[nh]; hy[1]:=hy[nh];
        pos[hx[1],hy[1]]:=1;
        dec(nh);
        down(1);
    End;
Procedure process;
    Var i,j,u,v,uu,vv:longint;
        st:string;
    Begin
        Readln(r,c); lq:=1; rq:=0;
        For i:=1 to r do
            Begin
                Readln(st);
                For j:=1 to c do
                    If st[j]='I' then
                        Begin
                            x1:=i; y1:=j;
                        End
                    Else
                        If st[j]='O' then
                            Begin
                                x2:=i; y2:=j;
                            End
                        Else
                            If st[j]='*' then a[i,j]:=1
                            Else
                                If st[j]='D' then
                                    Begin
                                        inc(rq); qx[rq]:=i; qy[rq]:=j;
                                        a[i,j]:=2;
                                    End;
            End;
        While lq<=rq do
            Begin
                u:=qx[lq]; v:=qy[lq]; inc(lq);
                For i:=1 to 4 do
                    Begin
                        uu:=u+rr[i]; vv:=v+cc[i];
                        If (uu<=r) and (vv<=c) and (uu>=1) and (vv>=1) then
                            If (d[uu,vv]=0) and (a[uu,vv]<>2) and (a[uu,vv]<>1) then
                                Begin
                                    d[uu,vv]:=d[u,v]+1;
                                    inc(rq); qx[rq]:=uu; qy[rq]:=vv;
                                End;
                    End;
            End;
        dd[x1,y1]:=d[x1,y1];
        push(x1,y1);
        Repeat
            pop;
            If (mx=x2) and (my=y2) then Break;
            free[mx,my]:=true;
            For i:=1 to 4 do
                Begin
                    uu:=mx+rr[i]; vv:=my+cc[i];
                    If (uu<=r) and (vv<=c) and (uu>=1) and (vv>=1) then
                        If (a[uu,vv]<>2) and (a[uu,vv]<>1) and (free[uu,vv]=false) and (dd[uu,vv]<min(dd[mx,my],d[uu,vv])) then
                            Begin
                                dd[uu,vv]:=min(dd[mx,my],d[uu,vv]);
                                If pos[uu,vv]=0 then push(uu,vv) Else up(pos[uu,vv]);
                            End;
                End;
        Until nh=0;
        If dd[x2,y2]=0 then Write(-1) Else Write(dd[x2,y2]);
    End;
BEGIN
    Assign(input,tfi); Reset(input);
    Assign(output,tfo); Rewrite(output);
        process;
    Close(input); Close(output);
END.