Board index » delphi » Equations and log

Equations and log

Hi!

I am currently writing a program in Turbo Pascal 7.0 that solves equations.
I am having problems with the procedure that calculates the x for f(x)=0.
I'm using a repeat-loop, that increments the x for each loop and calculates
f(x). However, the loop does not stop when f(x) is 0. If anyone could help
me with this, I would be greatful.

(Procedure Polydiv(a,b,c,d:Real)

Thanks

--PROGRAM--

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;
  If ((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d)<>0 Then
  Begin
    GotoXY(3,21);
    Write('Calculating...');
    Repeat
      t:=t+0.00000001;
      r:=a*(t*t*t)+b*(t*t)+(c*t)+d;
      GotoXY(3,22);
      Write(r:0:des);
    Until r=0;
  End;
  Ans[1]:=t;
  GotoXY(3,21);
  Write('X=',Ans[1]:0:des,'          ');
  GotoXY(2,22);
  Write('                                                        ');
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;

Begin
  Third_Equa;
End.

 

Re:Equations and log


The repeat-until is looking for r = 0 which it may never find as r is
derived from r:=a*(t*t*t)+b*(t*t)+(c*t)+d
which will only give r = 0 if a = b = c = d = 0 and no rounding errors occur
in the maths.

Similar thing was "solved" by having r = 0 replaced by r  being between
+0.0001 and - 0.0001 At the time it was left working and the reason for the
rounding was never investigated.

Bernard

Quote
"Bendik Eide" <mic-e...@online.no> wrote in message

news:zJCI5.12157$W31.180044@news1.online.no...
Quote
> Hi!

> I am currently writing a program in Turbo Pascal 7.0 that solves
equations.
> I am having problems with the procedure that calculates the x for f(x)=0.
> I'm using a repeat-loop, that increments the x for each loop and
calculates
> f(x). However, the loop does not stop when f(x) is 0. If anyone could help
> me with this, I would be greatful.

> (Procedure Polydiv(a,b,c,d:Real)

> Thanks

> --PROGRAM--

> 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;
>   If ((a*(Sqr(t)*t))+(b*(Sqr(t)))+(c*t)+d)<>0 Then
>   Begin
>     GotoXY(3,21);
>     Write('Calculating...');
>     Repeat
>       t:=t+0.00000001;
>       r:=a*(t*t*t)+b*(t*t)+(c*t)+d;
>       GotoXY(3,22);
>       Write(r:0:des);
>     Until r=0;
>   End;
>   Ans[1]:=t;
>   GotoXY(3,21);
>   Write('X=',Ans[1]:0:des,'          ');
>   GotoXY(2,22);
>   Write('                                                        ');
> 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;

> Begin
>   Third_Equa;
> End.

Re:Equations and log


Quote
Bernard Green <Syemon...@btinternet.com> wrote:
> The repeat-until is looking for r = 0 which it may never find as r is
> derived from r:=a*(t*t*t)+b*(t*t)+(c*t)+d
> which will only give r = 0 if a = b = c = d = 0 and no rounding errors occur
> in the maths.

Well, it'll also give zero if a, b, c, d solve the indicated cubic equation
(which after all is the whole point).

Quote
> Similar thing was "solved" by having r = 0 replaced by r  being between
> +0.0001 and - 0.0001 At the time it was left working and the reason for the
> rounding was never investigated.

Simple: except for some very basic calculations, irreducible roundoff errors
(such as the fact that a number like 0.1 cannot be exactly represented in
binary) usually mean that calculations on real-type (i.e. non-integer)
numbers will almost never produce a result *exactly* equal to zero, even
with the desired combination of inputs.

However, a code fragment like "if x = 0 then..." will check only for x
precisely equal to zero. If x is 0.00000000000000000001, the condition is
false. So for this situation we often use constructions like

  if abs(x) < 1e-8 then...

where the limit is chosen to be small enough that non-optimal inputs will
cause x to be larger than this value; if you're stepping your inputs with
increments of 0.1, a limit of 1e-5 would probably do (unless your function
is very slow-changing). If you're using increments of 1e-7, you probably
want a limit of something like 1e-10 or 1e-12 (and you'll need to use double
precision or better).

However, for an application like this it seems to me to be much better to
implement something like Newton-Raphson method - this will make the process
of finding roots much quicker, although care will have to be taken to deal
with special cases (if this is unsatisfactory, binary search could be
implemented; best might be a combination of the two).

Try this program:

program notquitezero;
var x1, x2: real;

begin
  x1 := 5;
  x2 := 0.2;
  writeln(x1*x2 - 1 = 0);
  writeln(5*x2 - 1 = 0);
  writeln(x1*0.2 - 1 = 0);
end.

This gives the output:
FALSE
FALSE
TRUE

with the first two examples evaluating to about 2.27e-13 (with double
precision this becomes 5.55e-17; with extended all evaluate to 0).

--
______________________________________________________________________
     The Scarlet Manuka,      |        Nitpickers' Party motto:
  Pratchett Quoter At Large,  |  "He who guards his lips guards his
 First Prophet of Bonni, is:  |  soul, but he who speaks rashly will
   sa...@maths.uwa.edu.au     |    come to ruin." -- Proverbs 13:3
______________________________|_______________________________________

Other Threads