Cod sursa(job #28868)

Utilizator raduzerRadu Zernoveanu raduzer Data 8 martie 2007 13:38:07
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.12 kb
var a:array[1..100]of word;
    n,i,j,c,x,y,prim,d:word;
begin
     write('n=');readln(n);
     write('c=');readln(c);
     for i:=1 to n do read(a[i]);
     for i:=1 to n do
     begin
          prim:=1;
          for d:=2 to trunc(sqrt(a[i])) do if a[i] mod d=0 then begin prim:=0;break;end;
          if prim=1 then write(a[i],' ')
                    else
          begin
               x:=a[i];
               repeat
                     x:=x-1;
                     prim:=1;
                     for d:=2 to trunc(sqrt(x)) do if x mod d=0 then begin prim:=0;break;end;
               until prim=1;
               y:=a[i];
               repeat
                     y:=y+1;
                     prim:=1;
                     for d:=2 to trunc(sqrt(y)) do if y mod d=0 then begin prim:=0;break;end;
               until prim=1;
               if a[i]-x<y-a[i] then write(x,' ');
               if a[i]-x>y-a[i] then write(y,' ');
               if a[i]-x=y-a[i] then if c=1 then write(x,' ')
                                            else write(y,' ');
          end;
     end;
     writeln;
readln;
end.