# Cod sursa(job #292380)

Utilizator Data 31 martie 2009 08:44:16 Perle 100 fpc done Arhiva de probleme 2.55 kb
``````var st:array[1..2,1..10000] of integer;
niv,valid:array[1..2] of integer;
n,l,v,i:integer;

procedure verif(i:integer);
begin
if valid[i]=1 then
if st[i,niv[i]-1]<4 then
begin
dec(niv[i]);
if st[i,niv[i]]=v then valid[i]:=1
else valid[i]:=0;
end
else if st[i,niv[i]-1]=4 {A} then dec(niv[i])
else if st[i,niv[i]-1]=5 {B} then
begin
if v=3 then valid[i]:=0;
if v=1 then
begin
dec(niv[i]);
st[i,niv[i]]:=6; inc(niv[i]); {C}
st[i,niv[i]]:=4; inc(niv[i]); {A}
st[i,niv[i]]:=3; inc(niv[i]); {3}
st[i,niv[i]]:=4; inc(niv[i]); {A}
end;
{2 e bun si nu duce la nici o modificare B->2B}
end
else {st[i,niv[i]-1]=6 -> este C in stiva}
begin
if v=2 then dec(niv[i]);
if v=1 then
begin
dec(niv[i]);
st[i,niv[i]]:=4; inc(niv[i]); {A}
st[i,niv[i]]:=2; inc(niv[i]); {2}
end;
if v=3 then
begin
dec(niv[i]);
st[i,niv[i]]:=6; inc(niv[i]); {C}
st[i,niv[i]]:=5; inc(niv[i]); {B}
end;
end;

if (niv[i]=0) and (l>0) then valid[i]:=0;
end;

begin
assign(input,'perle.in'); reset(input);
assign(output,'perle.out'); rewrite(output);
while n>0 do
begin
if l=1 then
begin
writeln(1);
end
else
begin
valid[2]:=1; valid[1]:=1;
niv[2]:=2; niv[1]:=2;
st[1,1]:=5;{B} st[2,1]:=6;{C}
while l>0 do
begin