All pastes #2493835 Raw Edit

kral

public unlisted text v1 · immutable
#2493835 ·published 2013-12-07 17:01 UTC
rendered paste body
program Kral;
type xy=record s1:byte;s2:byte;end;
  pojntr=^polozkafronty;
  polozkafronty=record souradnice:xy;hloubka:byte;dalsi:pojntr;end;
  moznosti=array[1..8] of xy;
var navst,fronta,prekazky:pojntr;

procedure vlozdoprekazek(a:xy);
var Q:pojntr;
begin
  new(Q);
  Q^.souradnice.s1:=a.s1;
  Q^.souradnice.s2:=a.s2;
  Q^.dalsi:=prekazky;
  prekazky:=Q;
end;

procedure vlozdonavst(b:xy);
var Q:pojntr;
begin
  new(Q);
  Q^.souradnice.s1:=b.s1;
  Q^.souradnice.s2:=b.s2;
  Q^.dalsi:=navst;
  navst:=Q;
end;

procedure vlozdofronty(c:xy;hl:byte);
var Q:pojntr;
begin
  new(Q);
  Q^.souradnice.s1:=c.s1;
  Q^.souradnice.s2:=c.s2;
  Q^.hloubka:=hl;
  Q^.dalsi:=fronta;
  fronta:=Q;
end;

function polepotomku(sour:xy):moznosti;
var pole:moznosti;i:integer;
begin
  pole[1].s1:=sour.s1-1;pole[1].s2:=sour.s2-1;
  pole[2].s1:=sour.s1;pole[2].s2:=sour.s2-1;
  pole[3].s1:=sour.s1+1;pole[3].s2:=sour.s2-1;
  pole[4].s1:=sour.s1-1;pole[4].s2:=sour.s2;
  pole[5].s1:=sour.s1+1;pole[5].s2:=sour.s2;
  pole[6].s1:=sour.s1-1;pole[6].s2:=sour.s2+1;
  pole[7].s1:=sour.s1;pole[7].s2:=sour.s2+1;
  pole[8].s1:=sour.s1+1;pole[8].s2:=sour.s2+1;
  polepotomku:=pole;    
end;

procedure smazfrontu;//=nechej ve fronte jeden prvek
var Q:pojntr;
begin
new(Q);
while fronta^.dalsi<>nil do begin
  Q:=fronta;
  fronta:=fronta^.dalsi;
  dispose(Q);    
end;
end;

function jevnavst(G:xy):boolean;
var Q:pojntr;
begin
jevnavst:=false;
new(Q);Q:=navst;
while Q<>nil do begin
  if (Q^.souradnice.s1=G.s1) and (Q^.souradnice.s2=G.s2) then begin jevnavst:=true;break;end;
  Q:=Q^.dalsi;
end;  
end;

function jevprekazkach(E:xy):boolean;
var Q:pojntr;
begin
jevprekazkach:=false;
new(Q);Q:=prekazky;
while Q<>nil do begin
  if (Q^.souradnice.s1=E.s1) and (Q^.souradnice.s2=E.s2) then begin jevprekazkach:=true;break;end;
  Q:=Q^.dalsi;
end;
end;

function jevsachovnici(F:xy):boolean;
begin
if (F.s1>=1) and (F.s1<=8) and (F.s2>=1) and (F.s2<=8) then jevsachovnici:=true
else jevsachovnici:=false;
end;

var i,Pr,h:byte;P,R:pojntr;cil,start,pre:xy;
  potomci:array[1..8] of xy;
begin
read(Pr);//prekazky
new(prekazky);
prekazky:=nil;
for i:=1 to Pr do begin
  read(pre.s1,pre.s2); vlozdoprekazek(pre);
end;
read(start.s1,start.s2);//start
read(cil.s1,cil.s2);//cl

h:=0;//hloubka, poet krok
new(navst);new(fronta);
navst:=nil;fronta:=nil;
if (start.s1<>cil.s1) and (start.s2<>cil.s2) then begin
  vlozdonavst(start);
  vlozdofronty(start,h);
  fronta^.dalsi:=nil;
end;

//P:=fronta;
while (fronta<>nil) and (h<37) do begin //maximalni mozna cesta z mista A do B s prekazkami
  while fronta^.hloubka=h do begin
    potomci:=polepotomku(fronta^.souradnice);
    for i:=1 to 8 do begin
      if (potomci[i].s1=cil.s1) and (potomci[i].s2=cil.s2) then begin//cil!
        smazfrontu; break;
      end;
      if (not jevnavst(potomci[i])) and (not jevprekazkach(potomci[i])) and (jevsachovnici(potomci[i])) then begin
        vlozdofronty(potomci[i],h+1);
        vlozdonavst(potomci[i]);
      end;
    end;
    new(R);
    R:=fronta;
    fronta:=fronta^.dalsi;
    dispose(R);
  end;
  inc(h);
end;
 
if h=37 then write(-1)
else write(h);
end.