Форум программистов [Powered by Invision Power Board]

Код

program mass;

{$APPTYPE CONSOLE}
uses
  SysUtils;

const
    MAX = 11;
Var
   A : Array [1..MAX] of integer; // коэффициенты
   len : integer = 4;             // вводимая степень полинома
   i, i1, i2, j, k : integer;
   count :  integer;     // количество целых корней
   f1 : integer;         // f(1)
   f2 : integer;         // f(-1)
   sign : integer;       // для подсчета f(-1)
   res : integer;        // для схемы Горнера
   root : integer;       // текущий проверяемый корень
Begin
   Writeln('Input polynom degree (max = 10)');
   Readln(len);

   Inc(len);
   // вывод массива
   writeln('Input coeffs:');
   for i := 1 to len do
      read(A[i]);
    
   f1 := 0;
   f2 := 0;
   sign := 1;
   count := 0;

   for i := 1 to len do
      f1 := f1 + A[i];

   for i := len downto 1 do
   begin
      f2 := f2 + A[i] * sign;
      sign := -sign;
   end;

   if (f1 = 0) then
   begin
       Inc(count);
       writeln(count, ' root = 1');
   end;

   if (f2 = 0) then
   begin
       Inc(count);
       writeln(count, ' root = -1');
   end;

   k := Trunc( sqrt( abs(A[len]) ) );

   for i := 1 to k do
   begin
       if (A[len] mod i <> 0) then          // не целый корень
          continue;

       root := i;

       for i1 := 1 to 2 do               // корни: root и len / root
       begin
           for i2 := 1 to 2 do           // меняем знак у корней
           begin
           // корень - 1 должен делить f(1) и корень + 1 должен делить f(-1)
           // причем корни +- 1 уже не учитываем
               if (root = 1) then
                  Break;
                  
               if (f1 mod (root - 1) = 0) and (f2 mod (root + 1) = 0) then
               begin
                   // значение считаем по схеме Горнера
                   // первый член в схеме Горнера совпадает с первым коэфф.
                   res := A[1];

                   for j := 2 to len do
                      res := res * root + A[j];

                   if (res = 0) then      // корень
                   begin
                       Inc(count);
                       writeln(count, ' root = ', root);
                   end;
                end;
                   
               root := -root;
           end;
           root := A[len] div root;
       end;  
   end;


   if (count = 0) then
      writeln('No integer roots');

   Writeln('Press any key to exit');

   readln;
   readln;
end.