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.