Cod sursa(job #204408)

Utilizator mari_anaMariana Gheorghe mari_ana Data 23 august 2008 17:01:21
Problema Nivele Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.68 kb
type adresa=^nod;
		 nod=record
     		 niv:longint;
         p,s:adresa
         end;
var rad,ult:adresa;
    i,n,t,t2,x:longint;
		fi,fo:text;

procedure adauga;
var adr,q:adresa;
		gata:boolean;
begin
new(q);
q^.niv:=x;
q^.p:=ult;
ult^.s:=q;
q^.s:=nil;
ult:=q;
repeat
	if ult^.p<>nil then
		q:=ult^.p
  else
  	q:=ult;
	gata:=true;
	while q^.s<>nil do
	if q^.niv=q^.s^.niv then
    begin
    gata:=false;
    q^.s^.niv:=q^.s^.niv-1;
    q^.s^.p:=q^.p;
    adr:=q;
  	if q^.p<>nil then
    	begin
    	q^.p^.s:=adr^.s;
    	q:=adr^.p;
      dispose(adr)
      end
    else
    	begin
      q:=q^.s;
      q^.p:=nil;
      ult:=q;
      rad:=ult;
      dispose(adr)
      end
    end
  else
  	q:=q^.s
until gata;

end;

function ok:boolean;
var adr,q:adresa;
		gata:boolean;
begin
i:=1;
repeat
q:=rad;
gata:=true;
while q^.s<>nil do
	if q^.niv=q^.s^.niv then
    begin
    gata:=false;
    q^.s^.niv:=q^.s^.niv-1;
    q^.s^.p:=q^.p;
    adr:=q;
  	if q^.p<>nil then
    	begin
    	q^.p^.s:=adr^.s;
    	q:=adr^.p;
      dispose(adr)
      end
    else
    	begin
      q:=q^.s;
      q^.p:=nil;
      rad:=q;
      dispose(adr)
      end
    end
  else
  	q:=q^.s
until gata;
if (q^.p=nil) and (q^.niv=1) then
  ok:=true
else
	ok:=false;
end;

begin
assign(fi,'nivele.in'); reset(fi);
assign(fo,'nivele.out'); rewrite(fo);
readln(fi,t);
for t2:=1 to t do
  begin
  read(fi,n,x);
  new(rad);
  rad^.niv:=x;
  rad^.p:=nil;
  rad^.s:=nil;
  ult:=rad;
  for i:=2 to n do
    begin
    read(fi,x);
    adauga
    end;
  if ok then
  	writeln(fo,'DA')
  else
  	writeln(fo,'NU')
  end;
close(fi);
close(fo)
end.