home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 01 / curves / sample4b.inc < prev    next >
Encoding:
Text File  |  1988-09-03  |  10.0 KB  |  321 lines
  1. {
  2.                        F i l e    I n f o r m a t i o n
  3.  
  4. * DESCRIPTION
  5. Include source code file for curve.
  6.  
  7. * ASSOCIATED FILES
  8. CURVE.PAS
  9. ASSAY.TXT
  10. CURVE.COM
  11. CURVE4.EXE
  12. CURVE4.PAS
  13. PRINTOUT.INC
  14. PT.LAS
  15. README
  16. SAMPLE.INC
  17. SAMPLE2.INC
  18. SAMPLE4.INC
  19. SAMPLE4B.INC
  20. SPACER.INC
  21. TOOLS.INC
  22. TOOLS4.INC
  23.  
  24. ==========================================================================
  25. }
  26. {       SAMPLE4B.INC  COMPILES    UNDER TURBO PASCAL VERSION 4.0         }
  27.  
  28. { SPACE.INC used like the basic command spc() to add spaces }
  29. PROCEDURE SPC ( FIELD : INTEGER);
  30.  
  31.    VAR
  32.      SPACES : STRING[80];
  33.      I , SPACEONLINE : INTEGER;
  34.  
  35. BEGIN
  36.   SPACES :=' ';
  37.   SPACEONLINE := FIELD;
  38.   FOR i := 1 TO SPACEONLINE DO SPACES := SPACES + ' ';
  39.   WRITE (LST,SPACES);
  40.   END;
  41.  
  42. PROCEDURE Y_SINGLE_SAMPLE(TOTAL : INTEGER; FIT : INTEGER);
  43.           VAR
  44.             SAMPLE, SPACER, PACE, IOCODE : INTEGER;
  45.             XV, YV, DIL : ARRAY[1..50] OF REAL;
  46.             T1, T2, DILUTION : ARRAY[1..50] OF STR25;
  47.               SPECIMEN : ARRAY[1..50] OF STR25;
  48.              CHOICE : CHAR;
  49.        BEGIN
  50.          CLRSCR;
  51.            FOR SAMPLE := 1 TO TOTAL DO
  52.                BEGIN
  53.                  WRITE('SPECIMEN ? ');
  54.                    READLN(SPECIMEN[SAMPLE]);
  55.                  WRITELN;
  56.                WRITE('ENTER TEST Y ?  ');
  57.                REPEAT
  58.            {$I-} READLN(YV[SAMPLE]);
  59.            {$I+} IOCODE := IORESULT;
  60.            IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  try 0.number ');
  61.            UNTIL IOCODE = 0; WRITELN;
  62.             WRITE('ENTER DILUTION FACTOR [ UND = 1 ]  ');
  63.             READLN(DIL[SAMPLE]);
  64.           WRITELN
  65.         END;
  66.             CASE FIT OF
  67.                       1 : BEGIN
  68.               DISPLAY_CURVE(1);
  69.               FOR SAMPLE := 1 TO TOTAL DO BEGIN
  70.                 XV[SAMPLE] := (YV[SAMPLE] - B[FIT] / M[FIT]);
  71.                 XV[SAMPLE] := XV[SAMPLE] * DIL[SAMPLE];
  72.                 WRITE('#  ',SAMPLE,'  ');
  73.                 WRITELN(SPECIMEN[SAMPLE],' = ',XV[SAMPLE]:2:2)
  74.                 END;
  75.                 PAUSE
  76.               END;
  77.             2 : BEGIN
  78.                  DISPLAY_CURVE(2);
  79.                   FOR SAMPLE := 1 TO TOTAL DO BEGIN
  80.                   XV[SAMPLE] := SQR((YV[SAMPLE] / B[FIT] * (1 / M[FIT])));
  81.                   XV[SAMPLE] := XV[SAMPLE] * DIL[SAMPLE];
  82.                   write('#  ',sample,'  ');
  83.                   writeln(specimen[sample],' = ',xv[sample]:2:2)
  84.                 END;
  85.                 PAUSE
  86.               END;
  87.             3 : BEGIN
  88.                 DISPLAY_CURVE(3);
  89.                   FOR SAMPLE := 1 TO TOTAL DO BEGIN
  90.                   XV[SAMPLE] := EXP((YV[SAMPLE]-B[FIT])/M[FIT]);
  91.                   XV[SAMPLE] := XV[SAMPLE] * DIL[SAMPLE];
  92.                   WRITE('#  ',SAMPLE,'  ');
  93.                   WRITELN(SPECIMEN[SAMPLE],' = ',XV[SAMPLE]:2:2)
  94.                 END;
  95.                 PAUSE
  96.               END;
  97.             4 : BEGIN
  98.                 DISPLAY_CURVE(4);
  99.                   FOR SAMPLE := 1 TO TOTAL DO BEGIN
  100.                   XV[SAMPLE] := LN(YV[SAMPLE] / B[FIT]) / M[FIT];
  101.                   XV[SAMPLE] := XV[SAMPLE] * DIL[SAMPLE];
  102.                   WRITE('#  ',SAMPLE,'  ');
  103.                   WRITELN(SPECIMEN[SAMPLE],' = ',XV[SAMPLE]:2:2)
  104.                 END;
  105.                 PAUSE
  106.               END
  107.             END; { CASE }
  108.         { HARDCOMPY }
  109.   WRITELN; INVERSE;
  110. WRITE(' do you want a hardcopy?  [ Y/N ] '); NO_inverse;
  111. READLN(CHOICE);
  112. IF CHOICE IN ['Y','y'] THEN BEGIN
  113.              WRITE(LST,'---------------------------');
  114.              WRITE(LST,'---------------------------');
  115.              WRITELN(LST); WRITELN(LST);
  116.   WRITELN(LST,'SAMPLES'); WRITELN(LST);
  117.   WRITE(LST,'# '); SPC(14);
  118.   WRITE(LST,'SAMPLE'); SPC(6);
  119.   WRITE(LST,'DILUTION'); SPC(11);
  120.   WRITE(LST,' t '); SPC(11);
  121.   WRITE(LST,' UNITS/ML');
  122.   WRITE(LST);
  123.   FOR SAMPLE := 1 TO TOTAL DO BEGIN
  124.   WRITE(LST,SAMPLE);
  125.    PACE := LENGTH(SPECIMEN[SAMPLE]);
  126.    SPACER := 20 - PACE;
  127.    SPC(SPACER);
  128.    WRITE(LST,SPECIMEN[SAMPLE]);
  129.    STR(DIL[SAMPLE],DILUTION[SAMPLE]);
  130.    PACE :=LENGTH(DILUTION[SAMPLE]);
  131.    SPACER := 19 - PACE;
  132.    SPC(SPACER);
  133.    WRITE(LST,DIL[SAMPLE]:2:2);
  134.    STR(XV[SAMPLE],T1[SAMPLE]);
  135.     PACE := LENGTH(T1[SAMPLE]);
  136.     SPACER := 22 - PACE;
  137.     SPC(SPACER);
  138.     WRITE(LST,YV[SAMPLE]:2:2);
  139.     SPC(12);
  140.   WRITELN(LST,XV[SAMPLE]:2:2);
  141.   END;
  142.  END
  143. END;
  144.  
  145.  
  146. PROCEDURE Y_PAIRED_SAMPLE (TOTAL, FIT : INTEGER);
  147.           VAR
  148.             SAMPLE, SPACER, PACE, IOCODE : INTEGER;
  149.             YV1, YV2, XV, YV, DIL : ARRAY[1..50] OF REAL;
  150.             T1, T2, DILUTION : ARRAY[1..50] OF STRING[10];
  151.             SPECIMEN : ARRAY[1..50] OF STR25;
  152.             CHOICE : CHAR;
  153.        BEGIN
  154.          CLRSCR;
  155.          FOR SAMPLE := 1 TO TOTAL DO BEGIN
  156.          WRITE('SPECIMEN NAME ? ');
  157.          READLN(SPECIMEN[SAMPLE]);
  158.          WRITELN;
  159.          WRITE('ENTER TEST Y1 ?  ');
  160.          REPEAT
  161.            {$I-} READLN(YV1[SAMPLE]);
  162.            {$I+} IOCODE := IORESULT;
  163.            IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  try 0.number ');
  164.            UNTIL IOCODE = 0; WRITELN;
  165.             WRITE('ENTER TEST Y2 ?  ');
  166.             REPEAT
  167.            {$I-} READLN(YV2[SAMPLE]);
  168.            {$I+} IOCODE := IORESULT;
  169.            IF IOCODE <> 0 THEN WRITELN('BAD INPUT!  try 0.number ');
  170.            UNTIL IOCODE = 0; WRITELN;
  171.                WRITE(' enter dilution factor [ und = 1 ] ');
  172.                READLN(DIL[SAMPLE]);
  173.              WRITELN;
  174.              YV[SAMPLE] := (YV1[SAMPLE] + YV2[SAMPLE]) / 2
  175.            END;
  176.                               { DISPLAY & COMPUTATIONS }
  177.            CASE FIT OF
  178.               1 : BEGIN
  179.               DISPLAY_CURVE(1);
  180.               FOR SAMPLE := 1 TO TOTAL DO BEGIN
  181.                 XV[SAMPLE] := (YV[SAMPLE] - B[FIT]) / M[FIT];
  182.                 XV[SAMPLE] := XV[SAMPLE] * DIL[SAMPLE];
  183.                 WRITE('#  ',SAMPLE,'  ');
  184.                 WRITELN(SPECIMEN[SAMPLE],' = ',XV[SAMPLE]:2:2)
  185.                 END;
  186.                 PAUSE
  187.               END;
  188.             2 : BEGIN
  189.                 DISPLAY_CURVE(2);
  190.                   FOR SAMPLE := 1 TO TOTAL DO BEGIN
  191.                   XV[SAMPLE] := SQR( (YV[SAMPLE] / B[FIT]) * (1 / M[FIT]) );
  192.                   XV[SAMPLE] := XV[SAMPLE] * DIL[SAMPLE];
  193.                   write('#  ',sample,'   ');
  194.                   writeln(specimen[sample],' = ',xv[sample]:2:2)
  195.                 END;
  196.                 PAUSE
  197.               END;
  198.             3 : BEGIN
  199.                 DISPLAY_CURVE(3);
  200.                   FOR SAMPLE := 1 TO TOTAL DO BEGIN
  201.                   XV[SAMPLE] := EXP((YV[SAMPLE]-B[FIT])/M[FIT]);
  202.                   XV[SAMPLE] := XV[SAMPLE] * DIL[SAMPLE];
  203.                   WRITE('#  ',SAMPLE,'  ');
  204.                   WRITELN(SPECIMEN[SAMPLE],' = ',XV[SAMPLE]:2:2)
  205.                 END;
  206.                 PAUSE
  207.               END;
  208.             4 : BEGIN
  209.                 DISPLAY_CURVE(4);
  210.                   FOR SAMPLE := 1 TO TOTAL DO BEGIN
  211.                   XV[SAMPLE] := LN(YV[SAMPLE] / B[FIT]) / M[FIT];
  212.                   XV[SAMPLE] := XV[SAMPLE] * DIL[SAMPLE];
  213.                   WRITE('#  ',SAMPLE,'  ');
  214.                   WRITELN(SPECIMEN[SAMPLE],' = ',XV[SAMPLE]:2:2)
  215.                 END;
  216.                 PAUSE
  217.               END
  218.             END; { CASE }
  219.         { HARDCOPY }
  220.   WRITELN; INVERSE;
  221. WRITE(' do you want a hardcopy?  [ Y/N ] '); NO_inverse;
  222. READLN(CHOICE);
  223. IF CHOICE IN ['Y','y'] THEN BEGIN
  224.              WRITE(LST,'------------------------------------');
  225.              WRITE(LST,'------------------------------------');
  226.              WRITELN(LST); WRITELN(LST);
  227.   WRITELN(LST,'SAMPLES'); WRITELN(LST);
  228.   WRITE(LST,'# '); SPC(11);
  229.   WRITE(LST,'SAMPLE'); SPC(7);
  230.   WRITE(LST,'DILUTION'); SPC(6);
  231.   WRITE(LST,' T1 '); SPC(6);
  232.   write(lst,' T2 '); spc(4);
  233.   WRITE(LST,' UNITS/ML');
  234.   WRITELN(LST);
  235.   FOR SAMPLE := 1 TO TOTAL DO BEGIN
  236.   WRITE(LST,SAMPLE);
  237.    PACE := LENGTH(SPECIMEN[SAMPLE]);
  238.    SPACER := 20 - PACE;
  239.    SPC(SPACER);
  240.    WRITE(LST,SPECIMEN[SAMPLE]);
  241.    STR(DIL[SAMPLE],DILUTION[SAMPLE]);
  242.    PACE :=LENGTH(DILUTION[SAMPLE]);
  243.    SPACER := 15 - PACE;
  244.    SPC(SPACER);
  245.    WRITE(LST,DIL[SAMPLE]:2:2);
  246.    STR(XV[SAMPLE],T1[SAMPLE]);
  247.     PACE := LENGTH(T1[SAMPLE]);
  248.     SPACER := 18 - PACE;
  249.     SPC(SPACER);
  250.     WRITE(LST,YV1[SAMPLE]:2:2);
  251.     SPC(5);
  252.     write(lst,yv2[sample]:2:2);
  253.     spc(6);
  254.   WRITELN(LST,XV[SAMPLE]:2:2);
  255.   END;
  256.  END
  257. END;
  258.  
  259. procedure x_samples(var total : integer);
  260.    var
  261.     choice : char;
  262. begin
  263.      writeln; inverse;
  264.      write('computation of x points'); NO_INVERSE;
  265.      writeln;
  266.      write('HOW MANY SAMPLES TO BE CALCULATED ? ');
  267.      READLN(TOTAL);
  268.      WRITE('ARE PAIRS OF NUMBERS TO BE CALCULATED [Y/N ] ');
  269.      READLN(CHOICE);
  270.          IF CHOICE IN ['N','n'] THEN X_SINGLE_SAMPLE(TOTAL,FLAG)
  271.       ELSE
  272.          X_PAIRED_SAMPLE(TOTAL,FLAG)
  273. END;
  274.  
  275. procedure y_samples(var total : integer);
  276.   var
  277.     choice : char;
  278. begin
  279.      writeln; inverse;
  280.      write('COMPUTATIONS OF Y POINTS'); NO_INVERSE;
  281.      WRITELN;
  282.      WRITE('HOW MANY SAMPLES TO BE CALCULATED ? ');
  283.      READLN(TOTAL);
  284.      WRITE('ARE PAIRS OF NUMBERS TO BE CALCULATED ? [ Y/N ]  ');
  285.      READLN(CHOICE);
  286.      IF CHOICE IN ['N','n'] THEN y_SINGLE_SAMPLE(TOTAL,FLAG)
  287.    ELSE
  288.        Y_PAIRED_SAMPLE(TOTAL,FLAG)
  289. END;
  290.  
  291.  
  292. PROCEDURE SAMPLE_PREP (VAR FIT : INTEGER);
  293.   VAR
  294.      X, Y, CHOICE : CHAR;
  295.      BEST_FIT : INTEGER;
  296.      TITLE : MARK;
  297. BEGIN
  298.      CLRSCR;
  299.      INVERSE;
  300.      WRITE('* use this routine only after computations * '); NO_INVERSE;
  301.      WRITE(' CONTINUE ?  [ Y/N ] ');
  302.      READLN(CHOICE);
  303.      IF CHOICE IN ['N','n'] THEN MENU
  304.    ELSE
  305.      BEGIN
  306.        FOR BEST_FIT := 1 TO 4 DO
  307.            IF C[BEST_FIT] <> 0 THEN BEGIN
  308.               WRITE('( ',BEST_FIT,' ) ');
  309.                        LABELS(BEST_FIT,TITLE)
  310.                      END;
  311.            WRITELN; WRITE('ENTER WHICH  ?  ');
  312.          READLN(FIT);
  313.          IF (C[FIT] = 0) OR (FIT > 4) THEN SAMPLE_PREP(FIT);
  314.           WRITE('ENTER X TO Y [ press x ] or Y TO X [ press y ] ');
  315.            readln(choice);
  316.             IF CHOICE IN ['X','x'] THEN X_SAMPLES(FIT)
  317.         ELSE Y_SAMPLES(FIT)
  318.     END
  319. END;
  320. 
  321.