INFOMAN брой 18

{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P+,Q+,R+,S+,T-,V-,X+,Y+}
{$M 65520,0,655360}

Uses Crt;

{  Нека е даден полиним

    f(x) = a0 + a1*x + a2*x^2 + ... + an*X^n  ,

 където a0 * an <> 0.

 f(x) има за корен несъкратимата дроб p/q тогава и само тогава когато

   a0*q^n + a1*q^(n-1)*p + ... + a(n-1)*q*p^(n-1) + an*pn = 0.

 Освен това q трябва да е делител на an , а p-делител на a0.


 Метод на хорнер:
 ----------------
1) Полинома f(x) = a0 + a1*x + a2*x^2 + ... + an*X^n може да се запише като:

   f(x) = ( ... (an*X+(an-1)) * X + (an-2)) * X + .... + a1)*X + a0.

   Или можем да сметнем полинома по зададени коефициенти и X - Un;
   Тогава
    U0 = an
    Ui = U(i-1) * X + a(n-1) , i = 1,2, ... ,n
   Резултата е в Ui


2) Полинома P(x,y) = u0*x^n + u1*x^(n-1)*y + .... + u(n-1)*x*y^(n-1) +un*y^n,

   I) може да се представи като:

P(x,y)=(...(((a0*x + a1*y)*x + a2y^2)*x + a3*y^3)*x +...+a(n-1)*y^(n-1) )*x +
        an*y^n.


   II) можем да разделим полинома P(x,y) на y^n и получаваме полином на
      променловата h = (x/y). Изчисляваме полинома в точка h по приложената
      в (1) схема , след което умножаваме резултата с y^n


}

type
     Integer = longint;
     TPolinom = record
		 N:integer;
		 A:array[0..100] of longint;
                end;


    { P(X) = A0*X^N + A1*X^N-1 + ... + An }

function Horner(Var T:TPolinom;X:LongInt):longint;
Var
 i:integer;
 Sum:integer;
begin
 Sum:=T.A[0];

 for i:=1 to T.N do
   Sum:=Sum*X + T.A[i];

 Horner:=Sum;
end;

function Horner2(Var T:TPolinom;X,Y:LongInt):longint;
Var
 i:integer;
 Sum,St:integer;
begin
 Sum:=T.A[0];
 St:=y;

 for i:=1 to T.N do
  begin
   Sum:=Sum*x+T.A[i]*ST;
   St:=St*y;
  end;

 Horner2:=Sum;
end;

procedure InputPolinom(Var P:TPolinom);
Var
 i:integer;
begin
 FillChar(P,SizeOF(p),0);
 Write('Степен на полинома N='); ReadLn(P.N);
 for i:=0 to P.N do
  begin
   Write('X^',P.N-i,' * A(',i,')='); ReadLn(P.A[i]);
  end;
end;

procedure WritePolinomX(Var P:TPolinom);
Var
 i:integer;
begin
 Write('P(X) = ');
 for i:=0 to P.N do
  Write(P.A[i],'* X^',P.N-i,' + ');
end;

procedure WritePolinomXY(Var P:TPolinom);
Var
 i:integer;
begin
 Write('P(X) = ');
 for i:=0 to P.N do
  Write(P.A[i],'* X^',P.N-i,'*Y^',i,' + ');
end;

{ P(X) = A0*X^N + A1*X^N-1 + ... + An }
procedure FindRoots(Var T:TPolinom);
Var
 A0,AN:integer;
 P,Q:integer;
begin
 A0:=abs(T.A[T.N]);
 AN:=T.A[0];

 for P:=-A0 to A0 do
  if p <> 0 then
   if A0 mod P = 0 then
    begin
     if Horner2(T,P,1) = 0 then
      WriteLn(P,'<->',boolean(Horner(T,P) = 0),' ');
    end
   else
    begin
     if Horner2(T,P,1) = 0 then
      WriteLn(P,'<->',boolean(Horner(T,P) = 0),' ');
    end
end;

procedure FindRoots2(Var T:TPolinom);
Var
 A0,AN:integer;
 P,Q:integer;
begin
 A0:=abs(T.A[T.N]);
 AN:=T.A[0];

 for P:=-A0 to A0 do
  if p <> 0 then
   if A0 mod P = 0 then
     if Horner(T,P) = 0 then { Дали наистина е 0 }
      WriteLn(P)
    else
     if Horner(T,P) = 0 then
      WriteLn(P);
end;

procedure FindRoots3(Var T:TPolinom);
Var
 A0,AN:integer;
 P,Q,i:integer;
 L:TPolinom;
begin
 A0:=abs(T.A[T.N]);
 AN:=T.A[0];

 L.N:=0;

 for P:=-A0 to A0 do
  if p <> 0 then
   if A0 mod P = 0 then
     if Horner(T,P) = 0 then { Дали наистина е 0 }
      begin
       WriteLn(P);
       inc(L.N); L.A[L.N]:=P;
      end
    else
     if Horner(T,P) = 0 then
      begin
       WriteLn(P);
       inc(L.N); L.A[L.N]:=P;
      end;

 if L.N = T.N then
  begin
   Write(' ==> P(X) => ');
   for i:=1 to L.N do
    Write('(X - ',L.A[i],')');
   WriteLn;
  end;
end;

Var
 P:TPolinom;
 X,Y:LongInt;
begin
 ClrScr;
 InputPolinom(P);  { P(X) = X^3 - 18X^2 + 47X - 30 }
 WriteLN;
 WriteLn;
 {Write('X='); ReadLn(X); WriteLn;}
 WritePolinomX(P); {Write('  ===  ',Horner(P,X));}
 WriteLn;

 {Write('Y='); ReadLn(Y); WriteLn;
  WritePolinomXY(P); Write('  ===  ',Horner2(P,X,Y));
  WriteLn; }

 WriteLn('Целите корени(нули) на полинома са');
 FindRoots3(P);
end.