|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 9472 (0x2500)
Types: TextFile
Names: »CFIG.PAS«
└─⟦692ac107c⟧ Bits:30005923 PolyPascal-80 V3.10 arbejdsdiskette 1
└─⟦this⟧ »CFIG.PAS«
(*$R-*)
PROGRAM CURVEFIT;
LABEL 5,10,15,20,40,50,99,110,220,330,440;
CONST MAX=100;
VAR (*S STAAR FOR SUMMA*)
XE,YE,
SX,SX2,SX3,SX4,SLNX,SLNX2,SLNX3,SLNX4,SY,SY2,SLNY,SLNY2,SXY,SX2Y,SXLNY,SX2LNY
,SYLNX,SYLNX2,SLNXLNY,SLNX2LNY,A1,A2,A3,B1,B2,B3,C1,C2,C3,D1,D2,D3
,DENOM,A,B,C,EPSILON,EMIN,XINP,YCALC:REAL;
NN,II,YY,I,N,BEST,CTRL,FIT:INTEGER;
X:ARRAY Æ1..MAXÅ OF REAL;
Y:ARRAY Æ1..MAXÅ OF REAL;
E:ARRAY Æ1..4Å OF REAL;
DUMMY:CHAR;
EDITFLAG:BOOLEAN;
PROCEDURE XY(X,Y:INTEGER); æCURSOR ADDRESSING PLEASEå
CONST
ESC=27; æVALUE FOR ESCå
OFF=32; æOFFSET IN DECIMALå
BEGIN
WRITE(CHR(ESC),'Y',CHR(Y+OFF),CHR(X+OFF));
END;
PROCEDURE CLRSCR;
BEGIN
WRITELN(CHR(27),'E'); æCLEAR SCREEN PROCEDUREå
END;
PROCEDURE BEEP;
BEGIN
WRITE(CHR(7)); æBELL CHARå
END;
PROCEDURE MORE;
VAR
ACK:CHAR;
BEGIN
WRITELN('More, press <RETURN>');
READ(ACK);
END;
PROCEDURE EDIT(VAR N:INTEGER;P:INTEGER); æN IS NEW DATAINDEX VALUE RETURNEDå
VAR æP IS OLD DATAINDEX VALUE FRM PRG å
P1,N1,ANSWER:INTEGER;
IPU,RUNFLAG:BOOLEAN;
BEGIN
RUNFLAG:=FALSE;
WHILE RUNFLAG=FALSE DO
BEGIN
XY(40,10);
WRITE('Backward..................<1>');
XY(40,11);
WRITE('Forward...................<2>');
XY(40,12);
WRITE('Finished..................<3>');
XY(40,13);
WRITE('Start over................<4>');
XY(40,14);
WRITE('Continue..................<5>');
XY(40,15);
WRITE('Enter your choice.........<?>');
REPEAT
XY(67,15);
WRITE('?');
XY(67,15);
FOR N1:=1 TO 10000 DO;
IPU:=KEYPRESS;
XY(67,15);
WRITE(' ');
XY(67,15);
FOR N1:=1 TO 10000 DO;
UNTIL IPU;
READ(ANSWER);
IF ANSWER IN Æ1,2,3,4,5Å THEN
BEGIN
RUNFLAG:=TRUE;
FOR P1:=10 TO 15 DO æCLEAR MENU AREAå
BEGIN
XY(40,P1);
WRITE(' ');
END;
CASE ANSWER OF
1:IF P>1 THEN N:=P-1; æBACKWARD å
2:N:=P+1; æFORWARD å
3:N:=0; æFINISHED å
4:N:=1; æSET TO FIRST DATALOCATION å
5:N:=P; æSET TO SAME DATALOCATION å
END;
END
ELSE
BEGIN
BEEP;
XY(68,15);
WRITE(' '); æCLEAR ENTRY AREAå
RUNFLAG:=FALSE;
END;
END;
END;
PROCEDURE ENTER(VAR X,Y:REAL;VAR EDITFLAG:BOOLEAN;I:INTEGER);æGET INPUT DATAå
TYPE æRETURN THESE AS X,Yå
DAT=STRING (.10.);
VAR
DATAIN,DATAX,DATAY:DAT;
N1,N2,TESTX,TESTY:INTEGER;
INCFLAG,RUNFLAG:BOOLEAN;
BEGIN
RUNFLAG:=FALSE;
REPEAT
IF I > 23 THEN
IF YY > 23 THEN YY:=1 ELSE
BEGIN
YY:=YY+1;
END
ELSE YY:=I;
XY(5,YY);
WRITE(' ');
XY(2,YY);
WRITE('Enter x,y (',i,')........... ');
READ(DATAIN);
IF DATAIN='' THEN
BEGIN æUSER WANT TO EDIT DATAå
EDITFLAG:=TRUE;
RUNFLAG:=TRUE;
END
ELSE æREAL DATA ENTERED SEARCH FOR A ','å
BEGIN
N1:=POS(',',DATAIN);
IF N1 <> 0 THEN
BEGIN
RUNFLAG:=TRUE;
N2:=LEN(DATAIN);
DATAX:=COPY(DATAIN,1,N1-1);
DATAY:=COPY(DATAIN,N1+1,(N2-N1+1));
VAL(DATAX,X,TESTX);
VAL(DATAY,Y,TESTY); æGET X AND Y VALUES FROM STRINGå
IF (TESTX >0) OR (TESTY >0) THEN RUNFLAG:=FALSE; æERROR IN ENTRYå
END
ELSE RUNFLAG:=FALSE; æNO COMMA, IE. STRANGE DATAå
END;
UNTIL RUNFLAG=TRUE;
END;
PROCEDURE EQUATIONS(TYP:INTEGER);
BEGIN
CLRSCR;
DENOM:=A1*(B2*C3-B3*C2)+A2*(B3*C1-B1*C3)+A3*(B1*C2-B2*C1);
A:=(D1*(B3*C2-B2*C3)+D2*(B1*C3-B3*C1)+D3*(B2*C1-B1*C2))/DENOM;
B:=(D1*(A2*C3-A3*C2)+D2*(A3*C1-A1*C3)+D3*(A1*C2-A2*C1))/DENOM;
C:=(D1*(A3*B2-A2*B3)+D2*(A1*B3-A3*B1)+D3*(A2*B1-A1*B2))/DENOM;
CASE TYP OF
1:BEGIN
WRITELN('LINEAR CASE:');
EÆ1Å:=SQRT ((SY2-A*SX2Y-B*SXY-C*SY)/(SY2));
EPSILON:=EÆ1Å;
END;
2:BEGIN
WRITELN('EXPONENTIAL CASE:');
EÆ2Å:=SQRT((SLNY2-A*SX2LNY-B*SXLNY-C*SLNY)/(SLNY2));
EPSILON:=EÆ2Å;
END;
3:BEGIN
WRITELN('LOGARITHMIC CASE:');
EÆ3Å:=SQRT((SY2-A*SYLNX2-B*SYLNX-C*SY)/(SY2));
EPSILON:=EÆ3Å;
END;
4:BEGIN
WRITELN('POWER CASE:');
EÆ4Å:=SQRT((SLNY2-A*SLNX2LNY-B*SLNXLNY-C*SLNY)/(SLNY2));
EPSILON:=EÆ4Å;
END;
END;
WRITELN('A =',A:16:8);
WRITELN('B =',A:16:8);
WRITELN('C =',C:16:8);
WRITELN('EPSILON =',EPSILON:16:10);
MORE;
END;
BEGIN
N:=0;
CTRL:=0;
SX:=0;SX2:=0;SX3:=0;SX4:=0;SLNX:=0;
SLNX2:=0;SLNX3:=0;SLNX4:=0;SY:=0;
SY2:=0;SLNY:=0;SLNY2:=0;SXY:=0;
SX2Y:=0;SXLNY:=0;SX2LNY:=0;SYLNX:=0;
SYLNX2:=0;SLNXLNY:=0;SLNX2LNY:=0;
5:CLRSCR;
WRITELN(' *****************************************************************');
WRITELN(' ++++++++++++++++ IMPROVED CURVE FITTING PROGRAM ++++++++++++++++');
WRITELN(' *****************************************************************');
XY(50,23);
WRITE('Press <RETURN> to continue ');
READ(DUMMY);
CLRSCR;
EDITFLAG:=FALSE;
I:=1;
NN:=1;
REPEAT æCONTINUE UNTIL N:=0å
ENTER(XE,YE,EDITFLAG,I);
IF EDITFLAG THEN
REPEAT
EDIT(NN,I);
IF NN> 0 THEN I:=NN;
EDITFLAG:=FALSE;
IF NN>0 THEN ENTER(XE,YE,EDITFLAG,I);
UNTIL NOT EDITFLAG;
IF NN>0 THEN
BEGIN
XÆIÅ:=XE;
YÆIÅ:=YE;
I:=I+1;
END;
UNTIL NN=0;
II:=I-1;
FOR I:=1 TO II DO
BEGIN
SX:=SX+XÆIÅ;
SX2:=SX2+SQR(XÆIÅ);
SX3:=SX3+SQR(XÆIÅ)*XÆIÅ;
SX4:=SX4+SQR(SQR(XÆIÅ));
SLNX:=SLNX+LN(XÆIÅ);
SLNX2:=SLNX2+SQR(LN(XÆIÅ));
SLNX3:=SLNX3+LN(XÆIÅ)*SQR(LN(XÆIÅ));
SLNX4:=SLNX4+SQR(SQR(LN(XÆIÅ)));
SY:=SY+YÆIÅ;
SY2:=SY2+SQR(YÆIÅ);
SLNY:=SLNY+LN(YÆIÅ);
SLNY2:=SLNY2+SQR(LN(YÆIÅ));
SXY:=SXY+XÆIÅ*YÆIÅ;
SX2Y:=SX2Y+SQR(XÆIÅ)*YÆIÅ;
SXLNY:=SXLNY+XÆIÅ*LN(YÆIÅ);
SX2LNY:=SX2LNY+SQR(XÆIÅ)*LN(YÆIÅ);
SYLNX:=SYLNX+YÆIÅ*LN(XÆIÅ);
SYLNX2:=SYLNX2+YÆIÅ*SQR(LN(XÆIÅ));
SLNXLNY:=SLNXLNY+LN(XÆIÅ)*LN(YÆIÅ);
SLNX2LNY:=SLNX2LNY+SQR(LN(XÆIÅ))*LN(YÆIÅ);
END;
CLRSCR;
WRITELN(CHR(171),'X = ',SX:16:10);
WRITELN(CHR(171),'X^2 = ',SX2:16:10);
WRITELN(CHR(171),'S^3 = ',SX3:16:10);
WRITELN(CHR(171),'X^4 = ',SX4:16:10);
WRITELN(CHR(171),'LN(X)= ',SLNX:16:10);
WRITELN(CHR(171),'LN(X)^2 = ',SLNX2:16:10);
WRITELN(CHR(171),'LN(X)^3 = ',SLNX3:16:10);
WRITELN(CHR(171),'LN(X)^4 = ',SLNX4:16:10);
WRITELN(CHR(171),'Y = ',SY:16:10);
WRITELN(CHR(171),'Y^2 = ',SY2:16:10);
WRITELN(CHR(171),'LN(Y) = ',SLNY:16:10);
WRITELN(CHR(171),'LN(Y)^2 = ',SLNY2:16:10);
MORE;
CLRSCR;
WRITELN(CHR(171),'X,Y ',SXY:16:10);
WRITELN(CHR(171),'Y*X^2 ',SX2Y:16:10);
WRITELN(CHR(171),'X*LN(Y) = ',SXLNY:16:10);
WRITELN(CHR(171),'X^2*LN(Y)= ',SX2LNY:16:10);
WRITELN(CHR(171),'Y*LN(X) = ',SYLNX:16:10);
WRITELN(CHR(171),'Y*LN(X)^2 = ',SYLNX2:16:10);
WRITELN(CHR(171),'LNX*LNY = ',SLNXLNY:16:10);
WRITELN(CHR(171),'LNX2*LNY = ',SLNX2LNY:16:10);
MORE;
CLRSCR;
110:(*LINEAR CASE*)
A1:=SX4;A2:=SX3;A3:=SX2;
B1:=SX3;B2:=SX2;B3:=SX;
C1:=SX2;C2:=SX;C3:=N;
D1:=-SX2Y;D2:=-SXY;D3:=-SY;
EQUATIONS(1);
IF CTRL=1 THEN GOTO 40;
220:(*EXPONENTIAL CASE*)
A1:=SX4;A2:=SX3;A3:=SX2;
B1:=SX3;B2:=SX2;B3:=SX;
C1:=SX2;C2:=SX;C3:=N;
D1:=-SX2LNY;D2:=-SXLNY;D3:=-SLNY;
EQUATIONS(2);
IF CTRL=1 THEN GOTO 40;
330:(*LOGARITHMIC CASE*)
A1:=SLNX4;A2:=SLNX3;A3:=SLNX2;
B1:=SLNX3;B2:=SLNX2;B3:=SLNX;
C1:=SLNX2;C2:=SLNX;C3:=N;
D1:=-SYLNX2;D2:=-SYLNX;D3:=-SY;
EQUATIONS(3);
IF CTRL=1 THEN GOTO 40;
440:(*POWER CASE*)
A1:=SLNX4;A2:=SLNX3;A3:=SLNX2;
B1:=SLNX3;B2:=SLNX2;B3:=SLNX;
C1:=SLNX2;C2:=SLNX;C3:=N;
D1:=-SLNX2LNY;D2:=-SLNXLNY;D3:=-SLNY;
EQUATIONS(4);
IF CTRL=1 THEN GOTO 40;
EMIN:=EÆ1Å;BEST:=1;
FOR I:=2 TO 4 DO
BEGIN IF EÆIÅ<EMIN THEN
BEGIN
EMIN:=EÆIÅ;
BEST:=I;
END;
END;
CASE BEST OF
1: WRITELN('LINEAR FIT BEST! (1)');
2: WRITELN('EXPONENTIAL FIT BEST (2)');
3: WRITELN('LOGARITHMIC FIT BEST (3)');
4: WRITELN('POWER FIT BEST (4)');
END;
CTRL:=1;
50: WRITELN;
WRITE('ENTER ESTIMATION CASE 1 TO 4 , -1 TO STOP OR 0 TO RESTART ');
READLN(FIT);
CASE FIT OF
-1:GOTO 99;
0:GOTO 5;
1:GOTO 110;
2:GOTO 220;
3:GOTO 330;
4:GOTO 440;
END;
40:WRITE('X: ');READ(XINP);
CASE FIT OF
1: (*LINEAR:*)
YCALC:=A*SQR(XINP)+B*XINP+C;
2: (*EXPONENTIAL:*)
YCALC:=EXP(A*XINP*XINP+B*XINP+C);
3: (*LOGARITHMIC:*)
YCALC:=A*LN(SQR(XINP))+B*LN(XINP)+C;
4: (*POWER:*)
YCALC:=EXP(A*LN(XINP)*LN(XINP)+B*LN(XINP)+C);
END;
WRITELN('Y: ',YCALC:14:10);
GOTO 40;
99: FOR NN:=0 TO 9 DO;
END.
«eof»