Cod sursa(job #109856)

Utilizator sandu2508Grigoroi Alexandru sandu2508 Data 25 noiembrie 2007 12:50:52
Problema Economie Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasa a 10-a Marime 1.72 kb
program Economie;
type
 sandu = array[1..1000] of longint;
label
 999;
var
 f : text;
 a, b, p, aux : sandu;
 n, i, j, k, min2, minaux, pas : integer;

procedure Init;
 var
  i : integer;
 begin
  for i := 1 to n do
   p[i] := 0;
  for i := 1 to n do
   b[i] := 0;
 end;
procedure Sort(in1, in2:sandu);
 var
  i, j, k : integer;
 begin
  for i := 1 to n do
   for j := i+1 to n do
    if in1[i] > in1[j] then
     begin
      k := in1[i];
      in1[i] := in1[j];
      in1[j] := k;
      k := in2[i];
      in2[i] := in2[j];
      k := in2[j];
     end;
 end;
procedure Gaseste(b, p :sandu);
 var
  c, j : integer;
 begin
  c := b[1];
  p[1] := a[i];
  minaux := 1;
  for j := 2 to n do
   if b[j] > c then
    begin
     minaux := minaux + 1;
     p[minaux] := aux[j];
     c := b[j];
    end;
 end;

begin
 assign(f,'economie.in');
 reset(f);
 readln(f,n);
 for i := 1 to n do
  begin
   ReadLn(F,a[i]);
   if a[i] = 1 then
   begin
    min2 := 1;
    aux[min2] := 1;
    goto 999;
   end;
 end;
 close(f);

for i := 1 to n do
 for j:= i+1 to n do
  if a[i] > a[j] then
   begin
    k := a[i];
    a[i] := a[j];
    a[j] := k;
   end;

 min2 := MaxInt;
 for i := 1 to n do
  begin
   for j := i+1 to n do
    b[j] := a[j] mod a[i];
   for j := 1 to n do
    aux[j] := a[j];
   Sort(b,aux);
   minaux := MaxInt;
   Gaseste(b,p);
   if minaux < min2 then
    begin
     min2 := minaux;
     pas := i;
     Init;
    end;
  end;

 for j := pas+1 to n do
  b[i] := a[j] mod a[pas];
  Sort(b,aux);
  Gaseste(b,p);
  min2 := minaux;


 999: ;
 assign(f,'economie.out');
 rewrite(f);
 writeln(f,min2);
 for i := 1 to min2 do
 writeln(f,aux[i]);
 close(f);
end.