10 REM NON-LINEAR EQUATIONS
   20 REM v.2.1(Engl) for 8-Bit Software
   30 REM by M.Bobrowski 8'91
   40 :
   50 MODE6:HIMEM=&5800:PROCstart:PROCintro:*FX229,1
   60 ONERRORPROCerr
   70 VDU22,6:PROCformula
   80 VDU22,4:PROCenter:PROCaxes
   90 ON ERROR GOTO 220
  100 V=EVAL(F$)
  110 X=X+C
  120 Y=EVAL(F$):IF SGNY<>SGNV Z%=Z%+1:IFX-C<>P:IFABS(Y-V)<(maxy-miny):PRINT;X;", ";:P=X
  130 IF yo+V*sy>1040 OR yo+V*sy<200 THEN 250
  140 MOVE X%,yo+V*sy:IF yo+Y*sy>1040 OR yo+Y*sy<200 THEN 250
  150 DRAW X%+4,yo+Y*sy:V=Y:X%=X%+4:IF X%<1280 THEN 110
  160 PROCfin:PROCwhat:IFQ%=2THEN80:ELSEIFQ%=3THEN70:ELSEIFQ%=4:OSCLI"FX229":VDU22,7,10:END
  170 VDU22,6:ONERROR PROCerr
  180 PROCcalc:REPEAT:PROCmain:UNTILO%=5ORO%=3:IFO%=3THEN80
  190 *FX229,0
  200 END
  210 :
  220 IFERR>17ANDERR<25:ELSEVDU22,6:PROCcen("f(X)="+F$,16):PROCerr:GOTO70
  230 ON ERROR OFF
  240 ON ERROR GOTO 220
  250 X=X+C:X%=X%+4:IF X%>1280 THEN 160
  260 V=EVAL(F$):GOTO120
  270 :
  280 DEFPROCformula:PRINTTAB(0,20)"Note: the formula for f(X) must satisfy requirements 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
  290 IFK%=1:PROCerr:CLS:K%=0:PROCformula
  300 ENDPROC
  310 DEFPROCenter:VDU28,0,31,39,25,12,24,0;224;1279;1023;16,19,0,4;0;19,1,3;0;:PRINT"f(X)=";F$:REPEAT:INPUT'"Enter minimum X value : "minx:INPUT'"Enter maximum X value : "maxx:IF maxx<=minx PRINT'"Note: Xmax must be greater than Xmin."CHR$7
  320 UNTILmaxx>minx:REPEAT:INPUT'"Enter minimum Y value : "miny:IF miny>=0 PRINT'"Note: Ymin must be a negative number."CHR$7
  330 UNTIL miny<0:REPEAT:INPUT'"Enter maximum Y value : "maxy:IF maxy<=0 PRINT'"Note: Ymax must be a positive number."CHR$7
  340 UNTILmaxy>0:C=(maxx-minx)/320:Z%=0:X%=0:X=minx:P=minx-C:@%=&20A:CLS:PRINTTAB(0,1)"Function : "F$;TAB(0,3)"f(X)=0 when X=";:ENDPROC
  350 DEFPROCaxes:sx=1280/(maxx-minx):sy=800/(maxy-miny):IF maxx>0 xo=1280-maxx*sx:ELSE xo=0
  360 IF xo<0 xo=0
  370 yo=224-miny*sy:IF sx<64 hx=128 ELSE hx=sx
  380 IF sy<40 hy=80 ELSE hy=sy
  390 IF xo=0 FOR J%=0 TO 1280 STEP hx:MOVE J%,yo-4:DRAW J%,yo+4:NEXT:ELSE FOR J%=xo TO 0 STEP -hx:MOVE J%,yo-4:DRAW J%,yo+4:NEXT:FOR J%=xo TO 1280 STEP hx:MOVE J%,yo-4:DRAW J%,yo+4:NEXT
  400 FOR 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:MOVE 0,224:DRAW 0,1023:DRAW 1279,1023:DRAW 1279,224:DRAW 0,224:MOVE 0,yo:DRAW 1280,yo:IF minx<=0 MOVE xo,224:DRAW xo,1024
  410 ENDPROC
  420 DEFPROCfin:VDU5:MOVE 16,yo-16:PRINT;minx:nx=1264-32*LEN(LEFT$(STR$(maxx),4)):MOVE nx,yo-16:IF xo<nx PRINT;maxx
  430 IF xo<>0 MOVE xo+16,yo+48:PRINT"0"
  440 MOVE xo+16,1008:PRINT;maxy:MOVE xo+16,256:PRINT;miny:@%=&90A:VDU7,4:IFZ%>0VDU127,127:PRINT:ELSEPRINTTAB(0,3)"No zeroes of the function within this"'"X range. Try to examine another X range."
  450 PRINT'"Press any key to continue ";:REPEATUNTILGET:ENDPROC
  460 DEFPROCmain:IFo%=0PROCmethod:ENDPROC:ELSEPROCkeys
  470 IFO%=1PROCchange:ELSEIFO%=2PROCmethod:ELSEIFO%=4 RUN
  480 ENDPROC
  490 DEFPROCmethod:PRINT'"There are three methods available :"''"  1. Newton-Raphson's method"'"  2. Bisection method"'"  3. Regula falsi"''"Which one do you choose ? ";:REPEATM%=GET-48:UNTILM%>0ANDM%<4:PRINT;M%:IFo%=0o%=M%:PROCinput:ENDPROC
  500 IFM%>1ANDo%=1:PROCrange:ELSEIFM%>1A=a:B=b
  510 IFM%=1ANDo%>1PROCinitx:ELSEIFM%=1X=x
  520 o%=M%:PROCcalc:ENDPROC
  530 DEFPROCinput:PROCaccur:IFM%=1PROCinitx:ELSEPROCrange
  540 PROCcalc:ENDPROC
  550 DEFPROCcalc:IFo%=0ENDPROC:ELSEx=X
  560 K%=0:I%=0:IFM%=1PROCnewton:ELSEIFM%=2PROCbisect:ELSEPROCillinois
  570 CLS:IFK%=0PROCresultELSEVDU7:PROCfail
  580 ENDPROC
  590 DEFPROCnewton:H=1E-6:IFFNf(X)=0ENDPROCELSEIFFNp(X)=0K%=2:ENDPROC
  600 s%=FALSE:REPEAT:z=X-FNf(X)/FNp(X):IFABS(z-X)<=ETHENs%=TRUEELSEX=z:I%=I%+1:IFFNp(X)=0K%=3
  610 UNTILs%ORI%>20ORK%=3:IFI%>20K%=4
  620 ENDPROC
  630 DEFPROCbisect:IFFNf(A)=0X=A:ENDPROC:ELSEIFFNf(B)=0X=B:ENDPROC:ELSEIFFNf(A)*FNf(B)>0K%=5:ENDPROC
  640 REPEAT:X=(A+B)*.5:y=FNf(X):IFy<>0I%=I%+1:IFy*FNf(A)<0B=XELSEA=X
  650 UNTILABS(B-A)<=E ORy=0ORI%>100:IFI%>100K%=6
  660 ENDPROC
  670 DEFPROCillinois:IFFNf(A)=0X=A:ENDPROC:ELSEIFFNf(B)=0X=B:ENDPROC:ELSEIFFNf(A)*FNf(B)>0K%=5:ENDPROC
  680 z=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=yELSEg=g*0.5
  690 X=r:y=h:I%=I%+1:UNTIL ABS(X-z)<=E ORABSy<=1E-38 ORI%>100:IFI%>100K%=6
  700 ENDPROC
  710 DEFPROCresult:PROCinfo:PRINT'CHR$7"The solution of the equation :"''SPC4;F$;"=0"''"is X=";X;:IFFNf(X)=0PRINT" (exact solution)":ELSEPRINTSPC6;"(approx.)"
  720 IFI%>0PRINT'"No. of iterations = ";I%
  730 ENDPROC
  740 DEFPROCchange:PROCinfo:PRINT'"You may change :"''TAB(2)"1. formula for f(x)"'TAB(2)"2. accuracy":IFM%=1PRINTTAB(2)"3. initial X value"ELSEPRINTTAB(2)"3. X range"
  750 PRINT'"Enter choice (1-3) : ";:REPEATZ%=GET-48:UNTILZ%>0ANDZ%<4:PRINT;Z%:IFZ%=1INPUT'"Enter : f(x)="F$:F$=FNcase(F$):ELSEIFZ%=2PROCaccur
  760 IFM%=1X=xELSEA=a:B=b
  770 IFZ%=3ANDM%=1PROCinitx:ELSEIFZ%=3ANDM%<>1:PROCrange
  780 PROCcalc:ENDPROC
  790 DEFPROCerr:FORJ%=1TO6:SOUND1,-7,150,1:SOUND1,0,0,1:NEXT:VDU28,0,24,39,20,12:IFERR>17ANDERR<25ANDM%=1PROCcen("*** Change Xo ! ***",0)ELSEIFERR>17ANDERR<25PROCcen("*** Change X Range ***",0)
  800 IFERR=26ORERR=27ORK%=1:VDU26:PROCcen("Invalid expression used",20)
  810 REPORT:PRINT" AT ";ERL
  820 PRINT':v%=VPOS:PROCcen("Press any key to continue",v%):REPEATUNTILGET:PRINTTAB(0,v%)SPC39:ENDPROC
  830 DEFPROCfail:PROCcen("No evidence of a solution.",3):IFK%=2PRINTTAB(2,5)"For  X=";X;" the derivative f'(X)=0"''TAB(2)x$
  840 IFK%=3PROCcen(t$,5)
  850 IFK%=4PROCcen("Divergence ! "+t$,5):PROCcen("or increase € value",7)
  860 IFK%=5PRINTTAB(2,5)"sign f(";A;") = sign f(";B;")"''TAB(2)z$
  870 IFK%=6PROCcen("Increase € value or "+t$,5)
  880 ENDPROC
  890 DEFPROCaccur:PRINT'"Enter accuracy (or press RETURN) :"''"  €=";:v%=VPOS:REPEATPRINTTAB(4,v%);SPC9:INPUTTAB(4,v%)E:IFE=0THENE=1E-4:PRINTTAB(4,v%);E
  900 UNTILE>=1E-9ANDE<1:ENDPROC
  910 DEFPROCrange:PRINT'"Enter bounds for X within which you hopeto find a solution :":v%=VPOS+1:REPEATPRINTTAB(0,v%);SPC39:INPUTTAB(2,v%)"X min : "A;TAB(19,v%)"X max : "B:UNTILA<B:a=A:b=B:ENDPROC
  920 DEFPROCinitx:INPUT'"Enter initial X value : Xo="X:x=X:ENDPROC
  930 DEFPROCkeys:VDU28,0,24,39,20,12:PRINTSTRING$(40,"-")"Press:";:PROCneg(77):PRINT"to change the method,";:PROCneg(71):PRINT"to plota graph,";:PROCneg(80):PRINT"to change a single parameter,or";:PROCneg(82):PRINT"to re-run the program, or";
  940 PROCneg(81):PRINT"to exit";:VDU26:PROCcon:REPEATO%=INSTR("PpMmGgRrQq",GET$):UNTILO%:O%=(O%+1)DIV2:PROCcoff:CLS:PRINT':ENDPROC
  950 DEFPROCinfo:CLS:PRINT'"Method ";M%;" (";:IFM%=1:PRINT"Newton-Ranson's)":ELSEIFM%=2:PRINT"Bisection)":ELSEPRINT"Regula falsi)"
  960 PRINT'SPC3;"f(X)=";F$''"€=";E;:IFM%=1:PRINTTAB(19)"Xo=";x:ELSEPRINTTAB(10)"X range : [";a;",";b;"]"
  970 PRINT'STRING$(40,"-"):ENDPROC
  980 DEFPROCwhat:CLS:PRINT'"Press:";:PROCneg(71):PRINT"to change graph coordinates,"':COLOUR129:COLOUR0:PRINT"SPACE";:COLOUR128:COLOUR1:PRINT" to pass to the next part of the"''"program,";:PROCneg(70):PRINT"to change formula,";:PROCneg(81):PRINT"to exit ";:REPEATQ%=INSTR("  GgFfQq",GET$):UNTILQ%:Q%=(Q%+1)DIV2:ENDPROC
  990 DEFPROCintro:PROCcen("NON-LINEAR EQUATIONS",7):PRINT''"The program plots any function Y=f(X)"'"within required X range(s), then finds  an approximate solution of equation"'"f(X)=0 (if one exists) with an accuracy"
 1000 PRINT"€>1E-9, using one of the three methods:"''SPC6"- Newton-Raphson's method,"'SPC6"- Bisection method,"'SPC6"- Regula falsi."'''SPC8"Press any key to start ";:REPEATUNTILGET:CLS:ENDPROC:
 1010 DEFPROCstart:o%=0:O%=0:K%=0:M%=0:g$="":VDU23,128,26172;14432;26208;60;23,129,32896;32896;32896;32896;:t$="Try another method":z$="Try to change X range":x$=LEFT$(z$,14)+"Xo.":ENDPROC
 1020 DEFFNf(X)=EVALF$
 1030 DEFFNp(X)=(FNf(X+H)-FNf(X))/H
 1040 DEFFNcase(L$):LOCALN$,a%,I%:FORI%=1TOLENL$:a%=ASCMID$(L$,I%,1):IFa%>96ANDa%<123 a%=a%-32
 1050 IFINSTR("!#$%&',:;<=>?@[\]_`{|}~"+CHR$34,CHR$a%)K%=1
 1060 N$=N$+CHR$a%:NEXT:=N$
 1070 DEFPROCcen(q$,y%):IFLENq$<38PRINTTAB(19-LENq$/2,y%)q$:ELSEPRINTTAB(0,y%)q$
 1080 ENDPROC
 1090 DEFPROCcon:VDU23,1,0;0;0;0;:ENDPROC
 1100 DEFPROCcoff:VDU23,1,1;0;0;0;:ENDPROC
 1110 DEFPROCneg(I%):VDU32,17,129,17,0,I%,17,128,17,1:IFI%=77VDU129:ELSEVDU32
 1120 ENDPROC