+ Ответить в теме
Показано с 1 по 2 из 2

Тема: Где ошибка?

  1. #1
    Conner is on a distinguished road
    Регистрация
    15.07.2009
    Возраст
    29
    Сообщений
    1
    Вес репутации
    0

    По умолчанию Где ошибка?

    Задание.
    Заданы коэффициенты а,б и ц биквадратного уравнения ax4+bx2+c=0.Найти все его действительные корни.

    Программа вроде работает,но всегда в ответе выводит 2 корня один из которых (х2) всегда равен 0 :/ Чую что-то не то с кодом...


    Код :
    1. procedure TForm1.Button1Click(Sender: TObject);
    2. var a,b,c,D,x1,x2,x3,x4,y1,y2:real;
    3. begin
    4. a:=StrToFloat(Edit1.Text);
    5. b:=StrToFloat(Edit2.Text);
    6. c:=StrToFloat(Edit3.Text);
    7. D:=sqr(b)-4*a*c;
    8. if D<0 then
    9. Label5.Caption:='v uravnenii' +chr(13)+'net dejstvitelnix kornej'
    10. else
    11. begin
    12. y1:=(-b+sqrt(D))/(2*a);
    13. y2:=(-b-sqrt(D))/(2*a);
    14. if (y1<0) and (y2<0) then
    15. Label5.Caption:='V uravnenii' +chr(13)+'net dejstvitelnix kornej'
    16. else
    17. if (y1>=0) and (y2>=0) then
    18. begin
    19. x1:=sqrt(y1);
    20. x2:=(-x1);
    21. x3:=sqrt(y2);
    22. x4:=(-x3);
    23. Label5.Caption:='X1 ='+FloatToStr(x1)+chr(13)+'X2 ='+FloatToStr(x2)+chr(13)+'X3 ='+FloatToStr(x3)+chr(13)+'X4 ='+FloatToStr(x4);
    24. end
    25. else if (y1>=0) then
    26. begin
    27. x1:=sqrt(y1);
    28. x2:=(-x1);
    29. Label5.Caption:='X1 ='+FloatToStr(x1)+chr(13)+'X2 ='+FloatToStr(x2);
    30. end
    31. else if (y2>=0) then
    32. begin
    33. x1:=sqrt(y2);
    34. x2:=(-x1);
    35. Label5.Caption:='X1 ='+FloatToStr(x1)+chr(13)+'x2 ='+FloatToStr(x2);
    36.  
    37. end;
    38. end;
    39. end;
    40. end.
    --------------------------------------------------------------------------------
    Добавлено сообщение
    --------------------------------------------------------------------------------
    С 0 разобрался,а вот почему не выводит 4 корня?
    Последний раз редактировалось Conner; 15.07.2009 в 17:30. Причина: Добавлено новое сообщение

  2. По умолчанию

     
    Хотите избавиться от рекламы? Зарегистрируйтесь
  3. #2
    dummy ivan! is on a distinguished road
    Регистрация
    16.07.2009
    Адрес
    St. Petersburg
    Возраст
    27
    Сообщений
    8
    Вес репутации
    0

    По умолчанию Re: Где ошибка?

    Давай сначала решим аналитически:

    Значит, количество корней зависит от двух условий - что дискриминант больше, меньше или равен нулю и что все подкоренное выражение б, м или р нулю.
    ] D - дискриминант; t1,t2 - корни
    Тогда условия на корни выглядят так:
    4 корня: D > 0 and t1 > 0 and t2 > 0
    3 корня: D > 0 and (t1 > 0 and t2 = 0 or t1 = 0 and t2 > 0)
    2 корня: D = 0 and t1 > 0
    1 корень: D = 0 and t1 = 0
    0 корней: D = 0 and t1 < 0 or D < 0 or D > 0 and t1 < 0 and t2 < 0
    Код :
    1. procedure solve(a,b,c: real; var count: integer; var roots: array of integer);
    2. var
    3.   D, sD: real;
    4.   t1, st1: real;
    5.   t2, st2: real;
    6. begin
    7.   D:= b*b - 4 * a * c;
    8.   if D > 0 then
    9.   begin
    10.     sD:= sqrt(D)
    11.     t1:= 0.5 * (-b + sD) / a;
    12.     t2:= 0.5 * (-b - sD) / a;
    13.     if t1 > 0 and t2 > 0 then
    14.     begin
    15.       count:= 4;
    16.       st1:= sqrt(t1);
    17.       st2:= sqrt(t2);
    18.       roots[1]:= st1;
    19.       roots[2]:= -st1;
    20.       roots[3]:= st2;
    21.       roots[4]:= -st2;  
    22.     end else
    23.     if t1 > 0 and t2 = 0 then
    24.     begin
    25.       count:= 3;
    26.       st1:= sqrt(t1);
    27.       roots[1]:= st1;
    28.       roots[2]:= -st1;
    29.       roots[3]:= 0;
    30.     end else
    31.     if t1 = 0 and t2 > 0 then
    32.       count:= 3;
    33.       st2:= sqrt(t2);
    34.       roots[1]:= 0;
    35.       roots[2]:= st2;
    36.       roots[3]:= -st2;
    37.     end else count:= 0;
    38.   end else
    39.   if D=0 then
    40.   begin
    41.     t1:= -0.5 * b / a;
    42.     if t1 > 0 then
    43.     begin
    44.       count:= 2;
    45.       st1:= sqrt(t1);
    46.       roots[1]:= st1;
    47.       roots[2]:= -st1;
    48.     end else
    49.     if t1 = 0 then
    50.     begin
    51.       count:= 1;
    52.       roots[1]:= 0;
    53.     end else
    54.       count:= 0;
    55.   end else
    56.     count:= 0;
    57. end;
    Не уверен, что будет работать, но я старался писал прямо здесь, в форуме поэтому не компилировал
    Последний раз редактировалось ivan!; 16.07.2009 в 22:52. Причина: Добавлено новое сообщение

+ Ответить в теме

Похожие темы

  1. В чем ошибка??
    Не могу понять, почему не работает... Многочлен состоит из одночленов типа k*x^a*y^b*z^c. Вылетает ошибка, если введу например...
    от _Kommandor_ в разделе задачи на Паскале и Delphi
  2. Ошибка
    Объясните,пожалуйста что мне делать,если у меня компьютер постоянно (когда ему захочется)выдает сообщение: "Система завершает работу.сохраните...
    от Альбина в разделе Операционные системы
  3. В чём ошибка?
    Подскажите В чём ОШИБКА? unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, ...
    от scorpi.on в разделе Delphi и Pascal
  4. ошибка IIS
    Здравствуйте! На сервере, где поднят IIS, в журнале событий системы постоянно появляется одно и то же предупреждение: источник V3SVC, код - 100 "не...
    от Rinne в разделе Apache, IIS...
  5. Ошибка
    Failed sending email :: PHP :: DEBUG MODE Line : 235 File : /home/developingru/www/forum/includes/emailer.php
    от DeeJayC в разделе Жалобная книга

Ваши права

  • Вы не можете создавать новые темы
  • Вы не можете отвечать в темах
  • Вы не можете прикреплять вложения
  • Вы не можете редактировать свои сообщения