3 REM MULTX: LEAST-SQUARES FIT, MULTIPLE Y'S PER X 7 REM TRANSLATED FOR BASIC-PLUS BY DSAA 100 Q=0 105 PRINT 110 INPUT'ENTER THE NUMBER OF DIFFERENT X GROUPS';N 120 FOR I=1 TO N 121 PRINT 130 PRINT'ENTER THE NUMBER OF ELEMENTS IN GROUP';I;' AND THE COMMON' 131 INPUT 'X VALUE';M,X 132 PRINT 135 PRINT'NOW ENTER THE ELEMENTS IN GROUP NUMBER ';I 140 FOR J=1 TO M 150 INPUT Y 160 Q=Q+1 170 X(Q)=X 180 Y(Q)=Y 190 NEXT J 200 NEXT I 210 N=Q 270 DIM X(200),Y(200),U(200),V(200),A(6),B(6),C(6),S(6),F(6) 280 MAT F=CON 290 PRINT 300 PRINT 310 PRINT " ","LEAST SQUARES CURVES FIT" 320 PRINT 330 PRINT "CURVE TYPE"," INDEX OF "," A"," B" 340 PRINT " ","DETERMINATION" 350 PRINT 360 FOR I=1 TO 6 370 MAT S=ZER 380 GOSUB 1390 390 IF (I-5)*(I-6)=0 THEN 540 400 IF (I-2)*(I-3)=0 THEN 470 410 FOR J=1 TO N 420 LET V(J)=Y(J) 430 GOSUB 1170 440 NEXT J 450 IF I=1 THEN 640 460 GOTO 750 470 FOR J=1 TO N 480 IF Y(J) <= 0 THEN 610 490 LET V(J)=LOG(Y(J)) 500 GOSUB 1170 510 NEXT J 520 IF I=3 THEN 690 530 GOTO 640 540 FOR J=1 TO N 550 IF Y(J)=0 THEN 610 560 LET V(J)=1/Y(J) 570 GOSUB 1170 580 NEXT J 590 IF I=6 THEN 750 600 GOTO 640 610 PRINT "CAN'T FIT" 620 LET F(I)=0 630 GOTO 820 640 FOR J=1 TO N 650 LET U(J)=X(J) 660 GOSUB 1200 670 NEXT J 680 GOTO 800 690 FOR J=1 TO N 700 IF X(J) <= 0 THEN 610 710 LET U(J)=LOG(U(J)) 720 GOSUB 1200 730 NEXT J 740 GOTO 800 750 FOR J=1 TO N 760 IF X(J)=0 THEN 610 770 LET U(J)=1/X(J) 780 GOSUB 1200 790 NEXT J 800 GOSUB 1800 810 PRINT C(I),A(I),B(I) 820 NEXT I 830 GOSUB 1240 840 PRINT 850 PRINT 860 PRINT 870 PRINT"DETAILS FOR CURVE TYPE [0 TO TERMINATE]"; 880 INPUT I 890 IF I=0 THEN 2050 900 LET K=I 910 IF F(I)=1 THEN 950 920 GOSUB 1390 930 PRINT " COULD NOT BE FIT." 940 GOTO 840 950 GOSUB 1570 960 IF (I-1)*(I-5)*(I-6)<>0 THEN 1060 970 FOR J=1 TO N 980 LET Y=A(I)+B(I)*X(J) 990 IF I=1 THEN 1030 1000 LET Y=1/Y 1010 IF I=5 THEN 1130 1020 LET Y=X(J)*Y 1030 GOSUB 1950 1040 NEXT J 1050 GOTO 840 1060 FOR J=1 TO N 1070 IF I=2 THEN 1130 1080 IF I=3 THEN 1110 1090 LET Y=A(4)+B(4)/X(J) 1100 GOTO 1140 1110 LET Y=A(3)*(X(J)^B(3)) 1120 GOTO 1140 1130 LET Y=A(2)*EXP(B(2)*X(J)) 1140 GOSUB 1950 1150 NEXT J 1160 GOTO 840 1170 LET S(5)=S(5)+V(J)^2 1180 LET S(3)=S(3)+V(J) 1190 RETURN 1200 LET S(1)=S(1)+U(J) 1210 LET S(2)=S(2)+U(J)^2 1220 LET S(4)=S(4)+U(J)*V(J) 1230 RETURN 1240 FOR I=1 TO N-1 1250 LET M=I 1260 FOR J=I+1 TO N 1270 IF X(M) <= X(J) THEN 1290 1280 LET M=J 1290 NEXT J 1300 IF M=I THEN 1370 1310 LET P=X(M) 1320 LET Q=Y(M) 1330 LET S(M)=X(I) 1340 LET Y(M)=Y(I) 1350 LET X(I)=P 1360 LET Y(I)=Q 1370 NEXT I 1380 RETURN 1390 LET K=I 1400 IF K=1 THEN 1550 1410 IF K=2 THEN 1530 1420 IF K=3 THEN 1510 1430 IF K=4 THEN 1490 1440 IF K=5 THEN 1470 1450 PRINT "6. Y=X/(A+B*X) "; 1460 RETURN 1470 PRINT "5. Y=1/(A+B*X) "; 1480 RETURN 1490 PRINT "4. Y=A+(B/X)", 1500 RETURN 1510 PRINT "3. Y=A*(X^B)", 1520 RETURN 1530 PRINT "2. Y=A*EXP(B*X)"; 1540 RETURN 1550 PRINT"1. Y=A+(B*X)", 1560 RETURN 1570 PRINT " "; 1580 GOSUB 1400 1590 PRINT " IS A"; 1600 IF K=1 THEN 1650 1610 IF K=2 THEN 1670 1620 IF K=3 THEN 1690 1630 PRINT " HYPERBOLIC"; 1640 GOTO 1700 1650 PRINT " LINERAR"; 1660 GOTO 1700 1670 PRINT "N EXPONENTIAL"; 1680 GOT O 1700 1690 PRINT " POWER"; 1700 PRINT " FUNCTION. THEN RESULTS" 1710 IF K=1 THEN 1730 1720 PRINT " OF A LEAST-SQUARES FIT OF ITS LINEAR TRANSFORM" 1730 PRINT " (SORTED IN ORDER OF ASCENDING VALUES OF X)" 1740 PRINT " ARE AS FOLLOWS:" 1750 PRINT 1760 PRINT "X-ACTUAL","Y-ACTUAL","Y-CALC","PCT DIFFER" 1770 PRINT 1780 RETURN 1790 PRINT 1800 LET B=(N*S(4)-S(1)*S(3))/(N*S(2)-(S(1)^2)) 1810 LET A=(S(3)-B*S(1))/N 1820 LET S1=S(5)-(S(3)^2)/N 1830 LET S2=(B^2)*(S(2)-(S(1)^2)/N) 1840 LET C(I)=S2/S1 1850 IF (I-1)*(I-4)*(I-5)=0 THEN 1920 1860 IF (I-2)*(I-3)=0 THEN 1900 1870 LET A(6)=B 1880 LET B(6)=A 1890 RETURN 1900 LET A(I)=EXP(A) 1910 GOTO 1930 1920 LET A(I)=A 1930 LET B(I)=B 1940 RETURN 1950 PRINT X(J),Y(J),Y, 1960 LET D=Y(J)-Y 1970 LET D=.1*SGN(D)*INT(1000*ABS(D/Y)) 1980 IF D<0 THEN 2030 1990 IF D>0 THEN 2020 2000 PRINT " 0" 2010 RETURN 2020 PRINT " "; 2030 PRINT D 2040 RETURN 2050 END