VPF::[Delphi] Решить кубическое уравнение

BorisON

Дата 27.5.2007, 12:50 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 27.5.2007

Репутация: нет
Всего: нет

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

Код


  begin
    a:=strtofloat(edit1.text);
    b:=strtofloat(edit2.text);
    c:=strtofloat(edit3.text);
    Q:=(a*a-3*b)/9;
    R:=(2*a*a*a-9*a*b+27*c)/54;
    if R*r<q*q*q  then
      begin
        t:=arccos(R/sqrt(q*q*q))/3;
        x1:=-2*sqrt(q)cos(t)-a/3;
        x2:=-2*sqrt(q)cos(t+(2*pi/3))-a/3;
        x3:=-2*sqrt(q)cos(t-(2*pi/3))-a/3;
      end
    else
      begin
      end;
end;

Это сообщение отредактировал(а) BorisON - 27.5.2007, 12:58

ne0n

Дата 27.5.2007, 13:23 (ссылка)

(голосов:1)

Загрузка ...

PlayBoy

Профиль
Группа: Участник
Сообщений: 733
Регистрация: 5.8.2005
Где: Н.Новгород

Репутация: нет
Всего: 11

А что конкретно не правильно? Там же кусок кода приведен?

--------------------

http://sa-sec.org
как я вам? smile

BorisON

Дата 27.5.2007, 13:26 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 27.5.2007

Репутация: нет
Всего: нет

ну как бы так мягко сказать, мне нужно в дельфи, а в С+ я ваще не шарю)

BorisON

Дата 27.5.2007, 13:24 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 27.5.2007

Репутация: нет
Всего: нет

также у меня есть исходники (нашёл в интернете)
я там вообще принцип нахождения не понимаю

Код


function Y(X:real):real;
begin
Y:=A*X*X*X+B*X*X+C*X+D;
end;
begin
  A:=StrToFloat(Form1.Edit1.Text);
  B:=StrToFloat(Form1.Edit2.Text);
  C:=StrToFloat(Form1.Edit3.Text);
  D:=StrToFloat(Form1.Edit4.Text);
  K:=0;
  M:=1;
  if Y(K-M)*Y(K+M)>=0 then
             repeat  M:=M*2;
             until Y(K-M)*Y(K+M)<0;
  Z1:=K-M;
  Z2:=K+M;
  Z0:=(Z1+Z2)/2;
  N:=Round(Ln(2*M/DX)/Ln(2));
  for I:=1 to N do
  begin
     if Y(Z1)*Y(Z0)<=0 then  Z2:=Z0
                       else  Z1:=Z0;
     Z0:=(Z1+Z2)/2;
  end;
  X1:=Z0;
  if Sqr(B+A*Z0)-4*A*(C+B*Z0+A*Z0*Z0)>0 then
  begin
    X2:=(-B-A*Z0+Sqrt(Sqr(B+A*Z0)-4*A*(C+B*Z0+A*Z0*Z0)))/2/A;
    X3:=(-B-A*Z0-Sqrt(Sqr(B+A*Z0)-4*A*(C+B*Z0+A*Z0*Z0)))/2/A;
    Form1.Label8.Caption:='X1 = '+FloatToStrF(X1,ffFixed,24,15);
    Form1.Label9.Caption:='X2 = '+FloatToStrF(X2,ffFixed,24,15);
    Form1.Label10.Caption:='X3 = '+FloatToStrF(X3,ffFixed,24,15);
  end
  else
  begin
    P:=(-B-A*Z0)/2/A;
    Q:=(Sqrt(-Sqr(B+A*Z0)+4*A*(C+B*Z0+A*Z0*Z0)))/2/A;
    Form1.Label8.Caption:='X1 = '+FloatToStrF(X1,ffFixed,24,15);
    Form1.Label9.Caption:='X2 = '+FloatToStrF(P,ffFixed,24,15)+
    ' + i * '+FloatToStrF(Q,ffFixed,24,15);
    Form1.Label10.Caption:='X3 = '+FloatToStrF(P,ffFixed,24,15)+
    ' - i * '+FloatToStrF(Q,ffFixed,24,15);
  end;
end;

Это сообщение отредактировал(а) BorisON - 27.5.2007, 13:30

ne0n

Дата 27.5.2007, 13:45 (ссылка)

(нет голосов)

Загрузка ...

PlayBoy

Профиль
Группа: Участник
Сообщений: 733
Регистрация: 5.8.2005
Где: Н.Новгород

Репутация: нет
Всего: 11

Код


function Cubic(x:double, a:double, b:double,c:double):integer;
var
 aa,bb,t,q,r,r2,q3: double;
begin
  q:=(a*a-3*b)/9.; r=(a*(2*a*a-9*b)+27*c)/54.;
  r2:=r*r; q3=q*q*q;
  if(r2<q3) then
 begin
    t:=arccos(r/sqrt(q3));
    a:=a/3; q:=-2*sqrt(q);
    x[0]=q*cos(t/3)-a;
    x[1]=q*cos((t+M_2PI)/3)-a;
    x[2]=q*cos((t-M_2PI)/3)-a;
   result:=3;
  end;
  else 
  begin
    if(r<=0) then  r:=-r;
    aa:=-pow(r+sqrt(r2-q3),1/3); 
    if(aa<>0) then bb:=q/aa;
    else bb:=0.;
    a:=a/3; q:=aa+bb; r:=aa-bb; 
    x[0]:=q-a;
    x[1]:=(-0.5)*q-a;
    x[2]:=(sqrt(3)*0.5)*abs(r);
    if(x[2]=0) then result:=2;
    result:=1;
 end;
end;

Вроде перевел, правдо сходу,так что наверно есть ошиПки, да не забудь массивчик x завести!

--------------------

http://sa-sec.org
как я вам? smile

BorisON

Дата 27.5.2007, 14:18 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 27.5.2007

Репутация: нет
Всего: нет

спасибо за перевод
теперь следующие вопросы, Х вводить глобальной переменной через type?
arccos delphi отказывается понимать...
а так вроде правлю ошибки

Это сообщение отредактировал(а) BorisON - 27.5.2007, 14:19

Yanis

Дата 27.5.2007, 21:28 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 4
Всего: 111

Цитата(BorisON @ 27.5.2007, 15:18

)

arccos delphi отказывается понимать...

F1 нажми, установив курсор на это слово.
Чувствую себя глупым, когда даю такие советы…
С другой стороны, автор должен чувствовать себя ещё глупее ))

P. S. Надо подключить модуль Math.

--------------------

*щёлк*

ne0n

Дата 28.5.2007, 16:11 (ссылка)

(нет голосов)

Загрузка ...

PlayBoy

Профиль
Группа: Участник
Сообщений: 733
Регистрация: 5.8.2005
Где: Н.Новгород

Репутация: нет
Всего: 11

Цитата(BorisON @ 27.5.2007, 14:18

)

теперь следующие вопросы, Х вводить глобальной переменной через type?

Зачем? Какой нафиг type? этож обычный массивчик на три элемента! X-надо делать глобальным(для железноголовых поясняю var находиться после public)!Но это только в том случии если тебе нужна информация о том какие корни получил!

Это сообщение отредактировал(а) ne0n - 28.5.2007, 16:15

--------------------

http://sa-sec.org
как я вам? smile

Alexeis

Дата 28.5.2007, 16:35 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 23
Всего: 459

Для домашних заданий, курсовых, существует "Центр Помощи".

Тема перенесена!

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

BorisON

Дата 31.5.2007, 16:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 27.5.2007

Репутация: нет
Всего: нет

ладно, мы не ищемпростых путей)
извиняюсь за туповство

Код


begin
a:=strtofloat(edit1.text);
    b:=strtofloat(edit2.text);
    c:=strtofloat(edit3.text);
    d:=strtofloat(edit9.text);
    p:=-(b*b)/(3*a)+c/a;
    q:=(2*b*b*b)/(27*a*a*a)-(b*c)/(3*a*a);
    //----------------------íàâåðíî íå ïðàâëüíî-----------------
    a1:=(-q/2)+sqrt((q*q)/4+(p*p*p)/27);
    a1:=exp((1/3) * ln(a1));
    b1:=(-q/2)-sqrt((q*q)/4+(p*p*p)/27);
    b1:=exp((1/3) * ln(b1));
    //---------------------------------------------------------
    if (q*q)/4+(p*p*p)/27>0 then
      begin
        x1:=a1+b1;
        x2:=-0.5*(a1+b1)+(sqrt(3)/2)*(a1-b1);
        x3:=-0.5*(a1+b1)-(sqrt(3)/2)*(a1-b1);
      end
      else if  (q*q)/4+(p*p*p)/27=0 then
      begin
        x1:=2*a1;
        x2:=-a1;
        x3:=-a1;
      end
      else
      showmessage('ââåäèòå êîððåêòíûå äàííûå');

label14.Caption := floattostr(x1);
label15.Caption := floattostr(x2);
label16.Caption := floattostr(x3);
      end;

вот код, у выходит ошибка imvalid floating point operation в очередной раз прошу помощи

Это сообщение отредактировал(а) BorisON - 31.5.2007, 16:24

ne0n

Дата 1.6.2007, 15:58 (ссылка)

(нет голосов)

Загрузка ...

PlayBoy

Профиль
Группа: Участник
Сообщений: 733
Регистрация: 5.8.2005
Где: Н.Новгород

Репутация: нет
Всего: 11

Ну тык запустил бы по шагово, да и посмотрел бы где у тебя вылетает!

--------------------

http://sa-sec.org
как я вам? smile

murder

Дата 7.8.2010, 19:09 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 7.8.2010

Репутация: нет
Всего: нет

Вот код, который решает уравнение A*x^3+B*x^2+C*x+D=0.
Действительные корни записываются в переменные x, x2, x3.

Код


procedure CubicSolver(A,B,C,D: single);
  var
    E,F,G: single;
  begin
      A:=1/A;
      B:=B*A;
      C:=C*A;
      D:=D*A;

      F:=abs(B);
      if F<abs(C) then
          F:=abs(C);
      if F<abs(D) then
          F:=abs(D);
      F:=F+1;

      x:=0;
      repeat
          E:=  x+B;
          G:=E*x+C;
          if G*x+D<0 then
              x:=x+F;
          F:=F*0.5;
          x:=x-F;
      until F=0;

      E:=E*(-0.5);
      G:=E*E-G;

      x2:=0;
      x3:=0;
      if G>0 then
      begin
          F :=sqrt(abs(G));
          x2:=E-F;
          x3:=F+E;
      end;
  end;

Взято отсюда

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »