home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 01 / curves / curve4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-03  |  17.7 KB  |  639 lines
  1. {
  2.                        F i l e    I n f o r m a t i o n
  3.  
  4. * DESCRIPTION
  5. Curve ++ (version T1.0) by Stephen Callender is a  Turbo Pascal 4.0 program
  6. that performs multiple regression on X and Y data and then draws a line that
  7. will best match the data. The user can choose from four lines - straight,
  8. exponential, logarithmic or power.
  9.  
  10. * ASSOCIATED FILES
  11. CURVE.PAS
  12. ASSAY.TXT
  13. CURVE.COM
  14. CURVE4.EXE
  15. CURVE4.PAS
  16. PRINTOUT.INC
  17. PT.LAS
  18. README
  19. SAMPLE.INC
  20. SAMPLE2.INC
  21. SAMPLE4.INC
  22. SAMPLE4B.INC
  23. SPACER.INC
  24. TOOLS.INC
  25. TOOLS4.INC
  26.  
  27. * CHECKED BY
  28. DRM - 01/25/88
  29.  
  30. * KEYWORDS
  31. CONTEST TUG-O-WARDS PROGRAM PASCAL V3.0 V4.0
  32.  
  33. ==========================================================================
  34. }
  35.  
  36. { CURVE++.PAS   FROM APPLESOFT BASIC  --> TURBO PASCAL  SEPT. 12, 1986
  37.   STEPHEN C. CALLENDER  MODIFIED AND ENHANCED BASIC PROGRAM FROM PUBLIC DOMAIN
  38.   UNDER DEVELOPMENT     9/16/86     SAMPLE ROUTINE ADDED
  39.   ADD THE LAST ROUTINES SPACE, HARDCOPY PRINTOUT CURVE   10/27/86   11/21/86
  40.   June 8, 1987 proofed by Stephen
  41.   June 18, 1987 compiled
  42.   revised with Turbo pascal version 4.0          Jan. 8, 1988                 }
  43.  
  44. PROGRAM CURVE;
  45. uses CRT, PRINTER, GRAPH;
  46. CONST BELL = #7;
  47.  
  48.     TYPE
  49.       STR25 = STRING[25];
  50.       CALC  = ARRAY[1..4] OF REAL;
  51.       MARK  = ARRAY[1..14] OF STRING[20];
  52.  
  53.    VAR
  54.      X,Y,Y1,Y2,X1,X2 : ARRAY[1..50] OF REAL;
  55.      B, M, C : CALC;
  56.      ENTRY, FLAG, POINT : INTEGER;
  57.  
  58. PROCEDURE WAIT;
  59. VAR PAUSE : CHAR;
  60. BEGIN
  61.      ASSIGN(INPUT,'');
  62.      RESET(INPUT);
  63.      READ(INPUT,PAUSE)
  64. END;
  65.  
  66. {$I TOOLS.INC}
  67.  
  68. PROCEDURE TITLE;
  69.   BEGIN
  70.     CLRSCR;
  71.       WRITELN('           CURVE TURBO PASCAL IBM VERSION 2.0 ');
  72.       WRITELN('           [C] 1/8/88 BY STEPHEN C. CALLENDER ');
  73.        INVERSE;
  74.     WRITE('              <+> MULTIPLE REGRESSION ON X,Y DATA <+>           ');
  75.    no_inverse; WRITELN;
  76.     WRITELN('                   DRAWS THE BEST LINE.');
  77.     WRITELN; WRITELN;
  78.     WRITELN('                  FOUR FITS ARE AVAILABLE: ');
  79.     WRITELN('                    LINEAR : y = b + mx');
  80.     WRITELN('                     POWER : y = bx ^ m ');
  81.     WRITELN('               LOGARITHMIC : y = b + b ln(x)');
  82.     WRITELN('               EXPONENTIAL : y = b exp(mx) ');
  83.     WRITELN;
  84.     PAUSE
  85. END;
  86.  
  87. PROCEDURE INITIALIZE;
  88.   VAR
  89.       N : INTEGER;
  90.     BEGIN
  91.       FOR N := 1 TO 4 DO
  92.           BEGIN
  93.                C[N] := 0; B[N] := 0; M[N] := 0
  94.         END
  95. END;
  96.  
  97. PROCEDURE LABELS(FFLAG : INTEGER; VAR BRAND : MARK);
  98.           VAR NAME : MARK;
  99.       BEGIN
  100.         CASE FFLAG OF
  101.         1 : NAME[1] := ' LINEAR ';
  102.         2 : NAME[2] := ' POWER ';
  103.         3 : NAME[3] := ' LOGARITHMIC ';
  104.         4 : NAME[4] := ' EXPONENTIAL ';
  105.         5 : NAME[5] := ' DATA UNSUITED TO ';
  106.         6 : NAME[6] := ' DATA ERROR ';
  107.         7 : NAME[7] := ' COMPUTE ';
  108.     END; { CASE }
  109.         WRITELN(NAME[FFLAG])
  110. END;
  111.  
  112. PROCEDURE SAVE;
  113.   VAR N : INTEGER;
  114.     FILER : TEXT;
  115.   BEGIN
  116.   WRITELN; WRITELN;
  117.  INVERSE;   WRITE('------SAVING TO THE DISK AS: ASSAY.TXT-----');
  118.      NO_INVERSE;
  119.     ASSIGN(FILER,'ASSAY.TXT');
  120.     REWRITE(FILER);
  121.       WRITELN(FILER,ENTRY);
  122.         FOR N:= 1 TO ENTRY DO
  123.             BEGIN
  124.               WRITELN(FILER,X[N]);
  125.               WRITELN(FILER,Y[N])
  126.               END;
  127.             CLOSE(FILER)
  128. END;
  129.  
  130. PROCEDURE LOAD;
  131.   VAR N : INTEGER;
  132.    FILER : TEXT;
  133.  BEGIN
  134.  WRITELN;
  135.  WRITELN;  INVERSE;
  136.  WRITE('-----LOADING THE FILE: ASSAY.TXT -----'); NO_INVERSE;
  137.    ASSIGN(FILER,'ASSAY.TXT');
  138.    RESET(FILER);
  139.     READLN(FILER);
  140.        FOR N := 1 TO ENTRY DO
  141.           BEGIN
  142.             READLN(FILER,X[N]);
  143.             READLN(FILER,Y[N])
  144.             END;
  145.          CLOSE(FILER)
  146. END;
  147.  
  148. PROCEDURE X_SINGLE_ENTRY;
  149. { X IS THE INDEX NO PAIRS }
  150.   VAR N, IOCODE : INTEGER;
  151.   BEGIN
  152.        ASSIGN(INPUT,'');
  153.      RESET(INPUT);
  154.   N := 0; X[N] := 0;     { JUNE 6, 1987 revision of former x index procedure }
  155.   REPEAT                 { previous pascal procedure probably did not work   }
  156.        N := N + 1;       { Version 1.43 Apple CP/M                           }
  157.     WRITELN('N =  ',N);
  158.     WRITELN('X =  ',X[N]:1:1);
  159.     WRITELN; WRITE('Y = ?  ');
  160.     REPEAT
  161.     {$I-} READLN(INPUT,Y[N]);
  162.     {$I+} IOCODE := IORESULT;
  163.     IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  TRY 0.NUMBER ');
  164.     UNTIL IOCODE = 0; WRITELN;
  165.     X[N] := X[N] + N;
  166.   UNTIL N = ENTRY;
  167.   POINT := 1
  168. END;
  169.  
  170. PROCEDURE X_PAIRED_ENTRY;
  171. { X IS THE INDEX AND PAIRED NUMBERS  }
  172.   VAR N, IOCODE : INTEGER;
  173.     BEGIN
  174.          ASSIGN(INPUT,'');
  175.      RESET(INPUT);
  176.       N :=0; X[N] := 0;     { this revision allows this procedure to work }
  177.       REPEAT                { unlike the original version from Basic      }
  178.        N := N + 1;          { Integer and real numbers can not be mixed   }
  179.        WRITELN('N =  ',N);                { in Pascal                     }
  180.        WRITELN('X =  ',X[N]:1:1);
  181.        WRITE('Y1 = ?  ');
  182.            REPEAT
  183.     {$I-} READLN(INPUT,Y1[N]);
  184.     {$I+} IOCODE := IORESULT;
  185.     IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  TRY 0.NUMBER ');
  186.     UNTIL IOCODE = 0; WRITELN;
  187.        WRITE('Y2 = ?  ');
  188.            REPEAT
  189.     {$I-} READLN(INPUT,Y2[N]);
  190.     {$I+} IOCODE := IORESULT;
  191.     IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  TRY 0.NUMBER ');
  192.     UNTIL IOCODE = 0; WRITELN;
  193.        Y[N] := (Y1[N] + Y2[N]) / 2;
  194.        { DISPLAY VALUES }
  195.          WRITELN('X =  ',N); WRITELN;
  196.          WRITELN('AVERAGE OF ',Y[N]:3:3,' & ',Y2[N]:3:3,' = ',Y[N]:3:3);
  197.          X[N] := X[N] + 1;
  198.       UNTIL N = ENTRY;
  199.       POINT :=2
  200. END;
  201.  
  202. PROCEDURE Y_SINGLE_ENTRY;
  203.   VAR N, IOCODE : INTEGER;
  204.   BEGIN
  205.        ASSIGN(INPUT,'');
  206.      RESET(INPUT);
  207.     N := 0;
  208.     REPEAT
  209.       N := N + 1;
  210.       WRITELN('N =  ',N);
  211.       WRITE('X = ?   ');
  212.            REPEAT
  213.     {$I-} READLN(INPUT,X[N]);
  214.     {$I+} IOCODE := IORESULT;
  215.     IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  TRY 0.NUMBER ');
  216.     UNTIL IOCODE = 0; WRITELN;
  217.       WRITE('Y = ?   ');
  218.           REPEAT
  219.     {$I-} READLN(INPUT,Y[N]);
  220.     {$I+} IOCODE := IORESULT;
  221.     IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  TRY 0.NUMBER ');
  222.     UNTIL IOCODE = 0; WRITELN;
  223.        WRITELN;
  224.          UNTIL N = ENTRY;
  225.       POINT :=3
  226. END;
  227.  
  228. PROCEDURE Y_PAIRED_ENTRY;
  229.   VAR N, IOCODE : INTEGER;
  230.   BEGIN
  231.        ASSIGN(INPUT,'');
  232.      RESET(INPUT);
  233.     N := 0;
  234.     REPEAT
  235.       N := N + 1;
  236.       WRITELN('N =   ',N);
  237.       WRITE('X = ?  ');
  238.           REPEAT
  239.     {$I-} READLN(INPUT,X[N]);
  240.     {$I+} IOCODE := IORESULT;
  241.     IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  TRY 0.NUMBER ');
  242.     UNTIL IOCODE = 0; WRITELN;
  243.       WRITE('Y1 = ?   ');
  244.           REPEAT
  245.     {$I-} READLN(INPUT,Y1[N]);
  246.     {$I+} IOCODE := IORESULT;
  247.     IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  TRY 0.NUMBER ');
  248.     UNTIL IOCODE = 0; WRITELN;
  249.       WRITE('Y2 = ?   ');
  250.           REPEAT
  251.     {$I-} READLN(INPUT,Y2[N]);
  252.     {$I+} IOCODE := IORESULT;
  253.     IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  TRY 0.NUMBER ');
  254.     UNTIL IOCODE = 0; WRITELN;
  255.       Y[N] := (Y1[N] + Y2[N]) / 2;
  256.     WRITELN(X[N]:3:3); WRITELN;
  257.     WRITELN('average of ',Y1[N]:3:3,' & ',Y2[N]:3:3,' = ',Y[N]:3:3);
  258.     UNTIL N = ENTRY;
  259.   PAUSE;
  260.   POINT :=4
  261. END;
  262.  
  263. PROCEDURE DATA_ENTRY;
  264.   VAR
  265.    CHOICE : CHAR;
  266.    BEGIN
  267.      CLRSCR;
  268.      INVERSE;
  269.     WRITE('DATA ENTRY MODE');
  270.     NO_INVERSE;
  271.      WRITELN;
  272.      WRITE('enter the number of data points for standard curve  ');
  273.      READLN(ENTRY);
  274.      WRITELN('DATA POINT SELECTION:  ');
  275.      WRITELN('x (index) single points press < a > ' );
  276.      WRITELN('x (index) paired points press < b > ' );
  277.      WRITELN('y (index) single points press < c > ' );
  278.      WRITELN('y (index) paired points press < d > ' );
  279.      WRITELN;
  280.       INVERSE;
  281.      WRITE( 'CHOOSE YOUR SELECTION:  ');
  282.      NO_INVERSE;
  283.      READLN(CHOICE);
  284.        CASE CHOICE OF
  285.        'A','a' : X_SINGLE_ENTRY;
  286.        'B','b' : X_PAIRED_ENTRY;
  287.        'C','c' : Y_SINGLE_ENTRY;
  288.        'D','d' : Y_PAIRED_ENTRY;
  289.        END; { CASE }
  290.      save;
  291. END;
  292.  
  293. PROCEDURE MENU;
  294.  FORWARD;
  295.  
  296. PROCEDURE EDIT_LIST;
  297.    FORWARD;
  298.  
  299. PROCEDURE EDIT_DATA;
  300.   VAR N : INTEGER;
  301.     CHOICE : CHAR;
  302.   BEGIN
  303.        ASSIGN(INPUT,'');
  304.      RESET(INPUT);
  305.     CLRSCR;
  306.  INVERSE;
  307.      WRITE('which data pair ?   ');
  308.      NO_INVERSE;
  309.      READ(N);
  310.      WRITELN;
  311.    WRITELN(' DATA ',N,' PRESENTLY ');
  312.    WRITELN;
  313.       WRITELN('X =  ',X[N]:3:3);
  314.       WRITELN('Y =  ',Y[N]:3:3); WRITELN;
  315.       WRITELN('INPUT NEW DATA: ');
  316.       IF (POINT = 1) OR (POINT = 2) THEN
  317.         BEGIN
  318.          WRITELN('X =  ',N); WRITELN;
  319.          WRITE('Y = ?  ');
  320.          READLN(INPUT,Y[N]); WRITELN
  321.        END
  322.      ELSE
  323.        BEGIN
  324.          WRITE('X = ?  ');
  325.          READLN(INPUT,X[N]);
  326.          WRITELN;
  327.          WRITE('Y = ?  ');
  328.          READLN(INPUT,Y[N]); WRITELN
  329.      END;
  330.      WRITELN;
  331.      WRITE('press (return) = more or O = options ');
  332.      READ(INPUT,CHOICE);
  333.      IF CHOICE IN ['O','o'] THEN MENU
  334.        ELSE EDIT_LIST
  335. END;
  336.  
  337. PROCEDURE LIST_DATA;
  338.    VAR N : INTEGER;
  339.      BEGIN
  340.           ASSIGN(OUTPUT,'');
  341.           REWRITE(OUTPUT);
  342.        CLRSCR;
  343.          FOR N := 1 TO ENTRY DO BEGIN
  344.            WRITELN(OUTPUT); WRITELN(OUTPUT,'# OF POINTS =  ',ENTRY);
  345.            WRITELN(OUTPUT,'N =  ',N);
  346.            WRITELN(OUTPUT); WRITELN(OUTPUT,'X =  ',X[N]:3:3);
  347.            WRITELN(OUTPUT,'Y =  ',Y[N]:3:3);
  348.            wait;
  349.          PAUSE
  350.      END
  351. END;
  352.  
  353. PROCEDURE EDIT_LIST;
  354.   VAR CHOOSE  :  CHAR;
  355.     BEGIN
  356.           ASSIGN(INPUT,'');
  357.      RESET(INPUT);
  358.     CLRSCR;
  359.     WRITELN('do you wish to E)dit or L)ist data points of standard curve ');
  360.     READ(INPUT,CHOOSE);
  361.             CASE CHOOSE OF
  362.             'E','e' : EDIT_DATA;
  363.             'L','l' : LIST_DATA
  364.         END
  365. END;
  366.  
  367. {"passed in" flag for displaying the final results of the standard curve }
  368.  
  369. PROCEDURE DISPLAY_CURVE(FFLAG : INTEGER);
  370.           VAR
  371.             NAME : MARK;
  372.           BEGIN
  373.           CLRSCR;
  374.             WRITELN;
  375.               LABELS(FFLAG,NAME); WRITELN;
  376.               WRITELN('Y - INTERCEPT =  ',B[FFLAG]:3:3); WRITELN;
  377.               WRITELN('SLOPE         =  ',M[FFLAG]:3:3); WRITELN;
  378.               WRITELN('CORR.COEFF    =  ',C[FFLAG]:3:3);
  379.            PAUSE
  380. END;
  381.  
  382. { new procedure works only under Turbo Pascal version 4.0   }
  383. PROCEDURE DISPLAY_GRAPH(FFLAG : INTEGER);
  384. VAR
  385.    R, DRIVER, MODE, CODE : INTEGER;
  386.    MX, MY : REAL;
  387.    CX, CY ,XM, XN, YM, YN : REAL;
  388.    XX, YY : ARRAY[1..20] OF REAL;
  389.    XG, YG : ARRAY[1..20] OF integer;
  390. BEGIN
  391.      CASE FFLAG OF
  392.      2 : BEGIN
  393.               FOR R := 1 TO ENTRY DO BEGIN
  394.                   X[R] := Ln(X[R]);
  395.                   Y[R] := Ln(Y[R])
  396.               END
  397.            END;
  398.      3  : BEGIN
  399.                FOR R := 1 TO ENTRY DO
  400.                    X[R] := Ln(X[R])
  401.                 END;
  402.      4 : BEGIN
  403.               FOR R := 1 TO ENTRY DO
  404.                   Y[R] := Ln(Y[R])
  405.                END
  406.          END;  { END OF CASE }
  407.          { NORMALIZATION OF VARIABLES }
  408.  
  409.     XM := X[1];
  410.       XN := X[1];
  411.          YM := Y[1];
  412.             YN := Y[1];
  413.             FOR R := 2 TO ENTRY DO
  414.                 BEGIN
  415.                      IF XM < X[R] THEN XM := X[R];
  416.                      IF XN > X[R] THEN XN := X[R];
  417.                      IF YM < Y[R] THEN YM := Y[R];
  418.                      IF YN > Y[R] THEN YN := Y[R]
  419.                  END;
  420.      CX := 275 / ((XM - XN) + 1);
  421.      CY := 155 / ((YM - YN) + 1);
  422.      FOR R := 1 TO ENTRY DO BEGIN
  423.          XX[R] := X[R] * CX;
  424.          YY[R] := Y[R] * CY
  425.     END;
  426.     MX := XX[1];
  427.     MY := YY[1];
  428.     FOR R := 2 TO ENTRY DO BEGIN
  429.         IF MX > XX[R] THEN MX := XX[R];
  430.         IF MY > YY[R] THEN MY := YY[R]
  431.      END;
  432.      MX := MX - 3;
  433.      MY := MY - 3;         {  NEED INTEGERS FROM REAL NUMBERS FOR GRAPH  }
  434.      FOR R := 1 TO ENTRY DO BEGIN
  435.          XG[R] := TRUNC(XX[R] - MX);
  436.          YG[R] := TRUNC(YY[R] - MY)
  437.      END;
  438.      DRIVER := DETECT;
  439.      INITGRAPH(DRIVER,MODE,'');
  440.      CODE := GRAPHRESULT;
  441.      IF CODE <> GROK THEN BEGIN
  442.        WRITELN('------ NO GRAPHICS BOARD FOUND ! -------');
  443.         WRITELN('-- YOUR PROGRAM HAS BEEN ABORTED -----');
  444.         HALT(1)
  445.       END;                      {      DRAW X AND Y AXIS      }
  446.       line(0,0,0,190);       {   y axis   }
  447.       LINE(0,190,320,190);   {   x axis   }
  448.               FOR R := 1 TO ENTRY - 1 DO
  449.                   LINE(XG[R],(190-YG[R]),XG[R+1],(190-YG[R+1]));
  450.           REPEAT
  451.           OUTTEXTXY(0,320,'==== PRESS ANY KEY TO CONTINUE ========');
  452.           UNTIL KEYPRESSED;
  453.           CLOSEGRAPH
  454. END;
  455.  
  456.  
  457. PROCEDURE COMPUTE(FFLAG : INTEGER);
  458.  
  459.        VAR FLAG2, N, BEST  :  INTEGER;
  460.     XX, YY, CC, XL, XY, YL, YS, XS  :  REAL;
  461.            NAME  :  MARK;
  462.     BEGIN
  463.       INITIALIZE;
  464.        XX := 0;
  465.         XS := 0;
  466.          YY := 0;
  467.          CC := 0;
  468.         XL := 0;
  469.        XY := 0;
  470.       YL := 0;
  471.      YS := 0;
  472.         CASE FFLAG OF
  473.         1 : BEGIN
  474.             FOR N := 1 TO ENTRY DO
  475.              BEGIN
  476.              XX := XX + X[N];
  477.              YY := YY + Y[N];
  478.              XY := (XY + (X[N] * Y[N]));
  479.              XS := XS + SQR(X[N]);
  480.              YS := YS + SQR(Y[N]);
  481.           END;
  482.   {    DEBUG;    }
  483. M[1] := XY - ((XX * YY) / ENTRY);
  484. M[1] :=M[1] / (XS - (SQR(XX) / ENTRY));
  485. B[1] :=(YY / ENTRY) - (M[1] * (XX / ENTRY));
  486. C[1] :=SQR(XY - ((XX * YY) / ENTRY));
  487. C[1] :=C[1]/(XS-(SQR(XX)/ENTRY));
  488. C[1] :=C[1]/(YS - (SQR(YY)/ENTRY));
  489. { display the computation  }
  490. DISPLAY_CURVE(1);
  491. WRITE(BELL)
  492. END;
  493.  
  494.     2 : BEGIN
  495.             FOR N := 1 TO ENTRY DO
  496.             BEGIN
  497.               XL :=LN(X[N]);
  498.               YL :=LN(Y[N]);
  499.               XX :=XX + XL;
  500.               YY :=YY + YL;
  501.               XY :=XY + (XL * YL);
  502.               XS :=XS + SQR(XL);
  503.               YS :=YS + SQR(YL)
  504.            END;
  505.        {    debug; }
  506.         M[2] := XY-(XX * YY/ENTRY);
  507.         M[2] := M[2]/(XS-(SQR(XX)/ENTRY));
  508.         B[2] := EXP((YY/ENTRY)-(M[2] * XX/ENTRY));
  509.         C[2] := SQR(XY-(XX * YY/ENTRY));
  510.         C[2] := C[2]/(XS-(SQR(XX)/ENTRY));
  511.         C[2] := C[2]/(YS-(SQR(YY)/ENTRY));
  512.         DISPLAY_CURVE(2);
  513.         WRITE(BELL)
  514.           END;
  515.  
  516.      3  :  BEGIN
  517.               FOR N := 1 TO ENTRY DO
  518.                 BEGIN
  519.                   XL := LN(X[N]);
  520.                   YL := Y[N];
  521.                   XX := XX + XL;
  522.                   YY := YY + YL;
  523.                   XY := XY + (XL * YL);
  524.                   XS := XS + SQR(XL);
  525.                   YS := YS + SQR(YL)
  526.               END;
  527.          {    debug;  }
  528.             M[3] := ((XY-(1/ENTRY)* XX * YY));
  529.             M[3] := M[3] / (XS-((1/ENTRY) * SQR(XX) ));
  530.             B[3] := (1/ENTRY) * (YY-(M[3] * XX));
  531.             C[3] := SQR(XY-((1/ENTRY) * XX * YY));
  532.             C[3] := C[3]/(XS-((1/ENTRY) * SQR(XX)));
  533.             C[3] := C[3]/(YS-((1/ENTRY) * SQR(YY)));
  534.             DISPLAY_CURVE(3);
  535.             WRITE(BELL)
  536.           END;
  537.  
  538.      4  :  BEGIN
  539.               FOR N := 1 TO ENTRY DO
  540.                 BEGIN
  541.                   XL := X[N];
  542.                   YL := LN(Y[N]);
  543.                   XX := XX + XL;
  544.                   YY := YY + YL;
  545.                   XY := XY + (XL * YL);
  546.                   XS := XS + SQR(XL);
  547.                   YS := YS + SQR(YL)
  548.               END;
  549.            {   debug;   }
  550.               M[4] := ((XY-((1/ENTRY) * XX * YY))/(XS-((1/ENTRY) * SQR(XX))));
  551.               B[4] := EXP((YY/ENTRY)-(M[4] * (XX/ENTRY)));
  552.               C[4] := SQR(XY-((1/ENTRY) * XX * YY));
  553.               C[4] := C[4]/(XS-(SQR(XX)/ENTRY));
  554.               C[4] := C[4]/(YS-(SQR(YY)/ENTRY));
  555.               DISPLAY_CURVE(4);
  556.             END;
  557.  
  558.      5 : BEGIN
  559.             FOR N := 1 TO 4 DO
  560.             COMPUTE(N);
  561.             if c[1] < c[2] then best := 2
  562.                 else best := 1;
  563.                    if c[3] < c[4] then best := 4
  564.                       else best := 3;
  565.                            writeln;
  566.                              compute(best);
  567.                              CLRSCR;
  568.                           display_curve(best);
  569.                  INVERSE; WRITE('     B E S T    F I T     '); NO_INVERSE;
  570.                  WRITELN;
  571.               WRITE(BELL);
  572.                  PAUSE
  573.              END;
  574.          END; {CASE}
  575.      READLN
  576. END; { procedure compute }
  577.  
  578. {$I SAMPLE4.INC}
  579. {$I SAMPLE4B.INC}
  580. {$I PRINTOUT.INC}
  581.  
  582. PROCEDURE MENU;
  583.     VAR CHOICE, FIT :  INTEGER;
  584.   BEGIN
  585.      CLRSCR;
  586.    WRITELN(' options:  '); WRITELN;
  587.      WRITELN('          (1) compute linear curve');
  588.      WRITELN('          (2) compute power curve');
  589.      WRITELN('          (3) compute logarithmic curve');
  590.      WRITELN('          (4) compute exponential curve');
  591.      WRITELN('          (5) compute & find the best fit');
  592.      WRITELN('          (6) LIST AND/OR EDIT DATA');
  593.      WRITELN('          (7) ENTER DATA TABLE FOR STANDARD CURVE');
  594.      WRITE('          (8)  '); INVERSE;
  595.      WRITE('  SAMPLES  '); NO_INVERSE;
  596.      WRITE('  FOR CALCULATIONS  '); WRITELN;
  597.      WRITELN('          (9) hardcopy of standard curve');
  598.      WRITELN('          (10)  load previous saved standard curve');
  599.      WRITELN('          (11)  display graph of standard curve');
  600.      WRITELN('          (12)  exit to the system'); WRITELN;
  601.    INVERSE; WRITELN('  please make your selection:  '); NO_INVERSE;
  602.      READ(CHOICE);
  603.           CASE CHOICE OF
  604.           1 : BEGIN
  605.                  COMPUTE(1);
  606.                FLAG :=1;
  607.              END;
  608.           2 : BEGIN
  609.                COMPUTE(2);
  610.              FLAG := 2
  611.             END;
  612.           3 : BEGIN
  613.                 COMPUTE(3);
  614.               FLAG := 3
  615.               END;
  616.           4 : BEGIN
  617.                 COMPUTE(4);
  618.               FLAG := 4
  619.                 END;
  620.           5 : COMPUTE(5);
  621.           6 : EDIT_LIST;
  622.           7 : DATA_ENTRY;
  623.           8 : SAMPLE_PREP(FIT);
  624.           9 : HARDCOPY;
  625.          10 : LOAD;
  626.          11 : DISPLAY_GRAPH(FLAG);
  627.         12 : HALT
  628.          END;  {CASE}
  629.        MENU
  630. END;
  631.  
  632. BEGIN
  633.  TITLE;
  634.  MENU
  635. END.
  636.  
  637.  
  638. 
  639.