Cod sursa(job #69568)

Utilizator MDanFMI - Dan Moldovan MDan Data 3 iulie 2007 16:08:06
Problema Stramosi Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 5.62 kb
type vec=array [1..14] of longint;
var f,g:text;
    ok,ok1:boolean;
    n,m,p,lk,lk2,cont,cont2,contor,egal,q,aux,aux2,aux3,auxaux,auxaux3,j,i:longint;
    a,b,c,d,e,asd:vec;
function stanga(i:integer):integer;
begin
stanga:=2*i;
end;

function dreapta(i:integer):integer;
begin
dreapta:=2*i+1;
end;

function parinte (i:integer):integer;
begin
parinte:=trunc(i/2);
end;


procedure reconstituieheap(i:integer);
var l,r,maxim:integer;
begin
l:=stanga(i);
r:=dreapta(i);
if (l<=aux2) and (a[l]>a[i])
then
    maxim:=l
else
    maxim:=i;
if (r<=aux2) and (a[r]>a[maxim])
then
    maxim:=r;
if maxim<>i
then
    begin
    aux:=a[i];
    a[i]:=a[maxim];
    a[maxim]:=aux;
    auxaux:=c[i];
    c[i]:=c[maxim];
    c[maxim]:=auxaux;
      auxaux:=asd[i];
    asd[i]:=asd[maxim];
    asd[maxim]:=auxaux;
    reconstituieheap(maxim);
    end;
end;


procedure construiesteheap;
begin
aux2:=j;
for i:=trunc(j/2) downto 1 do
reconstituieheap(i);
end;


procedure heapsort;
begin
construiesteheap;
for i:=j downto 2 do
    begin
    aux3:=a[1];
    a[1]:=a[i];
    a[i]:=aux3;
    auxaux3:=c[1];
    c[1]:=c[i];
    c[i]:=auxaux3;
    auxaux3:=asd[1];
    asd[1]:=asd[i];
    asd[i]:=auxaux3;
    aux2:=aux2-1;
    reconstituieheap(1);
    end;
end;
      {end heapsort 1}
procedure reconstituieheap2(i:integer);
var l,r,maxim:integer;
begin
l:=stanga(i);
r:=dreapta(i);
if (l<=aux2) and (d[l]>d[i])
then
    maxim:=l
else
    maxim:=i;
if (r<=aux2) and (d[r]>d[maxim])
then
    maxim:=r;
if maxim<>i
then
    begin
    aux:=d[i];
    d[i]:=d[maxim];
    d[maxim]:=aux;
      auxaux:=asd[i];
    asd[i]:=asd[maxim];
    asd[maxim]:=auxaux;
    reconstituieheap2(maxim);
    end;
end;


procedure construiesteheap2;
begin
aux2:=j;
for i:=trunc(j/2) downto 1 do
reconstituieheap2(i);
end;


procedure heapsort2;
begin
construiesteheap2;
for i:=j downto 2 do
    begin
    aux3:=d[1];
    d[1]:=d[i];
    d[i]:=aux3;
    auxaux:=asd[i];
    asd[i]:=asd[i];
    asd[i]:=auxaux;
    aux2:=aux2-1;
    reconstituieheap2(1);
    end;
end;
      {end heapsort 2}

procedure reconstituieheap3(i:integer);
var l,r,maxim:integer;
begin
l:=stanga(i);
r:=dreapta(i);
if (l<=aux2) and (asd[l]>asd[i])
then
    maxim:=l
else
    maxim:=i;
if (r<=aux2) and (asd[r]>asd[maxim])
then
    maxim:=r;
if maxim<>i
then
    begin
    aux:=asd[i];
    asd[i]:=asd[maxim];
    asd[maxim]:=aux;
    auxaux:=e[i];
    e[i]:=e[maxim];
    e[maxim]:=auxaux;
    reconstituieheap3(maxim);
    end;
end;


procedure construiesteheap3;
begin
aux2:=j;
for i:=trunc(j/2) downto 1 do
reconstituieheap3(i);
end;


procedure heapsort3;
begin
construiesteheap3;
for i:=j downto 2 do
    begin
    aux3:=asd[1];
    asd[1]:=asd[i];
    asd[i]:=aux3;
    auxaux:=e[1];
    e[1]:=e[i];
    e[i]:=auxaux;
    aux2:=aux2-1;
    reconstituieheap3(1);
    end;
end;
      {end heapsort 3}



begin
{programu principal}
assign (f,'stramosi.in');
assign (g,'stramosi.out');
reset (f);
rewrite (g);
read (f,n,m);
{cont:=1;}
readln (f);
for i:=1 to n do
read (f,b[i]);
{end citire}
cont:=1;
for i:=1 to m do
begin
readln (f);
read (f,a[i],c[i]);
asd[i]:=i;
end;
j:=m;
heapsort;

lk:=0;
lk2:=1;
ok:=true;
while ok do
begin
lk:=lk+lk2;
egal:=a[lk];
lk2:=1;
d[lk2]:=a[lk];
ok1:=true;
          while ok1 do
          begin
          if egal=a[lk+1]
          then
              begin
              lk2:=lk2+1;
              lk:=lk+1;
              d[lk2]:=c[lk];
              end
          else
              begin
              ok1:=false;
              j:=lk2;
              heapsort2;
              cont2:=1;
              {cont:=1;        }
                        while cont2<=lk2 do
                        begin
                             e[cont]:=b[a[cont]];
                             for contor:=2 to c[cont] do
                             begin
                             e[cont]:=b[e[cont]];
                             end;
                             cont:=cont+1;
                             cont2:=cont2+1;
                        end;
              end;
          end;
if lk>=m
then
    ok:=false;
end;

{sortarea finala}
j:=m;
heapsort3;

for i:=1 to m do
writeln (g,e[i]);

close(g);
close(f);
end.
{
ok:=true;
i:=1;
j:=1;
contor:=0;
while ok do
begin
contor:=contor+1;
a[2,j]:=-1;
a[3,j]:=contor*(-1);
b[1,i]:=j;
j:=a[1,j];

if j=0
then
    ok:=false;
i:=i+1;
end;
{b[1,0]:=2;}    {indicele vectorului 1}
b[0,0]:=1;    {nr de vrctori}



for i:=2 to n do
begin
if a[2,i]=0
then
    begin
    b[0,0]:=b[0,0]+1;
    ok:=true;
    iaux:=1;
    j:=i;
    contor:=0;
    while ok do
    begin
    contor:=contor+1;
    a[2,j]:=b[0,0]*(-1);
    a[3,j]:=contor*(-1);
    b[1,iaux]:=j;
    j:=a[1,j];
    if j=0
    then
        ok:=false;
    iaux:=iaux+1;
    end;
    end;
end;



{for i:=n-1 downto 1 do
begin
ok:=true;
ok1:=true;
for lk:=1 to b[0,0] do
if i=b[lk,b[lk,0]]
then
    begin
    ok1:=false;
    a[1,i]:=lk;
    a[2,i]:=b[lk,0];
    b[lk,0]:=b[lk,0]+1;
    end;
if ok1
then
    begin
    b[0,0]:=b[0,0]+1;
    contor:=1;
    iaux:=i;
    while ok do
    begin
    b[b[0,0],contor]:=iaux;
    iaux:=a[1,iaux];
    if iaux=0
    then
        ok:=false;
    contor:=contor+1;
    a[1,i]:=b[0,0];
    a[2,i]:=1;
    end;
b[b[0,0],0]:=2;
    end;
end;
{end prelucrare}







for i:=1 to m do
begin
readln (f);
read (f,p,q);
writeln (g,b[a[1,q],a[2,q]+p]);
end;











close (g);
close (f);
end.          }