# 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=');
GotoXY(3,13);
Write('b=');
GotoXY(3,15);
Write('c=');
Seconddegree(inequa[1],inequa[2],inequa[3]);
GotoXY(60,4);
Write('Again? [Y/N]: ');
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=');
GotoXY(3,12);
Write('b=');
GotoXY(3,14);
Write('c=');
GotoXY(3,16);
Write('d=');
Polydiv(inequa[1],inequa[2],inequa[3],inequa[4]);
GotoXY(60,4);
TextBackground(\$0);
Write('Again? [Y/N]: ');
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=');
>     GotoXY(3,13);
>     Write('b=');
>     GotoXY(3,15);
>     Write('c=');
>     Seconddegree(inequa[1],inequa[2],inequa[3]);
>     GotoXY(60,4);
>     Write('Again? [Y/N]: ');
>     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=');
>     GotoXY(3,12);
>     Write('b=');
>     GotoXY(3,14);
>     Write('c=');
>     GotoXY(3,16);
>     Write('d=');
>     Polydiv(inequa[1],inequa[2],inequa[3],inequa[4]);
>     GotoXY(60,4);
>     TextBackground(\$0);
>     Write('Again? [Y/N]: ');
>     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
______________________________|_______________________________________