Category : BASIC Source Code
Archive   : SICURV.ZIP
Filename : SICURV.BAS

 
Output of file : SICURV.BAS contained in archive : SICURV.ZIP

00010 CLS
00020 CLOSE
00030 DEFDBL A,D,X,Y,Z,T
00040 DIM A(1800),M$(10)
00050 DIM SOL$(30)
00060 SOL$(0)="S(J)=X1,X2,...,Xn"
00070 SOL$(1)="S(J)=X0,X1,...,Xn"
00080 ROW=2:COL=20
00090 C1F=1:C1B=2
00100 C2F=1:C2B=3
00110 FOR J=0 TO 1700:A(J)=0:NEXT
00120 M$(1)="SIMULTANEOUS EQUATIONS"
00130 M$(2)="FILE CURVE-FITTING"
00140 M$(3)="MANUAL CURVE-FITTING"
00150 M$(4)="CALL A DOS PROGRAM"
00160 M$(5)="CURVE-FITTING MENU"
00170 M$(6)="QUIT AND RETURN TO DOS"
00180 NP=6
00190 NME$=" SICURV "
00200 I$="SELECT BY NUMBER OR "+CHR$(24)+" "+CHR$(25)+" AND "+CHR$(17)+CHR$(196)+CHR$(217)+" TO GO"
00210 GOSUB 2580
00220 ON CH GOTO 1300,240,470,3020,970,2570
00230 GOTO 210
00240 CLS
00250 LOCATE 1,COL:PRINT" FILE CURVE-FITTING"
00260 LOCATE 2,COL:PRINT" ----------------------"
00270 LOCATE 3,COL-10:PRINT"INPUT DEGREE N,POINTS P,STEP ST
00280 INPUT"N,P,ST = ";N,P,ST
00290 IF ST=0 THEN ST=1
00300 IF N>=P THEN PRINT"ERROR N >= P REDO ":GOTO 270
00310 INPUT" [PATHNAME] FILENAME ";FILE$
00320 OPEN"I",1,FILE$
00330 M=1:A=1:Q=N+M
00340 H=1
00350 WHILE H<=P
00360 INPUT #1,X,Y
00370 PRINT X,Y
00380 H=H+ST
00390 GOSUB 710
00400 IF ST=1 THEN 420
00410 FOR ITER=1 TO ST-1:INPUT #1,XSKIP,YSKIP:NEXT ITER
00420 WEND
00430 CLOSE #1
00440 LOCATE 23,30:COLOR 1,3:PRINT" PRESS ANY KEY TO CONTINUE":COLOR 1,2
00450 IF INKEY$="" THEN 450
00460 GOTO 950
00470 CLS
00480 LOCATE 1,COL:PRINT" MANUAL CURVE-FITTING"
00490 LOCATE 2,COL:PRINT" ------------------------"
00500 LOCATE 3,COL-9:PRINT"INPUT DEGREE OF POLYNOMIAL N, NUMBER OF DATA POINTS P"
00510 LOCATE 23,COL
00520 COLOR 1,3:PRINT"INPUT M,M AND FOR MAIN MENU":COLOR 1,2
00530 LOCATE 4,1:INPUT"N,P ";N$,P$
00540 IF N$="M" THEN 120
00550 N=VAL(N$):P=VAL(P$)
00560 LOCATE 23,COL
00570 COLOR 1,3:PRINT" INPUT M,M AND FOR CURVE-FITTING MENU":COLOR 1,2
00580 LOCATE 4,1:IF N>=P THEN PRINT"ERROR N >= P REDO ":GOTO 500
00590 LOCATE 4,COL:PRINT"DEGREE =";N " DATA POINTS =";P
00600 PRINT"INPUT (Xi,Yi)"
00610 M=1:A=1:Q=N+M
00620 FOR H=1 TO P
00630 IF H>9 THEN LN=2 ELSE LN=1
00640 PRINT"X"+RIGHT$(STR$(H),LN)+CHR$(44)"Y"+RIGHT$(STR$(H),LN)" = ";
00650 INPUT"";X$,Y$
00660 IF X$="M" THEN 970
00670 X=VAL(X$):Y=VAL(Y$)
00680 GOSUB 710
00690 NEXT H
00700 GOTO 950
00710 REM CURVEFITTING ROUTINE
00720 A(1)=Q
00730 T=X
00740 FOR I=2 TO Q
00750 J=Q*I-Q+1
00760 FOR K=I TO J STEP Q-1
00770 A(K)=A(K)+T
00780 NEXT K
00790 T=T*X
00800 NEXT I
00810 J=Q*Q-Q+1
00820 FOR I=Q+Q TO Q*Q STEP Q
00830 J=J+1
00840 FOR K=I TO J STEP Q-1
00850 A(K)=A(K)+T
00860 NEXT K
00870 T=T*X
00880 NEXT I
00890 T=1
00900 FOR J=Q*Q+1 TO Q*Q+Q
00910 A(J)=A(J)+T*Y
00920 T=T*X
00930 NEXT J
00940 RETURN
00950 N=Q
00960 GOSUB 1550
00970 NME$=" CURVE-FITTING"
00980 REM
00990 M$(1)="EVALUATE THE POLYNOMIAL AT X=X0"
01000 M$(2)="EVALUATE FOR A RANGE OF X VALUES"
01010 M$(3)="COMPUTE THE DERIVATIVE AT X=X0"
01020 M$(4)="COMPUTE THE INTEGRAL FOR X= X0-X1"
01030 M$(5)="REVIEW COEFFICIENTS OF POLYNOMIAL"
01040 M$(6)="RETURN TO MAIN MENU"
01050 M$(7)="QUIT AND RETURN TO DOS"
01060 NP=7
01070 GOSUB 2580
01080 ON CH GOTO 1110,2790,2100,2260,1090,110,2570
01090 GOSUB 1550:GOTO 990
01100 DEFSNG X,Y
01110 CLS
01120 LOCATE 1,COL:PRINT" EVALUATE THE POLYNOMIAL AT X
01130 INPUT"FILENAME TO SAVE DATA TO ";FIL$
01140 OPEN"O",3,FIL$
01150 LOCATE 23,COL:COLOR 1,3:PRINT"INPUT AND FOR CURVE-FITTING MENU":COLOR 1,2
01160 LOCATE 3,1
01170 INPUT"X= ";X1$
01180 LOCATE 3,4:PRINT X1$+" "
01190 IF X1$="M" THEN CLS:GOTO 970 ELSE X=VAL(X1$)
01200 Y=0
01210 FOR J=N*N+N TO N*N+2 STEP-1
01220 Y=X*Y+X*A(J)
01230 NEXT J
01240 Y=Y+A(J)
01250 LOCATE 5,1
01260 PRINT"Y=";Y;" "
01270 PRINT #3,X;Y
01280 GOTO 1160
01290 REM SIMUL ROUTINE
01300 CLS:A=0
01310 LOCATE 2,1:PRINT" SIMULTANEOUS EQUATIONS"
01320 LOCATE 3,1:PRINT" -----------------------------"
01330 LOCATE 4,1:PRINT"INPUT NO. EQUATIONS N , NO. SOLUTION VECTORS M
01340 LOCATE 23,COL:COLOR 1,3:PRINT"INPUT M,M AND FOR MAIN MENU":COLOR 1,2
01350 LOCATE 5,1:
01360 INPUT"N,M = ";N$,M$
01370 IF N$="M" THEN 120 ELSE N=VAL(N$):M=VAL(M$)
01380 B=1E-10
01390 LOCATE 5,1
01400 PRINT"INPUT THE COEFFICIENT MATRIX IF ERROR INPUT AND "
01410 LOCATE 6,1:PRINT"COL"
01420 LOCATE 6,10:PRINT 1
01430 FOR C=1 TO N+M
01440 FOR J=1 TO N
01450 LOCATE J+6,1
01460 PRINT"ROW";J;
01470 INPUT" ";X$
01480 IF X$="E" THEN 2040
01490 A(N*C-N+J)=VAL(X$)
01500 NEXT J
01510 FOR J=1 TO N:LOCATE J+6,6:PRINT" ":NEXT
01520 IF C=N THEN LOCATE 6,1:PRINT"SOL COL":GOTO 1530
01530 LOCATE 6,10:PRINT C+1
01540 NEXT C
01550 CLS
01560 PRINT "SOLUTIONS:"
01570 PRINT SOL$(A)
01580 PRINT"FOR J=1 TO";M
01590 FOR K=1 TO N
01600 TT=N*K-N+K
01610 FOR R=K TO N
01620 IF K=N GOTO 1690
01630 IF ABS(A(TT+R-K))<=ABS(A(TT)) THEN NEXT R:GOTO 1690
01640 FOR C=K TO N+M
01650 Z=A(N*C-N+K)
01660 A(N*C-N+K)=A(N*C-N+R)
01670 A(N*C-N+R)=Z
01680 NEXT C
01690 IF R 01700 IF ABS(A(TT)) 01860 FOR I=1 TO M
01870 IF A=0 THEN CT=1 ELSE CT=0
01880 PRINT "SOLUTION VECTOR S(";I;")"
01890 FOR J=N*(N+I-1)+1 TO N*(N+I)
01900 PRINT "X"+RIGHT$(STR$(CT),LEN(STR$(CT))-1)" =";
01910 PRINT A(J)
01920 PRINT #2,CT;A(J)
01930 CT=CT+1
01940 NEXT J
01950 PRINT
01960 NEXT I
01970 PRINT "SAVED TO FILE SOLUTION.PRN"
01980 CLOSE 2
01990 LOCATE 23,COL+6:COLOR 1,3:PRINT"PRESS ANY KEY TO CONTINUE":COLOR 1,2
02000 IF INKEY$="" THEN 2000
02010 IF A=0 THEN 120
02020 RETURN
02030 REM SIMUL EQ ERROR ROUTINE
02040 LOCATE 6,1:INPUT"WRONG COL";C
02050 LOCATE 6,1:PRINT"REDO COL ";C
02060 FOR C=C TO N+M:GOTO 1440
02070 NEXT
02080 GOTO 1550
02090 REM DIFFERIENTIATION ROUTINE
02100 CLS
02110 LOCATE 1,20:PRINT" COMPUTE THE DERIVATIVE AT X = Xi
02120 LOCATE 23,18
02130 COLOR 1,3:PRINT" INPUT AND FOR CURVE-FITTING MENU":COLOR 1,2
02140 LOCATE 2,1:INPUT"X = ";X1$
02150 LOCATE 2,5:PRINT X1$" "
02160 IF X1$="M" THEN CLS:GOTO 980 ELSE X=VAL(X1$)
02170 YP=0:N1=N
02180 FOR J=N*N+N TO N*N+3 STEP-1
02190 N1=N1-1
02200 YP=(YP+N1*A(J))*X
02210 NEXT J
02220 YP=YP +A(J)
02230 LOCATE 4,1:PRINT"Y'= ";YP" "
02240 GOTO 2140
02250 REM INTEGRATION ROUTINE
02260 CLS:LOCATE 1,20
02270 PRINT"COMPUTE THE INTEGRAL FOR X=X0 TO X=X1
02280 LOCATE 23,20:COLOR 1,3:PRINT"INPUT M,M FOR CURVE-FITTING MENU":COLOR 1,2
02290 LOCATE 2,1
02300 INPUT"X0,X1 ";X0$,X1$
02310 LOCATE 2,7:PRINT X0$","X1$" "
02320 T$=LEFT$(X0$,1)
02330 IF T$="M" THEN CLS:GOTO 980
02340 X0=VAL(X0$)
02350 X=VAL(X1$)
02360 X1=VAL(X1$)
02370 IF X=.5 THEN YR=SQR(3)/8 ELSE YR=1/8.0:X=SQR(2-SQR(3))/2
02380 GOSUB 2510
02390 Y1=YI:X=X0
02400 GOSUB 2510
02410 Y=Y1-YI
02420 PRINT
02430 PRINT"INTEGRAL = ";Y
02440 IF FILE$="CIRCUM" THEN YPI=6*Y:GOTO 2470
02450 YR1=Y-YR
02460 IF X1=.5 THEN YPI=YR1*12 ELSE YPI=YR1*24
02470 PRINT"PI CALC =";YPI
02490 PRINT"PI TO 54 =";ATN(1)*4
02500 GOTO 2290
02510 YI=0:N1=N+1
02520 FOR J=N*N+N TO N*N+1 STEP-1
02530 N1=N1-1
02540 YI=(YI+A(J)/N1)*X
02550 NEXT J
02560 RETURN
02570 CLOSE:COLOR 1,7:CLS:END
02580 REM MENU ROUTINE
02590 IF ROW<1 OR ROW>24 OR COL<1 OR COL>70 THEN PRINT"SETUP ERROR":RETURN
02600 COLOR C1F,C1B
02610 CLS
02620 LOCATE ROW+1,COL+3:PRINT NME$" MENU"
02630 LOCATE ROW+2,COL:PRINT" ==========================="
02640 LOCATE 23,COL:COLOR 1,3:PRINT I$:COLOR 1,2
02650 FOR J=1 TO 16:X$=INKEY$:NEXT:CH=1
02660 LS=2:FOR J=1 TO NP:IF LEN(M$(J))>LS THEN LS=LEN(M$(J))
02670 NEXT:SL=COL
02680 FOR K=1 TO NP:LOCATE ROW+2+K,SL:PRINT K;" "M$(K):NEXT
02690 LOCATE ROW+2+CH,SL:COLOR C2F,C2B:PRINT CH;" "M$(CH):COLOR C1F,C1B:TD=CH
02700 X$=INKEY$
02710 T$=RIGHT$(X$,1)
02720 IF LEN(X$) THEN KP=ASC(T$) ELSE 2700
02730 IF KP=72 THEN CH=CH-1:IF CH<1 THEN CH=NP
02740 IF KP=80 THEN CH=CH+1:IF CH>NP THEN CH=1
02750 IF X$=>"1" AND X$<="9" THEN IF VAL(X$)=>1 AND VAL(X$)<=NP THEN CH=VAL(X$):RETURN
02760 IF KP=13 THEN RETURN
02770 IF KP<>72 AND KP<>80 THEN KP=KP-48:IF KP<1 OR KP>NP THEN PRINT CHR$(7):GOTO 2700 ELSE CH=KP
02780 IF CH=TD THEN 2700 ELSE LOCATE ROW+2+TD,SL:PRINT TD;" "M$(TD):GOTO 2690
02790 CLS
02800 LOCATE 1,1
02810 PRINT" EVALUATE THE POLYNOMIAL FOR A RANGE OF VALUES AND INCREMENT
02820 INPUT"FILENAME TO SAVE DATA TO ";FIL$
02830 OPEN"O",3,FIL$
02840 LOCATE 3,1
02850 INPUT"X0,XN,INC = ";X0,XN,XI
02860 IF XI=0 THEN 2850
02870 X=X0
02880 WHILE X <= XN
02890 Y=0
02900 FOR J=N*N+N TO N*N+2 STEP-1
02910 Y=X*Y+X*A(J)
02920 NEXT J
02930 Y=Y+A(J)
02940 PRINT #3,X;Y

02950 PRINT X;Y
02960 X=X+XI
02970 WEND
02980 CLOSE 3
02990 LOCATE 23,COL:COLOR 1,3:PRINT"PRESS ANY KEY TO CONTINUE"
03000 IF INKEY$="" THEN 3000
03010 GOTO 970
03020 CLS
03030 INPUT"FILENAME ";FIL$
03040 CALL FIL$
03050 LOCATE 23,30:COLOR 1,3:PRINT" PRESS ANY KEY TO CONTINUE":COLOR 1,2
03060 IF INKEY$="" THEN 3060
03070 GOTO 120