10REM NON-LINEAR EQUATIONS
20REM v.2.1(Engl) for 8-Bit Software
30REM by M.Bobrowski 8'91
40:
50MODE6:HIMEM=&5800:PROCstart:PROCint
ro:*FX229,1
60ONERRORPROCerr
70VDU22,6:PROCformula
80VDU22,4:PROCenter:PROCaxes
90ON ERROR GOTO 220
100V=EVAL(F$)
110X=X+C
120Y=EVAL(F$):IF SGNY<>SGNV Z%=Z%+1:IF
X-C<>P:IFABS(Y-V)<(maxy-miny):PRINT;X;",
";:P=X
130IF yo+V*sy>1040 OR yo+V*sy<200 THEN
250
140MOVE X%,yo+V*sy:IF yo+Y*sy>1040 OR
yo+Y*sy<200 THEN 250
150DRAW X%+4,yo+Y*sy:V=Y:X%=X%+4:IF X%
<1280 THEN 110
160PROCfin:PROCwhat:IFQ%=2THEN80:ELSEI
FQ%=3THEN70:ELSEIFQ%=4:OSCLI"FX229":VDU2
2,7,10:END
170VDU22,6:ONERROR PROCerr
180PROCcalc:REPEAT:PROCmain:UNTILO%=5O
RO%=3:IFO%=3THEN80
190*FX229,0
200END
210:
220IFERR>17ANDERR<25:ELSEVDU22,6:PROCc
en("f(X)="+F$,16):PROCerr:GOTO70
230ON ERROR OFF
240ON ERROR GOTO 220
250X=X+C:X%=X%+4:IF X%>1280 THEN 160
260V=EVAL(F$):GOTO120
270:
280DEFPROCformula:PRINTTAB(0,20)"Note:
the formula for f(X) must satisfy requi
rements for a BASIC expression":INPUTTAB
(0,4)"Enter formula for f(x) in terms of
X"''" f(X)="F$:F$=FNcase(F$):IFINSTR(F$
,"X")=0K%=1
290IFK%=1:PROCerr:CLS:K%=0:PROCformula
300ENDPROC
310DEFPROCenter:VDU28,0,31,39,25,12,24
,0;224;1279;1023;16,19,0,4;0;19,1,3;0;:P
RINT"f(X)=";F$:REPEAT:INPUT'"Enter minim
um X value : "minx:INPUT'"Enter maximum
X value : "maxx:IF maxx<=minx PRINT'"Not
e: Xmax must be greater than Xmin."CHR$7
320UNTILmaxx>minx:REPEAT:INPUT'"Enter
minimum Y value : "miny:IF miny>=0 PRINT
'"Note: Ymin must be a negative number."
CHR$7
330UNTIL miny<0:REPEAT:INPUT'"Enter ma
ximum Y value : "maxy:IF maxy<=0 PRINT'"
Note: Ymax must be a positive number."CH
R$7
340UNTILmaxy>0:C=(maxx-minx)/320:Z%=0:
X%=0:X=minx:P=minx-C:@%=&20A:CLS:PRINTTA
B(0,1)"Function : "F$;TAB(0,3)"f(X)=0 wh
en X=";:ENDPROC
350DEFPROCaxes:sx=1280/(maxx-minx):sy=
800/(maxy-miny):IF maxx>0 xo=1280-maxx*s
x:ELSE xo=0
360IF xo<0 xo=0
370yo=224-miny*sy:IF sx<64 hx=128 ELSE
hx=sx
380IF sy<40 hy=80 ELSE hy=sy
390IF xo=0 FOR J%=0 TO 1280 STEP hx:MO
VE J%,yo-4:DRAW J%,yo+4:NEXT:ELSE FOR J%
=xo TO 0 STEP -hx:MOVE J%,yo-4:DRAW J%,y
o+4:NEXT:FOR J%=xo TO 1280 STEP hx:MOVE
J%,yo-4:DRAW J%,yo+4:NEXT
400FOR J%=yo TO 224 STEP -hy:MOVE xo-4
,J%:DRAW xo+4,J%:NEXT:FOR J%=yo TO 1024
STEP hy:MOVE xo-4,J%:DRAW xo+4,J%:NEXT:M
OVE 0,224:DRAW 0,1023:DRAW 1279,1023:DRA
W 1279,224:DRAW 0,224:MOVE 0,yo:DRAW 128
0,yo:IF minx<=0 MOVE xo,224:DRAW xo,1024
410ENDPROC
420DEFPROCfin:VDU5:MOVE 16,yo-16:PRINT
;minx:nx=1264-32*LEN(LEFT$(STR$(maxx),4)
):MOVE nx,yo-16:IF xo<nx PRINT;maxx
430IF xo<>0 MOVE xo+16,yo+48:PRINT"0"
440MOVE xo+16,1008:PRINT;maxy:MOVE xo+
16,256:PRINT;miny:@%=&90A:VDU7,4:IFZ%>0V
DU127,127:PRINT:ELSEPRINTTAB(0,3)"No zer
oes of the function within this"'"X rang
e. Try to examine another X range."
450PRINT'"Press any key to continue ";
:REPEATUNTILGET:ENDPROC
460DEFPROCmain:IFo%=0PROCmethod:ENDPRO
C:ELSEPROCkeys
470IFO%=1PROCchange:ELSEIFO%=2PROCmeth
od:ELSEIFO%=4 RUN
480ENDPROC
490DEFPROCmethod:PRINT'"There are thre
e methods available :"''" 1. Newton-Rap
hson's method"'" 2. Bisection method"'"
3. Regula falsi"''"Which one do you ch
oose ? ";:REPEATM%=GET-48:UNTILM%>0ANDM%
<4:PRINT;M%:IFo%=0o%=M%:PROCinput:ENDPRO
C
500IFM%>1ANDo%=1:PROCrange:ELSEIFM%>1A
=a:B=b
510IFM%=1ANDo%>1PROCinitx:ELSEIFM%=1X=
x
520o%=M%:PROCcalc:ENDPROC
530DEFPROCinput:PROCaccur:IFM%=1PROCin
itx:ELSEPROCrange
540PROCcalc:ENDPROC
550DEFPROCcalc:IFo%=0ENDPROC:ELSEx=X
560K%=0:I%=0:IFM%=1PROCnewton:ELSEIFM%
=2PROCbisect:ELSEPROCillinois
570CLS:IFK%=0PROCresultELSEVDU7:PROCfa
il
580ENDPROC
590DEFPROCnewton:H=1E-6:IFFNf(X)=0ENDP
ROCELSEIFFNp(X)=0K%=2:ENDPROC
600s%=FALSE:REPEAT:z=X-FNf(X)/FNp(X):I
FABS(z-X)<=ETHENs%=TRUEELSEX=z:I%=I%+1:I
FFNp(X)=0K%=3
610UNTILs%ORI%>20ORK%=3:IFI%>20K%=4
620ENDPROC
630DEFPROCbisect:IFFNf(A)=0X=A:ENDPROC
:ELSEIFFNf(B)=0X=B:ENDPROC:ELSEIFFNf(A)*
FNf(B)>0K%=5:ENDPROC
640REPEAT:X=(A+B)*.5:y=FNf(X):IFy<>0I%
=I%+1:IFy*FNf(A)<0B=XELSEA=X
650UNTILABS(B-A)<=E ORy=0ORI%>100:IFI%
>100K%=6
660ENDPROC
670DEFPROCillinois:IFFNf(A)=0X=A:ENDPR
OC:ELSEIFFNf(B)=0X=B:ENDPROC:ELSEIFFNf(A
)*FNf(B)>0K%=5:ENDPROC
680z=A:X=B:g=FNf(z):y=FNf(X):REPEAT:r=
X-y*(X-z)/(y-g):h=FNf(r):IFh*y<0z=X:g=yE
LSEg=g*0.5
690X=r:y=h:I%=I%+1:UNTIL ABS(X-z)<=E O
RABSy<=1E-38 ORI%>100:IFI%>100K%=6
700ENDPROC
710DEFPROCresult:PROCinfo:PRINT'CHR$7"
The solution of the equation :"''SPC4;F$
;"=0"''"is X=";X;:IFFNf(X)=0PRINT" (exac
t solution)":ELSEPRINTSPC6;"(approx.)"
720IFI%>0PRINT'"No. of iterations = ";
I%
730ENDPROC
740DEFPROCchange:PROCinfo:PRINT'"You m
ay change :"''TAB(2)"1. formula for f(x)
"'TAB(2)"2. accuracy":IFM%=1PRINTTAB(2)"
3. initial X value"ELSEPRINTTAB(2)"3. X
range"
750PRINT'"Enter choice (1-3) : ";:REPE
ATZ%=GET-48:UNTILZ%>0ANDZ%<4:PRINT;Z%:IF
Z%=1INPUT'"Enter : f(x)="F$:F$=FNcase(F$
):ELSEIFZ%=2PROCaccur
760IFM%=1X=xELSEA=a:B=b
770IFZ%=3ANDM%=1PROCinitx:ELSEIFZ%=3AN
DM%<>1:PROCrange
780PROCcalc:ENDPROC
790DEFPROCerr:FORJ%=1TO6:SOUND1,-7,150
,1:SOUND1,0,0,1:NEXT:VDU28,0,24,39,20,12
:IFERR>17ANDERR<25ANDM%=1PROCcen("*** Ch
ange Xo ! ***",0)ELSEIFERR>17ANDERR<25PR
OCcen("*** Change X Range ***",0)
800IFERR=26ORERR=27ORK%=1:VDU26:PROCce
n("Invalid expression used",20)
810REPORT:PRINT" AT ";ERL
820PRINT':v%=VPOS:PROCcen("Press any k
ey to continue",v%):REPEATUNTILGET:PRINT
TAB(0,v%)SPC39:ENDPROC
830DEFPROCfail:PROCcen("No evidence of
a solution.",3):IFK%=2PRINTTAB(2,5)"For
X=";X;" the derivative f'(X)=0"''TAB(2
)x$
840IFK%=3PROCcen(t$,5)
850IFK%=4PROCcen("Divergence ! "+t$,5)
:PROCcen("or increase value",7)
860IFK%=5PRINTTAB(2,5)"sign f(";A;") =
sign f(";B;")"''TAB(2)z$
870IFK%=6PROCcen("Increase value or
"+t$,5)
880ENDPROC
890DEFPROCaccur:PRINT'"Enter accuracy
(or press RETURN) :"''" =";:v%=VPOS:RE
PEATPRINTTAB(4,v%);SPC9:INPUTTAB(4,v%)E:
IFE=0THENE=1E-4:PRINTTAB(4,v%);E
900UNTILE>=1E-9ANDE<1:ENDPROC
910DEFPROCrange:PRINT'"Enter bounds fo
r X within which you hopeto find a solut
ion :":v%=VPOS+1:REPEATPRINTTAB(0,v%);SP
C39:INPUTTAB(2,v%)"X min : "A;TAB(19,v%)
"X max : "B:UNTILA<B:a=A:b=B:ENDPROC
920DEFPROCinitx:INPUT'"Enter initial X
value : Xo="X:x=X:ENDPROC
930DEFPROCkeys:VDU28,0,24,39,20,12:PRI
NTSTRING$(40,"-")"Press:";:PROCneg(77):P
RINT"to change the method,";:PROCneg(71)
:PRINT"to plota graph,";:PROCneg(80):PRI
NT"to change a single parameter,or";:PRO
Cneg(82):PRINT"to re-run the program, or
";
940PROCneg(81):PRINT"to exit";:VDU26:P
ROCcon:REPEATO%=INSTR("PpMmGgRrQq",GET$)
:UNTILO%:O%=(O%+1)DIV2:PROCcoff:CLS:PRIN
T':ENDPROC
950DEFPROCinfo:CLS:PRINT'"Method ";M%;
" (";:IFM%=1:PRINT"Newton-Ranson's)":ELS
EIFM%=2:PRINT"Bisection)":ELSEPRINT"Regu
la falsi)"
960PRINT'SPC3;"f(X)=";F$''" =";E;:IFM%
=1:PRINTTAB(19)"Xo=";x:ELSEPRINTTAB(10)"
X range : [";a;",";b;"]"
970PRINT'STRING$(40,"-"):ENDPROC
980DEFPROCwhat:CLS:PRINT'"Press:";:PRO
Cneg(71):PRINT"to change graph coordinat
es,"':COLOUR129:COLOUR0:PRINT"SPACE";:CO
LOUR128:COLOUR1:PRINT" to pass to the ne
xt part of the"''"program,";:PROCneg(70)
:PRINT"to change formula,";:PROCneg(81):
PRINT"to exit ";:REPEATQ%=INSTR(" GgFfQ
q",GET$):UNTILQ%:Q%=(Q%+1)DIV2:ENDPROC
990DEFPROCintro:PROCcen("NON-LINEAR EQ
UATIONS",7):PRINT''"The program plots an
y function Y=f(X)"'"within required X ra
nge(s), then finds an approximate solut
ion of equation"'"f(X)=0 (if one exists)
with an accuracy"
1000PRINT" >1E-9, using one of the thre
e methods:"''SPC6"- Newton-Raphson's met
hod,"'SPC6"- Bisection method,"'SPC6"- R
egula falsi."'''SPC8"Press any key to st
art ";:REPEATUNTILGET:CLS:ENDPROC:
1010DEFPROCstart:o%=0:O%=0:K%=0:M%=0:g$
="":VDU23,128,26172;14432;26208;60;23,12
9,32896;32896;32896;32896;:t$="Try anoth
er method":z$="Try to change X range":x$
=LEFT$(z$,14)+"Xo.":ENDPROC
1020DEFFNf(X)=EVALF$
1030DEFFNp(X)=(FNf(X+H)-FNf(X))/H
1040DEFFNcase(L$):LOCALN$,a%,I%:FORI%=1
TOLENL$:a%=ASCMID$(L$,I%,1):IFa%>96ANDa%
<123 a%=a%-32
1050IFINSTR("!#$%&',:;<=>?@[½]`£¼|¾÷"+C
HR$34,CHR$a%)K%=1
1060N$=N$+CHR$a%:NEXT:=N$
1070DEFPROCcen(q$,y%):IFLENq$<38PRINTTA
B(19-LENq$/2,y%)q$:ELSEPRINTTAB(0,y%)q$
1080ENDPROC
1090DEFPROCcon:VDU23,1,0;0;0;0;:ENDPROC
1100DEFPROCcoff:VDU23,1,1;0;0;0;:ENDPRO
C
1110DEFPROCneg(I%):VDU32,17,129,17,0,I%
,17,128,17,1:IFI%=77VDU129:ELSEVDU32
1120ENDPROC