Cod sursa(job #110015)

Utilizator runnaway90Oprescu Radu Constantin runnaway90 Data 25 noiembrie 2007 15:55:15
Problema Economie Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.56 kb
var a:array[0..1010]of word;
        n,i,p,w,j,nr:word;
        f:text;
        ok:boolean;
    b:array[0..1000]of word;

procedure Sort(l, r: word);
var
  i, j, x, y: word;
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
        assign(f,'economie.in');
        reset(f);
                readln(f,n);
                for i:=1 to n do
                     read(f,a[i]);
        closE(f);
        sort(1,n);
        p:=0;
        if a[1]=1 then
        begin
        assign(f,'economie.out');
        rewrite(f);
                writeln(f,1);
                write(f,1);
        close(f);
        end
        else
        begin
        for i:=1 to n do
        begin
                w:=a[i];
                ok:=false;
                for j:=1 to i-1 do
                begin
                        while w mod a[j]=0 do
                                ok:=true;
                end;
                if ok=false then
                begin
                        inc(nr);
                        b[nr]:=a[i];
                end;
        end;
        assign(f,'economie.out');
        rewrite(f);
                writeln(f,nr);
                for i:=1 to nr-1 do
                writeln(f,b[i]);
                write(f,b[nr]);
        closE(f);
        end;
end.