I am still trying to write this program that solves 3. degree equations.
However, the program will only find some of the possible solutions. It
should be able to find them all...

If anyone could rewrite this code so it would work properly, it would help
me alot!

Thanks in advance...

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

Program Equation;
Uses Crt;
Const Des=5;

Var
  inequa:Array[0..4] Of Real;
  ch:Char;
  ok:Boolean;

Procedure FilledBox(x1,y1,x2,y2,color:Byte);
Var
  i:Integer;
  x,y:Integer;
  Screen:Array[0..3999] Of Byte Absolute $b800:0000;
Begin
  TextBackground(color);
  If y1=y2 Then
  Begin
    GotoXY(x1,y1);
    For i:=x1 To x2 Do Write(' ');
  End
  Else
  Begin
  GotoXY(x1,y1);
  For y:=y1 To y2 Do For x:=x1+1 To x2-1 Do
  Begin
    GotoXY(x,y);
    Write(' ');
  End;
  GotoXY(x1,y1);
  Write('');
  For i:=x1 To x2-2 Do Write('?');
  Write('?');
  For i:=y1+1 To y2-1 Do
  Begin
    GotoXY(x1,i);
    Write('3');
    GotoXY(x2,i);
    Write('3');
  End;
  GotoXY(x1,y2);
  Write('');
  For i:=x1 To x2-2 Do Write('?');
  If (x2=80) And (y2=25) Then
  Begin
    Screen[3998]:=Ord('');
    Screen[3999]:=TextAttr;
  End
  Else Write('');
  End;
End;

Procedure Seconddegree(a,b,c:Real);
Var
  Ans:Array[0..2] Of Real;
  Test:Real;
Begin
  TextBackground(0);
  Test:=(Sqr(b))-(4*a*c);

  If Test<0 Then
  Begin
    GotoXY(3,22);
    Write('Square root of a negative number does not exist - can''t solve
equation!');
    Exit;
  End;

  If a=0 Then
  Begin
    GotoXY(3,22);
    Write('Can''t divide by zero - impossible to solve equation!');
    Exit;
  End;

  Ans[1]:=(-b+Sqrt((Sqr(b))-(4*a*c)));
  Ans[1]:=Ans[1] / (2*a);
  Ans[2]:=(-b-Sqrt((Sqr(b))-(4*a*c)));
  Ans[2]:=Ans[2] / (2*a);

  If Ans[1]=Ans[2] Then
  Begin
    GotoXY(3,23);
    Writeln('X=',Ans[1]:0:des);
  End
  Else If Frac(Ans[1])=0 Then
  Begin
    GotoXY(3,21);
    Writeln('X=',Ans[1]:0:0);
    GotoXY(3,23);
    If Frac(Ans[2])=0 Then Writeln('X=',Ans[2]:0:0)
    Else Writeln('X=',Ans[2]:0:des);
  End
  Else If Frac(Ans[2])=0 Then
  Begin
    GotoXY(3,21);
    If Frac(Ans[1])=0 Then Writeln('X=',Ans[1]:0:0)
    Else Writeln('X=',Ans[1]:0:des);
    GotoXY(3,23);
    Writeln('X=',Ans[2]:0:0);
  End
  Else
  Begin
    GotoXY(3,21);
    Writeln('X=',Ans[1]:0:des);
    GotoXY(3,23);
    Writeln('X=',Ans[2]:0:des);
  End;
End;

Procedure Second_Equa;
Begin
  Repeat
    FilledBox(1,1,80,8,0);
    FilledBox(1,9,80,18,4);
    FilledBox(1,19,80,25,0);
    GotoXY(3,3);
    Write('SECOND-DEGREE EQUATION');
    GotoXY(3,6);
    Write('axy+bx+c=0');
    TextBackground($4);
    GotoXY(3,11);
    Write('a=');
    Readln(inequa[1]);
    GotoXY(3,13);
    Write('b=');
    Readln(inequa[2]);
    GotoXY(3,15);
    Write('c=');
    Readln(inequa[3]);
    Seconddegree(inequa[1],inequa[2],inequa[3]);
    GotoXY(60,4);
    Write('Again? [Y/N]: ');
    ch:=ReadKey;
    ch:=UpCase(ch);
    ok:=ch In ['N'];
  Until ok;
End;

Procedure Polydiv(a,b,c,d:Real);
Var
  Ans:Array[0..3] Of Real;
  r,t:Real;
Begin
  TextBackground($0);
  t:=0;
  GotoXY(3,24);
  Write('Please wait while calculating using highest precision...');
  If ((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d)<>0 Then
  Begin
    Repeat
      t:=t+(0.01);
      r:=((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d);
    Until (r<0.0005) And (r>-0.0005) Or (t>1000);
    If t<1000 Then Ans[1]:=t
    Else If (t>1000) Then
    Begin
      t:=0;
      Repeat
        t:=t-(0.01);
        r:=((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d);
      Until (r<0.0005) And (r>-0.0005) Or (t<-1000);
      If t<-1000 Then Ans[1]:=9997
      Else Ans[1]:=t;
    End;
  End;
  t:=0;
  If ((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d)<>0 Then
  Begin
    Repeat
      t:=t+(0.01);
      r:=((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d);
    Until ((r<0.0005) And (r>-0.0005) And (t<>Ans[1])) Or (t>1000);
    If t<1000 Then Ans[2]:=t
    Else If t>1000 Then
    Begin
      t:=0;
      Repeat
        t:=t-(0.01);
        r:=((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d);
      Until ((r<0.0005) And (r>-0.0005) And (t<>Ans[1])) Or (t<-1000);
      If t<-1000 Then Ans[2]:=9998
      Else Ans[2]:=t;
    End;
  End;
  t:=0;
  If ((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d)<>0 Then
  Begin
    Repeat
      t:=t+(0.01);
      r:=((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d);
    Until ((r<0.0005) And (r>-0.0005) And (t<>Ans[1]) And (t<>Ans[2])) Or
(t>1000);
    If t<1000 Then Ans[3]:=t
    Else If t>1000 Then
    Begin
      t:=0;
      Repeat
        t:=t-(0.01);
        r:=((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d);
      Until ((r<0.0005) And (r>-0.0005) And (t<>Ans[1]) And (t<>Ans[2])) Or
(t<-10000);
      If t<-1000 Then Ans[3]:=9999
      Else Ans[3]:=t;
    End;
  End;
  GotoXY(3,20);
  If Ans[1]<>9997 Then Write('X=',Ans[1]:0:des)
  Else Write('X does not exist!');
  GotoXY(3,21);
  If Ans[2]<>9998 Then Write('X=',Ans[2]:0:des)
  Else Write('X does not exist!');
  GotoXY(3,22);
  If Ans[3]<>9999 Then Write('X=',Ans[3]:0:des)
  Else Write('X does not exist!');
  GotoXY(3,24);
  Write('CALCULATION COMPLETE!
');
End;

Procedure Third_Equa;
Begin
  Repeat
    TextColor($F);
    FilledBox(1,1,80,8,0);
    FilledBox(1,9,80,17,4);
    FilledBox(1,18,80,25,0);
    GotoXY(3,3);
    Write('THIRD-DEGREE EQUATION');
    GotoXY(3,6);
    Write('ax+bxy+cx+d=0');
    TextBackground($4);
    GotoXY(3,10);
    Write('a=');
    Readln(inequa[1]);
    GotoXY(3,12);
    Write('b=');
    Readln(inequa[2]);
    GotoXY(3,14);
    Write('c=');
    Readln(inequa[3]);
    GotoXY(3,16);
    Write('d=');
    Readln(inequa[4]);
    Polydiv(inequa[1],inequa[2],inequa[3],inequa[4]);
    GotoXY(60,4);
    TextBackground($0);
    Write('Again? [Y/N]: ');
    ch:=ReadKey;
    ch:=UpCase(ch);
    ok:=ch In ['N'];
  Until ok;
End;

"Bendik Eide" <mic-e...@online.no> schrieb im Newsbeitrag
Hi

news:CSVK5.2417$Yy1.45204@news1.online.no...

you might try it this way : let f be f(x) := ax^3+bx^2+cx+d

1. create derivation =>  f' : f'(x) := 3a  x^2 + 2*b x  + c

2. solve f'(x) = 0  to get local min/max l1,l2 (0-2)

3. think of some special cases!
(eg: no solution:  you then only have to find x1 and x2 with sgn(f(x1))<>sgn(f(x2)))

4. now you know the intervals, where to find the solutions (if there)
and can find them by decreasing the range (in german: intervallschachtelung)

a new idea, probably more easy to implement.

the idea:
f(x) := ax^3+bx^2+cx+d;

1. find x0 with f(x0)=0; (there must be at least one, if a<>0 )

2. perform a polynomdivision f/(x-x0)

3. you should get : g(x) := px^2 + qx + e

    p = a
    q = b+ax0
    r = c+ bx0 + ax0^2

 (i'm not really sure! take a piece of paper and check!!!)

4. there should be no problem to solve g=0;

but how to find x0 :

my idea / (quick and dirty)

eps := 1.0E-8;
p := -1.0
q := 1.0;

while sgn(f(p))=sgn(f(q)) do
   p:=p*2; q:=q*2;

repeat
  m := (p+q)/2;
  x0 := f(m);
  if sgn(x0) = sgn(p) then p := m else q := m;
until abs(p-q)<eps;

just the idea - NOT tested!

Robert
--
Robert AH Prins
pr...@bigfoot.com

I will second what Robert Prins said. However, if you understand
some algebra (e.g. complex numbers), you may be able to fill in
the details into the following algorithm that solves the cubic.

1) Divide the equation to have a leading coefficient equal to 1, i.e
put the equation into the form

x^3+ a*x^2+b*x+c=0

2) Substitute x:=z-(a/3) to get an equation of the form

z^3+p*z+q=0

(here p and q are complicated formulas involving a,b,c)

3) Substitute z:=u+v. This a solution of the previous equation,
if u and v satisfy the following pair of equations:

u^3+v^3=-q, uv=-p/3

4) u^3 and v^3 are the roots of the quadratic equation

0=T^2+q*T+(-p/3)^3

So you must first work your way down to step 2 and then
work from step 4 up! Once you have solved for u^3 and v^3
you must use the complex cubic roots to solve for u and v
themselves. (Observe that once you have u, v is gotten
from the equation uv=-p/3)

The catch is that you must use complex cubic roots in order
to get all 3 solutions.

--
Jyrki Lahtonen, Ph.D.
Department of Mathematics,
University of Turku,
FIN-20014 Turku, Finland

--
Jyrki Lahtonen, Ph.D.
Department of Mathematics,
University of Turku,
FIN-20014 Turku, Finland

--
Jyrki Lahtonen, Ph.D.
Department of Mathematics,
University of Turku,
FIN-20014 Turku, Finland