Cod sursa(job #109442)

Utilizator vanila_CPPIonescu Victor Cristian vanila_CPP Data 25 noiembrie 2007 11:06:44
Problema Economie Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasa a 10-a Marime 3.39 kb
program economie;
var f,g:text;
        n:longint;
        maxv,dim:longint;
        v,sol:array[1..1001] of longint;
        vsp:array[0..50001] of byte;


procedure citire;
var i:longint;
begin
        assign(f,'economie.in');reset(f);
        assign(g,'economie.out');rewrite(g);
        readln(f,n);
        maxv:=0;
        for i:=1 to n do
                begin
                        readln(f,v[i]);
                        if (v[i]=1) then
                                begin
                                        writeln(g,1);
                                        writeln(g,1);
                                        close(f);
                                        close(g);
                                        halt;
                                end;
                        if v[i]>maxv then maxv:=v[i];
                end;
        fillchar(vsp,sizeof(vsp),0);
        vsp[0]:=1;
        dim:=n;
        close(f);
end;



procedure repair(i:longint);
var l,r,max,aux:longint;
begin
        l:=i*2;
        r:=l+1;
        max:=i;
        if (l<=dim)and(v[l]>v[max]) then max:=l;
        if (r<=dim)and(v[r]>v[max]) then max:=r;
        if max<>i then
                begin
                        aux:=v[i];
                        v[i]:=v[max];
                        v[max]:=aux;
                        repair(max);
                end;
end;


procedure build_heap;
var i:longint;
begin
        for i:=n div 2 downto 1 do
                repair(i);
end;


procedure heapsort;
var i,aux:longint;
begin
        build_heap;
        for i:=n downto 2 do
                begin
                        aux:=v[1];
                        v[1]:=v[i];
                        v[i]:=aux;
                        dec(dim);
                        repair(1);
                end;
end;



procedure rucsac(val:longint);
var i:longint;
begin
        for i:=0 to maxv-val do
                if vsp[i]=1 then vsp[i+val]:=1;
end;




function verif(poz:longint):boolean;
var i:longint;
begin
        verif:=true;
        for i:=poz+1 to n do
                if vsp[v[i]]<>1 then
                        begin
                                verif:=false;
                                break;
                        end;
end;



procedure solve;
var i,j,nb:longint;
begin
        for i:=1 to n do
                if (i=1) or (v[i]<>v[i-1]) then
                begin
                        rucsac(v[i]);
                        if verif(i) then
                                begin
                                        nb:=0;
                                        for j:=1 to i do
                                                if (j=1)or(v[j]<>v[j-1]) then
                                                        begin
                                                        inc(nb);
                                                        sol[nb]:=v[j];
                                                        end;
                                        writeln(g,nb);
                                        for j:=1 to nb do
                                                writeln(g,sol[j]);
                                        close(g);
                                        halt;
                                end;
                end;
end;


begin
        citire;
        heapsort;
        solve;
end.