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

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Object Pascal: кроссплатформенные технологии > Решение квадратного уравнения

Автор: term0stat 25.10.2004, 20:35

Помогите сделать программу на Паскале для решения кв. уравнения вида
a*x*x+b*x+c=0
И чтобы если a=0 говорило что это не кв. уравнение и начинало опять требовать ввести значения

Автор: Kesh 25.10.2004, 20:44

Код

var
  a,b,c,d: real;
begin
  repeat
    Write('a? ');
    RealLn(a);
    Write('b? ');
    RealLn(b);
    Write('c? ');
    RealLn(c);
  until a<>0;
  d := sqr(b)-4*a*c;
  if d<0 then writeln('Корни комплексные')
  else if d=0 then writeln('Один корень = ',-b/2/a)
  else  writeln('X1 = ',(-b-sqrt(d))/2/a,'X2 = ',(-b+sqrt(d))/2/a);
  Write('Enter для выхода...');
  ReadLn
end.

Автор: Полудненко Олег 25.10.2004, 20:44

begin
if a=0 then
begin
ShowMessage('а не может равняться 0!');
exit;
end;
D:=sqr(b)-4*a*c;
if D<0 then
begin
ShowMessage('Уравнение не имеет корней!');
exit;
end;
x1:=(-b+sqrt(D))/(2*a);
x2:=(-b-sqrt(D))/(2*a);
end.

Автор: p0s0l 25.10.2004, 21:38

Пока писал в оффлайне - уже ответили, ну да ладно

Код

program solver;

var a, b, c, d : real;

begin
  WriteLn ('Equation: A*x*x + B*x + C = 0');
  repeat
    Write ('Input A, B, C: ');
    ReadLn (a, b, c);
    if a = 0 then WriteLn ('Ne kvadratnoe uravnenie!!!');
  until a <> 0;
  d := b*b - 4*a*c;
  if d < 0 then WriteLn ('Net resheniy!')
  else if d = 0 then WriteLn ('x=', (-b/(2*a)):2:2)
  else WriteLn ('x1=', ((-b + Sqrt(d))/(2*a)):2:2, ' x2=', ((-b - Sqrt(d))/(2*a)):2:2 );
  ReadLn;
end.

Автор: term0stat 25.10.2004, 21:47

Огромное вам спасибо

Автор: Dr Smth 26.10.2004, 10:12

Цитата(p0s0l @ 25.10.2004, 21:38)

if d < 0 then WriteLn ('Net resheniy!')

На этом почему-то все останавливаются, в то время как существуют ещё и комплексные корни...

Автор: Dr Smth 27.10.2004, 18:04

При реализации решения квадратного уравнения можно столкнуться с различного рода неприятностями.
Например: a=1e-200, b=-3e-200, c=2e-200. При вычислении дискриминанта получается машинный нуль, и решение идёт по ветви равных корней: х1=х2=1.5, хотя вполне очевидно, что точные значения равны: х1=1, х2=2. Т.е. определённые комбинации коэффициентов могут заставить программу пойти по ложному следу.

В случае, если b*b >> 4*a*c при использовании стандартных формул есть опасность вычитания близких чисел в числителе. Чтобы обойти такую ситуацию применяют, например, выражение для определения х1 с использованием понятия знака числа b: x1=-(b + Sign(b)*Sqrt(d))/(2*a), а второй корень вычисляют с помощью теоремы Виета: x2=c/(a*x1).

Ниже помещаю предыдущий код с учётом данной особенности. В нём также вычисляются комплексные корни. В предыдущем коде не была учтена ситуация, когда все коэффициенты равны нулю. В этом случае решением является любое число.

Код

program sq;
uses
  SysUtils, Math;
var a, b, c, d, r, i : real;

begin
  WriteLn ('Equation: A*x*x + B*x + C = 0');
   Write ('Input A, B, C: ');
   ReadLn (a, b, c);
    if a = 0
      then
        begin
        if b = 0
          then
            begin
             if c = 0
              then
                begin //Все коэффициенты равны нулю
                WriteLn ('The root of the equation is any number.')
                end
               else
                begin //Нет корней - это когда есть только с
                WriteLn ('The equation has no roots.')
                end;
            end
           else
            begin    //Линейное уравнение (а=0, b<>0)
            WriteLn ('x=', (-c/b):2:2);
            end;
        end
      else
        begin
        d := b*b - 4*a*c;//Вычисление дискриминанта
        r := -b/(2*a);   //Вычисление действительной части
          if d >= 0
            then
              begin
               if d > 0
                  then
                    begin //Пихаем в i корень х1 - нечего ей простаивать!
                    i := -(b + Sign(b)*Sqrt(d))/(2*a);
                          //2 корень - по теореме Виета
                    WriteLn ('x1=', i:2:2,' x2=', c/(a*i):2:2);
                    end
                  else
                    begin
                    WriteLn ('x1=x2=', r:2:2);
                    end;
                  end
            else
              begin //Теперь используем i по назначению - для определения
                    //коэффициента при мнимой единице
                 i := Sqrt(-d)/(2*a);
                 WriteLn('x1=', r:2:2, '+ i*', i:2:2, ' x2=', r:2:2, '- i*', i:2:2);
              end
            end;
  ReadLn;
end.

Примечание. При программных расчётах редко получается нуль, так что можно сравнения производить с некоторой малой величиной e.

Не ото всех ситуаций удаётся избавиться. Указанной в начале проблемы данный код не решает. Если введём а=1е200, b=-3e200, c=2e-200, то получим нечто похожее, только вместо машинного нуля произойдёт переполнение.
Ситуацию, когда a=1e-200, b=1e200, c=-1e200 предложенный код, в принципе, позволяет разрешить, однако при вычислении b*b произойдёт любимое всеми нами переполнение.