bwBASIC/NBS2/P137.BAS

10 PRINT "PROGRAM FILE 137: POKER TEST FOR RND FUNCTION."
20 PRINT "    ANSI STANDARD 8.4"
30 PRINT
40 PRINT "SECTION 137.1: POKER TEST FOR RND FUNCTION."
50 PRINT
60 PRINT "THIS PROGRAM CATEGORIZES FIXED-SIZE GROUPS OF RANDOM NUMBERS"
70 PRINT "BASED ON HOW MANY DIFFERENT TYPES OF NUMBER ARE IN EACH"
80 PRINT "GROUP. A TYPE IS DETERMINED BY WHICH FRACTION OF THE 0 - 1"
90 PRINT "SEGMENT THE VALUE OF THE NUMBER FALLS WITHIN. CHI-SQUARE"
100 PRINT "IS THEN COMPUTED AND DISPLAYED AS THE RESULT TO SEE IF"
110 PRINT "IT IS COMPATIBLE WITH THE EXPECTED DISTRIBUTION FOR UNIFORM"
120 PRINT "RANDOM NUMBERS."
130 PRINT
140 PRINT "***** THIS TEST IS INFORMATIVE ONLY *****"
150 PRINT
160 PRINT "                    BEGIN TEST"
170 PRINT
180 DIM B(20)
190 REM SET SIZE OF GROUPS
200 LET K=5
210 REM SET #TYPES
220 LET D=7
230 IF D>=K THEN 260
240 PRINT "ALGORITHM INVALID FOR D<K. PROGRAM TERMINATING."
250 GOTO 820
260 LET N=INT(5*(D^(K-1)))
270 PRINT "RUNNING ";N;" TRIALS, SO THAT EACH POSSIBILITY HAS"
280 PRINT "EXPECTED VALUE >= 5, AS NEEDED FOR CHI-SQUARE TEST."
290 PRINT
300 FOR I=1 TO K
310 LET C(I)=0
320 NEXT I
330 FOR N1=1 TO N
340 LET R=0
350 REM MARK B-ARRAY AS NO TYPE S HIT SO FAR
360 FOR I=1 TO D
370 LET B(I)=0
380 NEXT I
390 FOR I=1 TO K
400 LET J=INT(D*RND)+1
410 IF B(J)=1 THEN 450
420 REM GOT A NEW TYPE, MARK AND COUNT
430 LET R=R+1
440 LET B(J)=1
450 NEXT I
460 LET C(R)=C(R)+1
470 NEXT N1
480 LET S=0
490 REM SET TOTAL #POSSIBILITIES
500 LET D1=D^K
510 PRINT "#TYPES","ACTUAL COUNT","EXPECTED COUNT"
520 FOR I=1 TO K
530 LET F=1
540 FOR J=(D-I)+1 TO D
550 LET F=F*J
560 NEXT J
570 LET R=I
580 REM GET STIRLING NUMBER FOR K,R
590 REM RESULT IN A9
600 GOSUB 840
610 REM F=PROB OF I DIFFERENT TYPES
620 LET F=(F*A9)/D1
630 PRINT I,C(I),F*N
640 LET S=S+(C(I)*C(I))/F
650 NEXT I
660 LET V=(S/N) - N
670 REM CHI-SQ FOR 4 D.F.
680 PRINT
690 PRINT "FOR FOUR D.F., SHOULD HAVE .710721 <= CHI-SQ <= 9.48773"
700 PRINT "(5% TAIL AT EACH END.)"
710 PRINT
720 PRINT "ACTUAL CHI-SQ = ";V
730 PRINT
740 IF V<.710721 THEN 780
750 IF V>9.48773 THEN 780
760 PRINT "*** INFORMATIVE TEST PASSED ***"
770 GOTO 790
780 PRINT "*** INFORMATIVE TEST FAILED ***"
790 PRINT
800 PRINT "                   END TEST"
810 PRINT
820 PRINT "END PROGRAM 137"
830 STOP
840 REM GIVEN K,R, WHAT IS STIRLING NUMBER?
850 REM ANSWER RETURNED IN A9
860 IF R>K THEN 910
870 IF R=K THEN 930
880 IF R=1 THEN 930
890 IF R=0 THEN 910
900 GOTO 950
910 LET A9=0
920 GOTO 1130
930 LET A9=1
940 GOTO 1130
950 DIM A(20)
960 REM THIS LIMITS RANGE OF ROUTINE TO R<=20 (K UNCONSTRAINED)
970 FOR I8=1 TO 20
980 LET A(I8)=1
990 NEXT I8
1000 LET K9=K-R
1010 FOR K1=3 TO K
1020 LET M1=R
1030 IF R<K1-1 THEN 1050
1040 LET M1=K1-1
1050 LET M2=2
1060 IF 2>K1-K9 THEN 1080
1070 LET M2=K1-K9
1080 FOR R1=M1 TO M2 STEP -1
1090 LET A(R1)=R1*A(R1)+A(R1-1)
1100 NEXT R1
1110 NEXT K1
1120 LET A9=A(R)
1130 RETURN
1140 END