Cod sursa(job #109686)

Utilizator 7RaduRadu Antohi 7Radu Data 25 noiembrie 2007 12:24:47
Problema Ecuatie Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 5-8 Marime 2.98 kb
program Ecuatie2;
label
 001;
var
   Fl : text;
   s, p1, p2, r1, r2 : array[1..1000] of longint;
   a, b, c, k, d, q1, q2, i, j, q, l : longint;
begin
   q := 1;
   Assign(Fl,'ecuatie.in');
   Reset(Fl);
   ReadLn(Fl,a,b,c,k);
   Close(Fl);

   d := sqr(b) - 4 * a * c;
   q1 := (trunc(sqrt(d) - b)) div (2*a);
   q2 := (trunc(0-sqrt(d)-b)) div (2*a);

   j := 0;
   for i := 1 to a do
      if a mod i = 0 then
         begin
            j := j+1;
            s[j] := i;
         end;
   l := j;
   for i := l downto 1 do
      begin
         j := -s[i];
         p1[q] := j;
         p2[q] := a div j;
         r1[q] := q1*j;
         r2[q] := q2 * (a div j);
         q := q + 1;
      end;
   for i := 1 to l do
      begin
         p1[q] := s[i];
         p2[q] := a div s[i];
         r1[q] := q1 * s[i];
         r2[q] := q2 * (a div s[i]);
         q := q + 1;
      end;
   for i := q to 2 * q do
      begin
         p1[i] := p2[i-q];
         r1[i] := r2[i-q];
         p2[i] := p1[i-q];
         r2[i] := r1[i-q];
      end;

   for i := 1 to 2 * q do
      for j := i+1 to 2 * q do
         begin
            if p1[i] > p1[j] then
               begin
                 d := p1[i];
                 l := p2[i];
                 p1[i] := p1[j];
                 p2[i] := p2[j];
                 p1[j] := d;
                 p2[j] := l;
                 d := r1[i];
                 l := r2[i];
                 r1[i] := r1[j];
                 r2[i] := r2[j];
                 r1[j] := d;
                 r2[j] := l;
              end;
           if p1[i] = p1[j] then
             if r1[i] < r1[j] then
                begin
                   d := p1[i];
                   l := p2[i];
                   p1[i] := p1[j];
                   p2[i] := p2[j];
                   p1[j] := d;
                   p2[j] := l;
                   d := r1[i];
                   l := r2[i];
                   r1[i] := r1[j];
                   r2[i] := r2[j];
                   r1[j] := d;
                   r2[j] := l;
              end;
          end;

   i := p1[k];
   j := p2[k];
   q1 := r1[k];
   q2 := r2[k];

   if (l > k) or (d < 0) then
      goto 001;

   Assign(fl,'ecuatie.out');
   ReWrite(Fl);
   if (i <> 1) and (i <> -1) then
     Write(Fl,'(',i,'x')
   else
      if (i = 1) then
        write(fl,'( x')
      else
         write(fl,'( -x');
   if q1 > 0 then
      write(fl,'-',q1);
   if q1 < 0 then
      begin
         q1 := abs(q1);
         write(fl,'+',q1);
      end;
   write(fl,')');
   if (j <> 1) and (j <> -1) then
     write(fl,'(', j, 'x')
   else
      if j = 1 then
        write(fl,'( x')
      else
         write(fl,'( -x');
   if q2 > 0 then
      write(fl,'-', q2);
   if q2 < 0 then
      begin
         q2 := abs(q2);
         write(fl,'+',q2);
      end;
   write(fl,')');
001: ;
   rewrite(fl);
   if (l > k) or (d < 0) then
      writeln(fl,'-1');
   Close(fl);
end.