Версия для печати темы

Автор: klem4 9.10.2007 1:43

Задача: Зная корни x[1]...x[n] многочлена P(x) определить его коэффициенты a[0], a[1], ..., a[n], где

P(x) = a[0] + a[1] * x + a[2] * x^2 + ... + a[n - 1] * x^(n - 1) + a[n] * x^n

Напоминание: По теореме Безу: P(x) = (x - x[1])*(x - x[2])*(x - x[3]) *... *(x - x[n])

мой вариант:

{$R-}
uses crt;

type
  PArray = ^TArray;
  TArray = array [1..1] of integer;

function get_coeff(const roots: PArray; const roots_count,
 coeff_num: integer; unuse: PArray): integer;
var
  s, i, j, p: integer;

begin

  if coeff_num = 0 then begin

    s := 1;

    for i := 1 to roots_count do
     s := s * roots^[i];

     get_coeff := s;

  end
   else if coeff_num = roots_count then get_coeff := 1
    else begin

      p := 1;

      for i := 1 to roots_count do begin

        j := 1;

        while (j <= coeff_num) and (i <> unuse^[j]) do
         j := j + 1;

        if j > coeff_num then
         p := p * roots^[i];

      end;

      if unuse^[1] = roots_count - coeff_num + 1 then
       get_coeff := p else begin

         j := coeff_num;

         while (j >= 1) and (unuse^[j] >= j + roots_count - coeff_num)
          do dec(j);

         inc(unuse^[j]);

         if j < coeff_num then
          unuse^[j + 1] := unuse^[j] + 1;

         get_coeff := get_coeff(roots, roots_count, coeff_num, unuse) + p;
      end;
    end
end;

procedure get_coeffs(const roots: PArray; var coeffs: PArray;
 const roots_count: integer);

var
  unused: PArray;
  i, j: integer;

begin

  for i := 0 to roots_count do begin

    GetMem(unused, i * sizeof(TArray));
    for j := 1 to i do
     unused^[j] := j;

    coeffs^[succ(i)] := get_coeff(roots, roots_count, i, unused);

    FreeMem(unused, i * sizeof(TArray));

  end;
end;

var
  roots, coeffs: PArray;
  i, roots_count: integer;

begin
  clrscr;

  write('roots_count = '); readln(roots_count); writeln;

  GetMem(roots, roots_count * sizeof(TArray));
  GetMem(coeffs, succ(roots_count) * sizeof(TArray));

  for i := 1 to roots_count do begin
    write('root[', i, '] = '); readln(roots^[i]);
    roots^[i] := -roots^[i];
  end;

  get_coeffs(roots, coeffs, roots_count);

  writeln;

  for i := roots_count + 1 downto 1 do
   writeln('a[', i - 1, '] = ', coeffs^[i]:3);

  FreeMem(roots, roots_count * sizeof(TArray));
  FreeMem(coeffs, succ(roots_count) * sizeof(TArray));

  readln;
end.

Автор: Lapp 9.10.2007 7:39

klem4, насколько я понимаю, нужно решить систему линейных уравнений. Скажи - какой метод ты применял для этого?
Если эта прога отлажена-проверена, то может ее запостить в FAQ?

оффтоп: а почему у тебя столько пустых строк в тексте?

Автор: klem4 9.10.2007 20:47

нет, никаких систем уравнений я не решал, алгоритм опишут чуть позже, сейчас к сожалению нет времени