Listing PIRAMIDA.PAS
{$M 65500,0,655360}
program Piramida;
const DIMAX=4500; {Lungime maxima a
vectorului in care se salveaza piramida }
NMAX=30;
{ Lungimea maxima a bazei piramidei }
type piramida_byte=array[0..DIMAX] of Byte;
piramida_long=array[0..DIMAX] of Longint;
var
i,j,k,n,m:Integer;
d, { Duritatile blocurilor }
hback,lback,cback:piramida_byte;
{ Adresa blocului precedent }
min:piramida_long;
{ Lungimea minima pana la acel bloc }
pos:array[0..NMAX] of Longint;
w:array[0..NMAX] of Integer;
fin,fout:Text;
procedure Initializare;
{ Initializeaza variabile, precalculeaza date }
var s,k:Longint;
begin
m:=(n div 2)+1; { Inaltimea piramidei }
w[0]:=n; { Dimensiunea bazei }
pos[0]:=0; { Pozitia de inceput in }
{ vector a bazei }
s:=0;
for k:=1 to m-1 do
begin
w[k]:=w[k-1]-2;{Dimensiunea nivelului k }
s:=s+Longint(w[k-1]*w[k-1]);
pos[k]:=s { Pozitia de inceput in }
{ vector a nivelului k }
end;
for k:=0 to DIMAX-1 do min[k]:=MaxLongInt
{ Initializare vector lungimi gasite }
end;
function Offset(h,l,c:Integer):Longint;
{ Afla pozitia in vector a blocului de }
{ piramida de la nivelul h, linia l si }
{ coloana c }
begin
Offset:=Longint(pos[h])+Longint(l*w[h]+c)
end;
procedure AjungeIn(bh,bx,by,h,x,y:Integer;
v:Longint);
var pos:Integer;
{ bh,bx,by - Adresa blocului vecin de unde }
{ s-a plecat }
{ h,x,y - Adresa blocului din care se refac }
{ drumurile }
{ v - Lungimea drumului pana la acel bloc
inclusiv }
begin
pos:=Offset(h,x,y);
if v<min[pos]
then
begin { Daca drumul gasit este mai mic }
min[pos]:=v;{ Marchez lungimea drumului }
hback[pos]:=bh;
{ Si adresa blocului din care am venit }
lback[pos]:=bx;
{ pentru a gasi drumul minim plecand de la }
cback[pos]:=by; { blocul de sus }
{ Incerc sa ajung si in blocurile }
{ vecine plecand din acest bloc }
if x>0 then AjungeIn(h,x,y,h,x-1,y,
v+d[Offset(h,x-1,y)]);
if x<w[h]-1 then AjungeIn(h,x,y,h,x+1,
y,v+d[Offset(h,x+1,y)]);
if y>0 then AjungeIn(h,x,y,h,x,y-1,
v+d[Offset(h,x,y-1)]);
if y<w[h]-1 then AjungeIn(h,x,y,h,x,
y+1,v+d[Offset(h,x,y+1)])
end
end;
procedure CalculNivel(h:Integer);
{ Calculeaza lungimile minime ale }
{ drumurilor care ajung la fiecare }
{ bloc dintr-un nivel }
var i,j:Integer;
begin
if h=0
then
begin { Daca este nivelul baza atunci se }
{ poate intra pe fiecare latura }
for i:=0 to n-1 do
begin { Pentru fiecare bloc de pe }
{ margine incerc sa construiesc drumul }
{ plecand din acel bloc }
AjungeIn(100,0,0,0,i,0,d[Offset(0,i,0)]);
AjungeIn(100,0,0,0,i,n-1,
d[Offset(0,i,n-1)]);
AjungeIn(100,0,0,0,0,i,d[Offset(0,0,i)]);
AjungeIn(100,0,0,0,n-1,i,
d[Offset(0,n-1,i)])
end
end
else
begin
{ Daca nu este nivelul baza incerc sa }
{ ajung la acest nivel prin oricare din }
{ blocurile existente la nivelul inferior }
for i:=0 to w[h]-1 do
for j:=0 to w[h]-1 do
AjungeIn(h-1,i+1,j+1,h,i,j,
min[Offset(h-1,i+1,j+1)]+d[Offset(h,i,j)])
end
end;
procedure AfiseazaDrum;
{ afiseaza drumul minim gasit }
var dh,dx,dy:piramida_byte;{Stocheaza drumul}
h,x,y,pos,k:Integer;
begin
k:=0; { Numar de blocuri prin care a }
{ trecut drumul }
h:=m-1; { Pozitia blocului curent h,x,y }
x:=0; y:=0;
while h<100 do
begin
dh[k]:=h; { Stochez acest bloc si }
{ incrementez numarul de blocuri }
dx[k]:=x; {prin care trece drumul minim }
dy[k]:=y;
Inc(k);
pos:=Offset(h,x,y);
h:=hback[pos]; {Trec la blocul anterior }
x:=lback[pos]; y:=cback[pos]
end;
Writeln(fout,' ',k);
{ Afisez lungimea drumului }
for h:=k-1 downto 0 do
{ Afisez in sens invers drumul }
Writeln(fout,dh[h],' ',dx[h]+1,' ',dy[h]+1)
end;
Begin
Assign(fin,'PIRAMIDA.IN');
Reset(fin);
{ Fisier de intrare }
Assign(fout,'PIRAMIDA.OUT');
Rewrite(fout);
{ Fisier de iesire }
Readln(fin,n); { Citirea lungimii bazei }
Initializare;
{ Procedura de initializare variabile }
for k:=0 to m-1 do
for i:=0 to w[k]-1 do
begin
for j:=0 to w[k]-1 do
Read(fin,d[Offset(k,i,j)]);
{ Citirea duritatilor }
Readln(fin)
end;
for i:=0 to m-1 do
CalculNivel(i);
{ Calcularea drumurilor pana }
{ la un fiecare nivel }
Write(fout,min[Offset(m-1,0,0)]);
{ Scrierea lungimii minime gasite }
AfiseazaDrum;
{ Afisarea drumului gasit }
Close(fin);
Close(fout)
End.