Cod sursa(job #293406)

Utilizator AndreiDumaAndrei Duma AndreiDuma Data 1 aprilie 2009 19:58:16
Problema Economie Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.15 kb
var a:array[1..1000] of longint;
    b:array[1..1000] of boolean;
    n,i,j:integer;
	
	f,g:text;
	
procedure insert ( p:integer );
begin
		b[p]:=true;
		for j:=p+1 to n do if a[j] mod a[p]=0 then b[j]:=true;
end;

function valid : boolean;
var ok:boolean;
begin
		ok:=true;
		for j:=i to n do if not b[j] then 
		begin 
			ok:=false;
			break;
		end;
		
		valid:=ok;
end;	

function Part(l,r:integer):integer;
var p,t:integer;
begin
        p:=a[r];
        j:=l-1;
        for i:=l to r do
         if a[i]<=p then
            begin
             inc(j);
             
			 t:=a[i];
		     a[i]:=a[j];
			 a[j]:=t;
            end;
        Part:=j;
end;

procedure QuickS(l,r:integer);
var poz:byte;
begin
        poz := Part(l,r);
        if l<poz-1 then QuickS(1,poz-1);
        if r>poz+1 then QuickS(poz+1,r);
end;

begin
assign(f,'economie.in');reset(f);
assign(g,'economie.out');rewrite(g);
readln(f,n);

for i:=1 to n do readln(f,a[i]);

QuickS(1,n);

i:=1;
insert(i);

while not valid do
begin
		inc(i);
		insert(i);
end;

writeln(i);
for j:=1 to i do writeln(a[j]);

readln;
end.