Cod sursa(job #163070)

Utilizator DanielGGlodeanu Ioan Daniel DanielG Data 21 martie 2008 12:24:47
Problema Economie Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.8 kb
const Max = 1000;
type List = array[1..Max] of Integer;
vect=array[1..10000] of longint;
var a,v:list;
s:vect;
m,k,n,i,j,nr:integer;
f:text;
procedure QuickSort(var A: List; Lo, Hi: Integer);
procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
repeat
    while a[i] < x do i := i + 1;
while x < a[j] do j := j - 1;
if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;
begin;
  Sort(Lo,Hi);
end;
procedure QuickkSort(var s:vect; Lo, Hi: Integer);
procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := s[(l+r) DIV 2];
repeat
    while s[i] < x do i := i + 1;
while x < s[j] do j := j - 1;
if i <= j then
    begin
      y := s[i]; s[i] := s[j]; s[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;
begin;
  Sort(Lo,Hi);
end;
procedure citire;
var i:integer;
begin
assign(f,'economie.in');reset(f);
readln(f,n);
for i:=1 to n do
readln(f,a[i]);
close(f);
end;
begin
citire;
quicksort(a,1,n);
k:=1;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
if a[i]<>0 then
begin
if a[i]<>0 then
begin
if a[j] mod a[i]=0 then a[j]:=0;
end;
end;
end;
for i:=1 to n do
if a[i]<>0 then
begin
v[k]:=a[i];
inc(k);
end;
m:=1;
for i:=1 to k-1 do
for j:=1 to k do
begin
s[m]:=a[i]+v[j];
inc(m);
end;
quickksort(s,1,k);
for i:=1 to k do
begin
for j:=1 to m do
if v[i]-s[m]=0 then
begin
v[i]:=0;
break;
end;
end;
for i:=1 to k do
if v[i]<>0 then inc(nr);
assign(f,'economie.out');rewrite(F);
writeln(f,nr);
for i:=1 to k do
if v[i]<>0 then writeln(f,v[i]);
close(f);
end.