Cod sursa(job #515848)

Utilizator sharky12592Sireanu Roland sharky12592 Data 22 decembrie 2010 15:52:00
Problema Nums Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.01 kb
Program nums;
var J,i,C,X,N:longint;
	A:array[1..100000] of longint;
	t:longint;
	FI,FO:Text;

Procedure Bouble(nr:longint);
	var X,i,O,k:longint;
	begin
	For O:=J-1 DownTo 1 Do
		For i:=1 to O do
			IF A[i]>A[i+1] then
				Begin
				X:=A[i];
				A[i]:=A[i+1];
				A[i+1]:=X;
				end;
        For i:=1 to j do
            IF A[i]=0 then
               For k:=i to j-1 do
                   A[k]:=A[k+1];

	Writeln(FO,A[nr]);
	End;

Function vrf(nr:longint):boolean;
	var i:longint;
		ok:boolean;
	Begin
	ok:=true;
	for i:=1 to j do
		if A[i]=nr then ok:=false;
	vrf:=ok;
	end;


Begin
J:=1;
Assign(FI,'nums.in');
Reset(FI);
ASSIGN(FO,'nums.out');
Rewrite(FO);
Readln(FI,n);
	For i:=1 to n do
		begin
		Readln(FI,T,X);
		IF T=1 then { daca T=1 adaugam}
			IF vrf(X) then { verificam daca mai exista acest numar in vector}
				Begin
				A[J]:=X;
				inc(J);
				end;
		IF T=0 then
			bouble(X);
		end;
Close(FI);
Close(FO);
for i:=1 to j do
writeln(' ',A[i]);
writeln(J);

end.