home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / educ / pstat2.zip / LILFOR13.PQS / lilfor13.pas
Pascal/Delphi Source File  |  1987-02-07  |  28KB  |  922 lines
  1. PROGRAM Lilfor ; { Version 1.3 }
  2. { This program does two things. It prints a graph that can be used to hand
  3.   plot a sample CDF to perform the Lilliefors test for normality. It also
  4.   reads data from disk or keyboard and performs the Lilliefors test, both
  5.   graphically and algebraically. To do the test, there must be between 4
  6.   and 255 rows of data. See LILFOR.DOC for more information. }
  7.  
  8. { This program is placed in the public domain by Joseph C. Hudson }
  9.  
  10. {$C-}
  11. CONST Limit = 255;
  12.  
  13. TYPE
  14.    String3  = String[3]  ;
  15.    String14 = String[14] ;
  16.    InSet    = Set Of Char ;
  17.    Indices  = Array [1..15] Of String[3] ;
  18.    GridSize = Array [0..719,0..49] Of Byte ;
  19.    DataType = Array [1..Limit] Of Real ;
  20.  
  21. VAR
  22.    DataCol, Special, Op1, Op2, N : Integer ;
  23.    Key : Char ;
  24.    Elite, FormFeed, GraphLine, InitPr, Lpi6, LS872 : String[6] ;
  25.    FileName : String[14] ;
  26.    Data: DataType ;
  27.    Grid : GridSize ;
  28.    DCrit, ErrTol, S2Pi, DMax, WMax, XMax : Real ;
  29.    Reject, DoneAlready : Boolean ;
  30.    Y        : Array [1..718] Of Real ;
  31.    Digit    : Array [ 0..9 , 1..5 ] Of Integer ;
  32.    Index    : Array [1..15] Of String3 ;
  33.    Quantile : Array [1..15] Of Real ;
  34.  
  35. Procedure DefinePrintVars ;
  36. Begin
  37.    Elite     := #27#77       ; { elite pitch, 12 char/in.                  }
  38.    FormFeed  := #12          ; { formfeed                                  }
  39.    GraphLine := #27#76#208#2 ; { set for 8 lines of 720 dots @ 120 per in. }
  40.    InitPr    := #27#64       ; { Initialize Printer                        }
  41.    Lpi6      := #27#50       ; { Line spacing 6 lines per in.              }
  42.    LS872     := #27#51#24    ; { Line spacing 8/72 in.                     }
  43. End ; { DefinePrintVars }
  44.  
  45. Procedure SetUp ;
  46. Var
  47.    I, J, Code : Integer ;
  48.    Dig1, Dig2 : String[50] ;
  49. Begin
  50.    DataCol := 0 ;
  51.    FileName := '' ;
  52.    DoneAlready := False ;
  53.    N := 0 ; S2Pi := Sqrt(2.0 * Pi) ;
  54.    ErrTol := 0.5 * Exp( -4.0 * Ln(10.0)) * S2Pi ;
  55.    Dig1 := '06090909061404040604150204091407080608070404150505' ;
  56.    Dig2 := '07080701150609070106040404091406090609060608140906' ;
  57.    For I := 0 To 4 Do
  58.       For J := 1 To 5 Do
  59.       Begin
  60.          Val(Copy(Dig1,10*I+2*J-1,2),Digit[I,J],Code) ;
  61.          Val(Copy(Dig2,10*I+2*J-1,2),Digit[I+5,J],Code) ;
  62.       End ; { For J }
  63. End ; { SetUp }
  64.  
  65. Procedure Exchange (Var X1, X2 : Real) ;
  66. Var Temp : Real ;
  67. Begin
  68.    Temp := X1 ;
  69.    X1 := X2 ;
  70.    X2 := Temp ;
  71. End ; { Exchange }
  72.  
  73. Procedure Heap(I, N : Integer) ;
  74. Begin
  75.    While ( 2 * I + 1 <= N ) And
  76.       ( ( Data[I] < Data[2*I] ) Or ( Data[I] < Data[2*I+1] ) ) Do
  77.    Begin
  78.       If Data[2*I] > Data[2*I+1] Then
  79.       Begin
  80.          Exchange(Data[I],Data[2*I]) ;
  81.          I := 2 * I ;
  82.       End  { Then }
  83.       Else Begin
  84.          Exchange(Data[I],Data[2*I+1]) ;
  85.          I := 2 * I + 1 ;
  86.       End ; { Else }
  87.    End ; { While }
  88.    If ( ( 2 * I = N ) And ( Data[I] < Data[2*I] ) )
  89.       Then Exchange(Data[I],Data[2*I]) ;
  90. End ; { Heap }
  91.  
  92. Procedure SortData ;
  93. Var
  94.    I, M : Integer ;
  95. Begin
  96.    ClrScr ; GoToXY(30,12) ;
  97.    Write(Con,'<<< Sorting Data >>>') ;
  98.    I := Trunc ( ( N / 2.0 ) + 0.1 ) ;
  99.    While I >= 1 Do
  100.    Begin
  101.       Heap(I,N) ;
  102.       I := I - 1 ;
  103.    End ; { While }
  104.    M := N ;
  105.    While M > 1 Do
  106.    Begin
  107.       Exchange(Data[1],Data[M]) ;
  108.       M := M - 1 ;
  109.       Heap(1,M) ;
  110.    End ; { While }
  111. ClrScr ;
  112. End ; { SortData }
  113.  
  114. Function InKey(ValCar: InSet): CHAR;
  115. Var Key : Char ;
  116. Begin
  117.    Repeat
  118.       Read(Kbd, Key);
  119.       Key := UpCase(Key);
  120.    Until Key In ValCar ;
  121.    IF Key = #8 THEN
  122.    Begin
  123.       Key := #255 ;
  124.       Write(Con, #8#32#8) ;
  125.    End ;
  126.    InKey := Key;
  127. End ; { InKey }
  128.  
  129. Procedure InputLn(Var Line : String14 ; Var Count : Integer ;
  130.                   Max: Integer ; ValCar, Term : InSet ; Var Key : Char ) ;
  131. Begin
  132.    Repeat
  133.       READ(Kbd, Key);
  134.       Key := UPCASE(Key);
  135.       IF (Key IN ValCar) AND (Count < Max) THEN
  136.       BEGIN
  137.          WRITE(Key);
  138.          Line := Line + Key;
  139.          Count := Count + 1;
  140.       END;
  141.       IF (Key = #8) AND (Count >= 0) THEN
  142.       BEGIN
  143.          WRITE(#8#32#8);
  144.          Delete(Line,LENGTH(Line),1);
  145.          Count := Count - 1;
  146.       END;
  147.       UNTIL (Key IN Term) OR (Key = #13) OR ((Key = #8) AND (Count = -1));
  148.    IF Count = -1 THEN
  149.    Key := #255;
  150. END ; { Inputln }
  151.  
  152. PROCEDURE GetNum(VAR Number: REAL; VAR Key: CHAR);
  153. VAR
  154.    Decimal: BOOLEAN;
  155.    NumStr: String14;
  156.    Size,Count: INTEGER;
  157. BEGIN
  158.    GotoXY(32,22); WRITE('X =             ');
  159.    GotoXY(36,22); NumStr := '';
  160.    Decimal := FALSE;
  161.    Size := 0; Count := 0;
  162.    REPEAT
  163.       IF Size > 0 THEN Key := InKey(['0'..'9','.','-',#13,#8,#5,#27])
  164.       ELSE Key := InKey(['0'..'9','.','-',#13,#5,#27]);
  165.       CASE Key OF
  166.          #255: BEGIN
  167.                   Key := NumStr[LENGTH(NumStr)];
  168.                   IF Key = '.' THEN Decimal := FALSE
  169.                   ELSE IF Key IN ['0'..'9'] THEN Count := Count - 1;
  170.                   Delete(NumStr,LENGTH(NumStr),1);
  171.                   Size := Size - 1;
  172.                   Key := '@';
  173.                END;
  174.           '.': IF NOT Decimal THEN
  175.                BEGIN
  176.                   WRITE(Key);
  177.                   NumStr := NumStr + Key;
  178.                   Size := Size + 1;
  179.                   Decimal := TRUE;
  180.                END;
  181.           '-': IF Size = 0 THEN
  182.                BEGIN
  183.                   WRITE(Key);
  184.                   NumStr := NumStr + Key;
  185.                   Size := Size + 1;
  186.                END;
  187.      '0'..'9': IF Count < 10 THEN
  188.                BEGIN
  189.                   WRITE(Key);
  190.                   Size := Size + 1;
  191.                   NumStr := NumStr + Key;
  192.                   Count := Count + 1;
  193.                END
  194.       END; { Case }
  195.    UNTIL (Key IN [#5,#27]) OR ((Key = #13) AND (Count > 0));
  196.    IF Key = #13 THEN Val(NumStr,Number,Size);
  197. END; { GetNum }
  198.  
  199. PROCEDURE InputFile(Var Key: Char) ;
  200. LABEL
  201.    Jump1,Jump2,Jump3,Jump4;
  202. VAR
  203.    I,J,K: INTEGER;
  204.    Flag: BOOLEAN;
  205. BEGIN
  206. Jump1: GotoXY(28,10);
  207.        WRITE('File name: ');
  208.        Key := InKey(['A'..'Z',#27]);
  209.        IF Key = #27 THEN
  210.        Begin
  211.           FileName := '' ;
  212.           Exit;
  213.        End ; { If }
  214.        FileName := Key;
  215.        WRITE(FileName);
  216.        K := 0;
  217. Jump2: InputLn(FileName,K,7,['0'..'9','A'..'Z'],['.',':',#27],Key);
  218.        IF Key = #27 THEN
  219.        Begin
  220.           FileName := '' ;
  221.           Exit ;
  222.        End ; { If }
  223.        IF Key = #255 THEN Goto Jump1 ;
  224.        Flag := FALSE;
  225.        IF Key = ':' THEN
  226.        BEGIN
  227.           WRITE(':');
  228.           FileName := FileName + ':';
  229. Jump3:    Key := InKey(['A'..'Z',#8,#27]);
  230.           IF Key = #27 THEN
  231.           Begin
  232.              FileName := '' ;
  233.              Exit ;
  234.           End ; { If Key = #27 }
  235.           IF Key = #255 THEN Goto Jump2 ;
  236.           WRITE(Key);
  237.           FileName := FileName + Key;
  238.           I := 0;
  239. Jump4:    InputLn(FileName,I,7,['0'..'9','A'..'Z'],['.',#27],Key);
  240.           IF Key = #27 THEN
  241.           Begin
  242.              FileName := '' ;
  243.              Exit ;
  244.           End ; { If Key = #27 }
  245.           If Key = #255 Then Goto Jump3 ;
  246.           Flag := TRUE;
  247.        End ; { If Key = ':'}
  248.        IF Key = '.' THEN
  249.        Begin
  250.           Write('.') ;
  251.           FileName := FileName + '.';
  252.           J := 0;
  253.           InputLn(FileName,J,3,['0'..'9','A'..'Z'],[#27],Key);
  254.           If Key = #27 Then
  255.           Begin
  256.              FileName := '' ;
  257.              Exit;
  258.           End ; { If Key = #27 }
  259.           IF Key = #255 THEN IF Flag THEN Goto Jump4 ELSE Goto Jump2 ;
  260.        End ; { If Key = '.' }
  261. End ; { InputFile }
  262.  
  263. PROCEDURE InputNumber(VAR Number: INTEGER; VAR Key: CHAR);
  264. LABEL
  265.    Back1, Back2, Back3;
  266. VAR
  267.    NumStr: String3;
  268.    Code: INTEGER;
  269. BEGIN
  270. Back1: NumStr := '   ';
  271.        NumStr[1] := InKey(['1'..'9',#27]);
  272.        IF NumStr[1] <> #27 THEN
  273.        BEGIN
  274.           WRITE(NumStr[1]);
  275. Back2:    IF NumStr[1] IN ['1'..'3'] THEN NumStr[2] := InKey(['0'..'9',#27,#8])
  276.           ELSE NumStr[2] := InKey(['0'..'9',#27,#13,#8]);
  277.           CASE NumStr[2] OF
  278.              #27: Key := '@';
  279.              #255: Goto Back1;
  280.           ELSE WRITE(NumStr[2]);
  281.        END;
  282. Back3: IF NOT (NumStr[2] IN [#13,#27]) THEN
  283.        BEGIN
  284.           NumStr[3] := InKey(['0'..'9',#27,#13,#8]);
  285.           CASE NumStr[3] OF
  286.               #27: Key := '@';
  287.              #255: Goto Back2;
  288.           ELSE
  289.           BEGIN
  290.              WRITE(NumStr[3]);
  291.              Key := InKey([#13,#27,#8]);
  292.              CASE Key OF
  293.                  #27: Key := '@';
  294.                 #255: Goto Back3;
  295.              END;
  296.           END;
  297.        END;
  298.        END;
  299.        END
  300.        ELSE
  301.           Key := '@';
  302.           Val(NumStr,Number,Code)
  303.   END;
  304.  
  305.   FUNCTION Up2(Power: INTEGER): BYTE;
  306.     VAR
  307.       I: INTEGER;
  308.       Result: BYTE;
  309.     BEGIN
  310.       Result := 1;
  311.       I := 0;
  312.       WHILE Power > I DO
  313.         BEGIN
  314.           Result := Result * 2;
  315.           I := I + 1;
  316.         END;
  317.       Up2 := Result;
  318.     END;
  319.  
  320.   PROCEDURE SaveData(VAR X: DataType; N: INTEGER);
  321.     VAR
  322.       Key: CHAR;
  323.       I: INTEGER;
  324.       OutFile: TEXT;
  325.     BEGIN
  326.       ClrScr;
  327.       GotoXY(26,12);
  328.       IF N > 0 THEN
  329.         BEGIN
  330.           InputFile(Key);
  331.           IF Key = #27 THEN
  332.           Begin
  333.              FileName := '' ;
  334.              Exit;
  335.           End ; { If Key = #27 }
  336.           ClrScr;
  337.           GotoXY(26,12);
  338.           WRITE('<<< Writing Data to Disk >>>');
  339.           ASSIGN(OutFile, FileName);
  340.           REWRITE(OutFile);
  341.           FOR I := 1 TO N DO
  342.           WRITELN(OutFile, X[I]:15:8);
  343.           CLOSE(OutFile);
  344.         END
  345.       ELSE
  346.         BEGIN
  347.           WRITE('<<< Insufficent Data >>>');
  348.           Delay(1000);
  349.         END;
  350.       ClrScr;
  351.     END;
  352.  
  353. FUNCTION ConFrac(X: REAL): REAL;
  354. VAR
  355.    X2, Term, Sum, ETol, Beta : REAL;
  356.    Kount: INTEGER;
  357. BEGIN
  358.    X2 := X * X ;
  359.    Etol := ErrTol * X * Exp(X2/2.0) ;
  360.    Term := 1.0 ;
  361.    Sum := 1.0 ;
  362.    Kount := 1;
  363.    Beta := 1;
  364.    WHILE ABS(Term) > Etol DO
  365.    BEGIN
  366.       Beta := 1.0 / (1.0 + Kount * Beta / X2);
  367.       Term := (Beta - 1) * Term;
  368.       Sum := Sum + Term;
  369.       Kount := Kount + 1;
  370.    END;
  371.    ConFrac := 1 - Sum * Exp(-X2/2.0) / ( S2Pi * X );
  372. END ; { Confrac }
  373.  
  374. FUNCTION MacLauren(X: REAL): REAL;
  375. VAR
  376.    X2, Term, Sum : REAL;
  377.    Kount: INTEGER;
  378. BEGIN
  379.    X2 := X * X;
  380.    Term := X ;
  381.    Sum := Term;
  382.    Kount := 1;
  383.    WHILE ABS(Term) > Errtol DO
  384.    BEGIN
  385.       Term := -Term * X2 * (2 * Kount - 1) / (2 * Kount * (2 * Kount + 1));
  386.       Sum := Sum + Term;
  387.       Kount := Kount + 1;
  388.    END;
  389.    MacLauren := 0.5 + Sum / S2Pi ;
  390. END ; { Maclauren }
  391.  
  392. FUNCTION Convert(St : String3): INTEGER;
  393. VAR
  394.    Number, Code: INTEGER;
  395. BEGIN
  396.    Val(St, Number, Code);
  397.    Convert := Number;
  398. END ; { Convert }
  399.  
  400. FUNCTION CriticalD(Number: INTEGER): REAL;
  401. VAR
  402.    Table: ARRAY[0..5] OF STRING[51];
  403.    Result: REAL;
  404. BEGIN
  405.    IF Number < 21 THEN
  406.    BEGIN
  407.       Table[5] := '303289269252239227217208200' +
  408.                   '193187181176171167163159' ;
  409.       Table[4] := '321303281264250238228218210' +
  410.                   '202196190184179175170166' ;
  411.       Table[3] := '346319297280265252241231222' +
  412.                   '215208201195190185181176' ;
  413.       Table[2] := '376343323304288274262251242' +
  414.                   '234226219213207202197192' ;
  415.       Table[1] := '413397371351333317304291281' +
  416.                   '271262254247240234228223' ;
  417.       Table[0] := '433439424402384365352338325' +
  418.                   '314305296287279273266260' ;
  419.       Result := Convert(Copy(Table[Op1],1+3*(Number-4),3))/1000;
  420.    End
  421.    Else
  422.       Case Op1 Of
  423.          0 : Result := 1.0 / Sqrt( 1.0194273 - 7.439981E-5 * Sqr(Number)
  424.                        + 0.69594400 * Number ) ;
  425.          1 : Result := 1.0 / Sqrt( 1.5014504 - 2.688139E-5 * Sqr(Number)
  426.                        + 0.92969285 * Number ) ;
  427.          2 : Result := 1.0 / Sqrt( 2.4247449 + 4.2778854E-6 * Sqr(Number)
  428.                        + 1.2279378 * Number ) ;
  429.          3 : Result := 1.0 / Sqrt( 1.6210592 - 1.250862E-4 * Sqr(Number)
  430.                        + 1.5283685 * Number ) ;
  431.          4 : Result := 1.0 / Sqrt( 3.2539680 + 4.4853635E-6 * Sqr(Number)
  432.                        + 1.6358438 * Number ) ;
  433.          5 : Result := 1.0 / Sqrt( 2.6080763 - 8.113091E-5 * Sqr(Number)
  434.                        + 1.8481843 * Number ) ;
  435.        End ; { Case }
  436.      CriticalD := Result ;
  437. END ; { CriticalD }
  438.  
  439.  
  440. Procedure PlotX(VAR X: DataType; N: INTEGER);
  441. Var
  442.    Lv, Lz, Z, V, I, J, K,Correct: INTEGER;
  443.    StanDev, Xbar, X2sum, F, D : REAL;
  444.    W: DataType;
  445.    M: ARRAY[0..719] OF INTEGER;
  446. Begin
  447.    Xbar := 0 ; X2sum := 0 ; Lv := 0 ;
  448.    For I := 1 To N Do
  449.    Begin
  450.       Xbar := Xbar + X[I];
  451.       X2sum := X2sum + X[I] * X[I];
  452.    End ; { For }
  453.    Xbar := Xbar / N ;
  454.    StanDev := SQRT((X2sum - Xbar * Xbar * N) / (N - 1));
  455.    For I := 1 To N Do
  456.       IF StanDev = 0 Then W[I] := 0 Else W[I] := (X[I] - Xbar) / StanDev ;
  457.    DMax := 0.0 ;
  458.    For I := 1 To N Do
  459.    Begin
  460.       If Abs(W[I])>2.0 Then F:=ConFrac(Abs(W[I])) Else F:=Maclauren(Abs(W[I]));
  461.       If W[I] < 0.0 Then F := 1.0 - F ;
  462.       D := Abs(F-(I-1)/N) ;
  463.       If Abs(F-I/N) > D Then D := Abs(F-I/N) ;
  464.       If D > DMax Then
  465.       Begin
  466.          DMax := D ;
  467.          WMax := W[I] ;
  468.          XMax := X[I] ;
  469.       End ; { If }
  470.    End ; { For }
  471.    DCrit := CriticalD(N) ;
  472.    If DMax > DCrit Then Reject := True Else Reject := False ;
  473.    I := 1 ; J := 0 ; K := 0 ;
  474.    Repeat
  475.       While ((W[I]=W[I+1]) And (I<N)) Do I := I + 1 ;
  476.       While (((-3.0+K/120.0)<W[I]) And (K<720)) Do
  477.       Begin
  478.          M[K] := J ;
  479.          K := K + 1 ;
  480.       End ; { While }
  481.       J := I ; I := I + 1 ;
  482.    Until ((I>N) Or (K=720)) ;
  483.    If K <= 719 Then For J := K To 719 Do M[J] := N ;
  484.    For I := 1 To 718 Do
  485.    Begin
  486.       V := Trunc(400 * (M[I] / N) + 0.5) ;
  487.       Z := 1 ;
  488.       For K := 1 To (V Mod 8) Do Z := 2 * Z ;
  489.       If V > Lv Then For K := Lv To V Do
  490.       Begin
  491.          Correct := (K Div 8) Mod 50 ;
  492.          If Correct < 0 Then Correct := 0 ;
  493.          Grid[I-1,Correct] := Grid[I-1,Correct] OR Up2(K MOD 8);
  494.       End ; { For }
  495.       Correct := (V Div 8) Mod 50 ;
  496.       If Correct < 0 Then Correct := 0 ;
  497.       Grid[I,Correct] := Grid[I,Correct] Or Z ;
  498.       Lv := V ;
  499.    End ; { For I }
  500. End ; { PlotX }
  501.  
  502. Procedure DataEntry(Var Data : DataType ; Var N : Integer) ;
  503. Label Jmp ;
  504. Var
  505.    NextNum : Boolean ;
  506.    Key : Char ;
  507.    MaxCol, Col, Row, I, J, K : Integer ;
  508.    InFile : Text ;
  509.    Dummy : Real ;
  510.    DataLine : String[255] ;
  511. Begin
  512. FileName := '' ;
  513. Jmp:  ClrScr;
  514.       GotoXY(35,10); Write('<1> Keyboard');
  515.       GotoXY(35,12); Write('<2> Disk');
  516.       GotoXY(35,14); Write('Input from: ');
  517.       Key := InKey(['1','2',#27]); Write(Key);
  518.       If Key = #27 Then Exit ;
  519.       ClrScr;
  520.       If Key = '2' Then
  521.       Begin
  522.          InputFile(Key) ;
  523.          If Key = #27 Then
  524.          Begin
  525.             FileName := '' ;
  526.             Goto Jmp ;
  527.          End ; { If Key = #27 }
  528.          Assign(InFile,FileName) ;
  529.          {$I-} Reset(InFile) {$I+} ;
  530.          If IOResult <> 0 Then
  531.          Begin
  532.             GotoXY(28-Length(FileName) DIV 2,12) ;
  533.             Writeln(#7+'File ',FileName,' Can Not Be Located') ;
  534.             Delay(4000) ; FileName := '' ;
  535.             Exit ;
  536.          End ; { If IOResult <> 0 }
  537.          Col := 0 ; Row := 1 ;
  538.          Repeat
  539.             { $I-} Read(InFile,Dummy) {$I+} ;
  540.             Col := Col + 1 ;
  541.             Dummy := IOResult ;
  542.          Until Eoln(InFile) ;
  543.          GotoXY(28,12) ; Writeln('File contains ',Col,' column(s)');
  544.          Repeat
  545.             DataLine := '' ;
  546.             Readln(InFile, DataLine) ;
  547.             J := 47 ;
  548.             Repeat
  549.                J := J + 1 ;
  550.             Until ( ( Pos(Chr(J),DataLine) > 0 ) Or ( J = 58 ) ) ;
  551.             If J < 58 Then Row := Row + 1 ;
  552.          Until Eof(InFile) ;
  553.          GoToXY(28,14) ; Writeln('File contains ',Row,' row(s)') ;
  554.          If Row > Limit Then
  555.          Begin
  556.             GoToXY(10,16) ;
  557.             Write(Con,'This program can only handle data files with ') ;
  558.             Write(Con,Limit,' or fewer rows.') ;
  559.             FileName := '' ;
  560.             GoToXY(10,18) ; Write(Con,'Press any key to continue.') ;
  561.             Repeat Until KeyPressed ;
  562.             GoTo Jmp ;
  563.          End ; { If Row > Limit }
  564.          If Col > 1 Then
  565.          Begin
  566.             MaxCol := Col ;
  567.             Repeat
  568.                GoToXY(56,16) ; Write(Con,' ':24) ;
  569.                GotoXY(28,16) ; Write(Con,'Enter column containing X: ') ;
  570.                { $I-} Readln(Col)  {$I+} ;
  571.             Until ((IOResult=0) And ((Col > 0) And (Col <= MaxCol))) ;
  572.          End { If Col > 1 }
  573.          Else Col := 1 ;
  574.          ClrScr ;
  575.          Reset(InFile) ;
  576.          For J := 1 To Row Do
  577.          Begin
  578.             GotoXY(32,22); WRITE('                   ');
  579.             GotoXY(32,22); WRITE('X = ');
  580.             If Col > 1 Then For I := 1 To Col - 1 Do
  581.             Begin
  582.                {$I-} Read(InFile, Data[J]) {$I+} ;
  583.                If IOResult <> 0 Then
  584.                Begin
  585.                   GoToXY(10,24) ;
  586.                   Write(Con,' Error in data file in row ',J,' .') ;
  587.                   GoToXY(10,25) ; Write(Con,'Press any key to continue.') ;
  588.                   Repeat Until KeyPressed ;
  589.                   GoTo Jmp ;
  590.                End ; { If IOResult <> 0 }
  591.             End ; { For I }
  592.             {$I-} Readln(InFile, Data[J]) {$I+} ;
  593.             If IOResult <> 0 Then
  594.             Begin
  595.                GoToXY(10,24) ;
  596.                Write(Con,' Error in data file in row ',J,' .') ;
  597.                GoToXY(10,25) ; Write(Con,'Press any key to continue.') ;
  598.                Repeat Until KeyPressed ;
  599.                GoTo Jmp ;
  600.             End ; { If IOResult <> 0 }
  601.             Writeln(Data[J]:-8:4);
  602.             GotoXY(4+25*(((J - 1) Div 20) Mod 3),1 + (J - 1) Mod 20);
  603.             Write(J:3,'. ',Data[J]:16:4);
  604.          End ; { For J }
  605.          Close(InFile);
  606.          DataCol := Col ;
  607.          N := Row ;
  608.       End { If Key = '2' }
  609.       Else
  610.       Begin
  611.          N := 0;
  612.          GotoXY(30,24); WRITE('Type Ctrl-E to Exit');
  613.          Repeat
  614.             N := N + 1;
  615.             GetNum(Data[N], Key);
  616.             GotoXY(4+25*(((N - 1) DIV 20) MOD 3),1 + (N - 1) MOD 20);
  617.             WRITE(N:3,'. ',Data[N]:16:4);
  618.          Until ( Key IN [#5,#27] ) Or ( N = Limit ) ;
  619.          N := N - 1;
  620.       End ; { Else }
  621.       IF N > (Limit - 1) THEN
  622.       Begin
  623.          GotoXY(25,22); WRITE('Maximum Amount of Data Entered');
  624.          Delay(2000);
  625.       End ; { If }
  626.       If N < 4 Then
  627.       Begin
  628.          N := 0 ;
  629.          ClrScr ;
  630.          GoToXY(10,4) ;
  631.          Write(Con,'Sample size is less than 4. Test cannot be run.') ;
  632.          GoToXY(10,6) ;
  633.          Write(Con,'Only graphs for hand plotting can be printed.') ;
  634.          GoToXY(10,8) ; Write(Con,'Press any key to continue.') ;
  635.          Repeat Until KeyPressed ;
  636.       End ; { If N < 4 }
  637. End ; { DataEntry }
  638.  
  639.     PROCEDURE MiniMenu(VAR Op1,Op2: INTEGER);
  640.       LABEL
  641.         Bran1, Bran2;
  642.       BEGIN
  643. Bran1:  ClrScr;
  644.         GoToXY(36,6) ;  Write('<0> 99.9%') ;
  645.         GotoXY(37,8) ;  Write('<1> 99%') ;
  646.         GotoXY(37,10) ; Write('<2> 95%') ;
  647.         GotoXY(37,12) ; Write('<3> 90%') ;
  648.         GotoXY(37,14) ; Write('<4> 85%') ;
  649.         GoToXY(37,16) ; Write('<5> 80%') ;
  650.         GotoXY(30,18); Write('Select confidence level: ');
  651.         Key := InKey(['0'..'5',#27]);
  652.         IF Key = #27 Then Exit ;
  653.         Writeln(Key);
  654.         Op1 := Ord(Key) - Ord('0');
  655. Bran2:  IF N > 3 THEN
  656.           BEGIN
  657.             ClrScr;
  658.             GotoXY(26,10); WRITE('<1> 5, 10, 15, 20, 30, 50, 100');
  659.             GotoXY(26,12); WRITE('<2> ',N);
  660.             GotoXY(25,14); WRITE('Plot confidence bound curve(s): ');
  661.             Key := InKey(['1','2',#27]); WRITELN(Key);
  662.             If Key = #27 Then GoTo Bran1 ;
  663.             Op2 := ORD(Key) - ORD('1');
  664.             Key := '@';
  665.           END
  666.         ELSE
  667.           BEGIN
  668.             ClrScr;
  669.             GotoXY(26,10); WRITE('<1> 5, 10, 15, 20, 30, 50, 100');
  670.             GotoXY(26,12); WRITE('<2> N');
  671.             GotoXY(25,14); WRITE('Plot confidence bound curve(s): ');
  672.             Key := InKey(['1','2',#27]); WRITELN(Key);
  673.             IF Key = #27 THEN
  674.               Goto Bran1;
  675.             IF Key = '2' THEN
  676.               BEGIN
  677.                 GotoXY(25,16); WRITE('Enter N value: ');
  678.                 InputNumber(Special,Key);
  679.                 IF Key = '@' THEN
  680.                   Goto Bran2;
  681.               END;
  682.             Op2 := ORD(Key) - ORD('1');
  683.             Key := '@';
  684.           END;
  685.       END;
  686.  
  687. PROCEDURE ScreenMenu;
  688.    BEGIN
  689.       ClrScr;
  690.       GotoXY(24,4)  ; WRITE('LILLIEFORS TEST FOR NORMALITY');
  691.       GotoXY(29,8)  ; WRITE('<E> Enter data');
  692.       GotoXY(29,10) ; WRITE('<S> Save data to disk');
  693.       GotoXY(29,12) ; WRITE('<P> Print graph');
  694.       GotoXY(29,14) ; WRITE('<X> Exit program');
  695.       GotoXY(29,16) ; WRITE('Selection: ');
  696.       Key := InKey(['E','S','P','X']) ; WRITELN(Key) ;
  697.       CASE Key OF
  698.         'E': Begin DataEntry(Data, N); SortData ; End ;
  699.         'S': SaveData(Data, N);
  700.         'P': IF (N = 0) OR (N > 3) Then MiniMenu(Op1,Op2)
  701.              Else
  702.              Begin
  703.                 ClrScr;
  704.                 GotoXY(30,12);
  705.                 WRITE('Insufficent Data to Plot');
  706.                 Delay(2000);
  707.                 Key := 'S';
  708.              End ; { Else }
  709.       End ; { Case }
  710.   End ; { ScreenMenu }
  711.  
  712. PROCEDURE FillIndex ;
  713. VAR
  714.    I: INTEGER;
  715. BEGIN
  716.    IF Op2 = 0 THEN
  717.    BEGIN
  718.       Index[01] := '5';     Index[02] := '10';
  719.       Index[03] := '15';    Index[04] := '20';
  720.       Index[05] := '30';    Index[06] := '50';
  721.       Index[07] := '100';
  722.    END
  723.    ELSE
  724.    BEGIN
  725.       FOR I := 1 TO 6 DO Index[I] := '';
  726.       IF N > 3 THEN Str(N,Index[7]) ELSE Str(Special,Index[7]) ;
  727.    END;
  728.    FOR I := 1 TO 7 DO Index[16 - I] := Index[I];
  729. END ; { FillIndex }
  730.  
  731. PROCEDURE PlotGrid ;
  732. VAR
  733.    I,X,Y: INTEGER;
  734. BEGIN
  735.    FOR Y := 0 TO 49 DO Grid[0,Y] := 0;
  736.    FOR X := 1 TO 719 DO Grid[X] := Grid[0];
  737.    FOR Y := 0 TO 49 DO
  738.    BEGIN
  739.       Grid[0,Y]   := 255;
  740.       Grid[719,Y] := 255;
  741.    END ;
  742.    FOR I := 1 TO 11 DO FOR Y := 0 TO 49 DO Grid[I*60,Y] := 17 ;
  743.    FOR X := 0 TO 719 DO
  744.    BEGIN
  745.       Grid[X,49] := Grid [X,49] OR 128;
  746.       Grid[X,0] := Grid[X,0] OR 1;
  747.    END;
  748.    FOR Y := 1 TO 9 DO FOR X := 0 TO 143 DO Grid[X*5,Y*5] := Grid[X*5,Y*5] OR 1;
  749. END ; { PlotGrid }
  750.  
  751. Procedure PlotPoint(I,U : Integer ; Var V : Integer) ;
  752. Var
  753.    J, W, Z, Z2 : Integer ;
  754.    PlotY : Real ;
  755. Begin
  756.    PlotY := Y[U] + Quantile[I];
  757.    If ((PlotY > 0.0) AND (PlotY < 1.0)) Then
  758.    BEGIN
  759.       V := TRUNC(400.0 * PlotY + 0.5);
  760.       W := (V DIV 8) MOD 50;
  761.       Z := 1;
  762.       Z2 := V MOD 8;
  763.       FOR J := 1 TO Z2 DO Z := Z * 2;
  764.       Grid[U,W] := Grid[U,W] OR Z;
  765.     End ; { If }
  766. End ; { PlotPoint }
  767.  
  768. Procedure WriteLabel(I, U, V, Len : Integer) ;
  769. Var
  770.    Col, J, K, L, Row, Test, Test2, W, Z, Z2, Z3 : Integer ;
  771. Begin
  772. Col := U + 3 ; Row := V - 2 ;
  773. For J := 1 To Len DO
  774.    Begin
  775.    For K := Row To Row + 4 Do
  776.       Begin
  777.       W := ( K Div 8 ) Mod 50 ;
  778.       Z2 := K Mod 8 ; Z := 1 ;
  779.       For L := 1 To Z2 Do Z := Z * 2 ; Test := 1 ;
  780.       For L := Col To Col + 3 Do
  781.          Begin
  782.          If L > Col Then Test := Test * 2 ;
  783.          Test2 := Test And Digit[Integer(Copy(Index[I],J,1))-48,K+1-Row];
  784.          If Test2 = 0 Then Z3 := 0 Else Z3 := Z ;
  785.          Grid[L,W] := Grid[L,W] Or Z3 ;
  786.       End ; { For L }
  787.    End ; { For K }
  788.    Col := Col + 5 ;
  789. End ; { For J }
  790. End ; { WriteLabel }
  791.  
  792. PROCEDURE PlotCurves ;
  793. VAR
  794.    EndLabelCol, I, LabelCol, Len, LenLabel, U, V : INTEGER;
  795.    PlotY,X: REAL;
  796.    Table: ARRAY[1..5] OF STRING[21];
  797. BEGIN
  798.    FOR I := 1 TO 7 DO
  799.    IF Index[I] <> '' THEN
  800.    BEGIN
  801.       Quantile[I] := CriticalD(Convert(Index[I]));
  802.       Quantile[16 - I] := 0 - Quantile[I];
  803.    END;
  804.    Quantile[8] := 0; Index[8] := ' ';
  805.    If Not DoneAlready Then FOR U := 1 TO 718 DO
  806.    BEGIN
  807.       X := -3.0 + 6.0 * U / 720;
  808.       IF ABS(X) < 2.25 THEN Y[U] := MacLauren(ABS(X))
  809.       ELSE Y[U] := ConFrac(ABS(X));
  810.       IF (X < 0.0) THEN Y[U] := 1.0 - Y[U] ;
  811.    End ; { If }
  812.    DoneAlready := True ;
  813.    FOR I := 1 TO 15 DO
  814.    Begin
  815.       IF Index[I] <> '' THEN
  816.       BEGIN
  817.          Len := Length(Index[I]) ;
  818.          LenLabel := 5 * Len + 1 ;
  819.          If I < 8 Then LabelCol := 8 Else LabelCol := 708 - LenLabel ;
  820.          EndLabelCol := LenLabel + LabelCol + 1 ;
  821.          If I = 8 Then EndLabelCol := 0 ;
  822.          If I <> 8 Then For U := 1 To LabelCol Do PlotPoint(I,U,V) ;
  823.          If I <> 8 Then WriteLabel(I,LabelCol,V,Len) ;
  824.          For U := EndLabelCol + 3 To 718 Do PlotPoint(I,U,V) ;
  825.       End ; { If }
  826.    End ; { For }
  827. End ; { PlotCurves }
  828.  
  829. Procedure GraphTitle(Option: INTEGER ; Var Sig : Real);
  830. Var I : Integer ;
  831. Begin
  832.    For I := 0 TO 7 Do Writeln(Lst);
  833.    Case Option OF
  834.       0 : Sig := 99.9 ;
  835.       1 : Sig := 99 ;
  836.       2 : Sig := 95 ;
  837.       3 : Sig := 90 ;
  838.       4 : Sig := 85 ;
  839.       5 : Sig := 80 ;
  840.    End ;
  841.    If Option > 0 Then Write(Lst,Sig:30:0) Else Write(Lst,Sig:29:1) ;
  842.    Writeln(Lst, '% Lilliefors Bounds for Normal Samples') ;
  843.    For I := 1 TO 5 Do Writeln(Lst) ;
  844. End ; { GraphTitle }
  845.  
  846. Procedure InitPrinter;
  847. Begin
  848.    Writeln(Lst, InitPr, LS872, Elite) ;
  849. End ; { InitPrinter }
  850.  
  851. Procedure PrintGraph ;
  852. Var
  853.    A, I, J : Integer ;
  854.    Sig : Real ;
  855. Begin
  856.    {$U+}
  857.    GraphTitle(Op1,Sig);
  858.    For I := 49 DownTo 0 Do
  859.    Begin
  860.       If (I > 10) And (I < 40) Then
  861.          Write(Lst, Copy('CUMULATIVE RELATIVE FREQUENCY',30-(I-10),1):6)
  862.       Else Write(Lst, ' ':6) ;
  863.       IF I = 49 Then Write(Lst, '1.0 ':6)
  864.       Else
  865.          If (I Mod 5) = 0 Then Write(Lst, ' .':4, I Div 5, ' ')
  866.          Else Write(Lst, '    ':6) ;
  867.       Write(Lst, GraphLine) ;
  868.       For J := 0 To 719 Do Write(Lst, Chr(Grid[J,I])) ;
  869.       Writeln(Lst) ;
  870.    End ; { For }
  871.    Writeln(Lst,Elite) ;
  872.    Writeln(Lst,-3:13,-2:12,-1:12,0:12,1:12,2:12,3:12) ;
  873.    Writeln(Lst) ; Writeln(Lst) ;
  874.    Writeln(Lst, 'STANDARDIZED SAMPLE VALUE':60) ;
  875.    If N > 4 Then
  876.    Begin
  877.       Writeln(Lst,Lpi6, Elite) ;
  878.       Writeln(Lst) ; Writeln(Lst) ;
  879.       If FileName <> '' Then
  880.       Begin
  881.          Write(Lst,' ':9,'The data is column ',DataCol:2) ;
  882.          Writeln(Lst,' of file ',FileName,'.') ;
  883.       End ; { If FileName <> '' }
  884.       Write(Lst,' ':9,'The maximum distance between ') ;
  885.       Writeln(Lst,'the Normal and sample CDFs is ',DMax:5:4,'.');
  886.       Write(Lst,' ':9,'This maximum occurs at z = ',WMax:6:4,', x = ') ;
  887.       Writeln(Lst,XMax,'.') ;
  888.       Write(Lst,' ':9,'The hypothesis of normality is ') ;
  889.       If Reject = True
  890.       Then Write(Lst,'rejected at the ',100-Sig:4:1)
  891.          Else Write(Lst,'not rejected at the ',100-Sig:4:1) ;
  892.       Writeln(Lst,'% significance level.') ;
  893.       Writeln(Lst,' ':9,'The critical distance is ',DCrit:5:3,'.') ;
  894.    End ; { If }
  895.    Write(Lst, FormFeed, InitPr) ;
  896. End ; { PrintGraph }
  897.  
  898. Begin { Main }
  899.    DefinePrintVars ;
  900.    SetUp ;
  901.    Repeat
  902.       Special := 0;
  903.       ScreenMenu;
  904.       IF Key = '@' Then
  905.       Begin
  906.          ClrScr;
  907.          FillIndex ;
  908.          PlotGrid ;
  909.          GotoXY(27,11); Write('<<< Generating Graph >>>') ;
  910.          PlotCurves ;
  911.          If N > 4 Then PlotX(Data,N) ;
  912.          ClrScr;
  913.          GotoXY(30,12); Write('<<< Printing Graph >>>') ;
  914.          GotoXY(40,14) ;
  915.          InitPrinter ;
  916.          PrintGraph ;
  917.       End ; { If }
  918.    Until Key = 'X';
  919.    ClrScr;
  920. End .
  921.  
  922.