SUB CROSS0(NR,NC)
         DIM #3,B(250,15) \ &
         DIM E(10,10),IG(10,10),A(250),C(250),AB(10),CB(10)
              !
              !     THIS FUNCTION COMPUTES X FACTORAL
              !
         DEF* FNF(X)
         IF X<=1. THEN FNF=1. ELSE FNF=X*FNF(X-1.)
         FNEND
              !
         H9=.9E-38 \ &
         ON ERROR GOTO <<ERR>> \ &
         AB$="PLEASE TYPE Y OR N" \ &
         AC$="YOU MUST SPECIFY 1 TO 10 INTERVALS"
<<*TYP>> PRINT "ENTER THE COLUMN NUMBERS OF TWO VARIABLES FOR CROSS " \ &
         INPUT "TABULATION (FORM: HORIZONTAL,VERTICAL)";IA;IC\ PRINT
         IF IA<1 OR IC<1 OR IA>NC OR IC>NC OR IA=IC THEN &
           PRINT "COLUMN NUMBERS MUST BE BETWEEN 1 AND";NC;". PLEASE TRY "+ &
                 "AGAIN" \ GOTO <<TYP>>
              !
<<*INA>> PRINT "ENTER THE NUMBER OF INTERVALS FOR VARIABLE";IA \ &
         INPUT "(MAXIMUM OF 10)";JA \ PRINT
         IF JA<1 OR JA>10 THEN PRINT AC$ \ GOTO <<INA>>
              !
<<*INC>> PRINT "ENTER THE NUMBER OF INTERVALS FOR VARIABLE";IC \ &
         INPUT "(MAXIMUM OF 10)";JC \ PRINT
         IF JC<1 OR JC>10 THEN PRINT AC$ \ GOTO <<INC>>
              !
              !     MOVE PAIRS OF DATA TO ARRAYS A AND C
              !
         N=0 \ AMIN=1.E37 \ AMAX=-1.E37
         FOR I=1 TO NR
           IF B(I,IA)=H9 OR B(I,IC)=H9 GOTO <<NI1>>
           N=N+1 \ A(N)=B(I,IA) \ C(N)=B(I,IC) \ &
           IF A(N)>AMAX THEN AMAX=A(N)
           IF A(N)<AMIN THEN AMIN=A(N)
<<*NI1>> NEXT I
              !
              !     SORT C IN DESCENDING ORDER KEEPING A MATCHING
              !
         N1=N-1
<<*SOR>> L=0
         FOR I=1 TO N1
           IF C(I)<C(I+1) THEN L=1 \ &
             Q=C(I) \ C(I)=C(I+1) \ C(I+1)=Q \ &
             Q=A(I) \ A(I)=A(I+1) \ A(I+1)=Q
         NEXT I
         IF L>0 THEN N1=N1-1 \ GOTO <<SOR>>
         CMAX=C(1) \ CMIN=C(N)
              !
<<*UBA>> PRINT "DO YOU WISH TO SPECIFY INTERVAL BOUNDARIES FOR THE CROSS"+ &
           "TABLE (Y/N)"; \ INPUT L$ \ PRINT
         L$=LEFT(L$,1)
         IF L$="N" GOTO <<PBA>>
         IF L$<>"Y" THEN PRINT AB$ \ GOTO <<UBA>>
         PRINT "RANGE OF VARIABLE";IA;" IS";AMIN;" TO"; AMAX \ PRINT
              !
              !     ENTER USER BOUNDARIES FOR VARIABLE A AND SORT ASCENDING
              !
<<*ABA>> PRINT "ENTER";JA+1;" INTERVAL BOUNDARIES SEPARATED BY COMMAS" \ &
         LINPUT L$ \ L$=L$+","
         FOR K=0 TO JA
<<*AGN>> IZ=INSTR(1,L$,",")
         IF IZ>0 GOTO <<AAA>>
<<*NAG>> PRINT "TYPE MORE VALUES" \ LINPUT L$ \ L$=L$+"," \ GOTO <<AGN>>
<<*AAA>> A$=LEFT(L$,IZ-1)
<<*VLA>> AB(K)=VAL(A$) \ &
         L$=RIGHT(L$,IZ+1)
         NEXT K
         I1=JA-1
<<*SBA>> L=0
         FOR I=0 TO I1
           IF AB(I)>AB(I+1) THEN Q=AB(I) \ AB(I)=AB(I+1) \ AB(I+1)=Q \ L=1
         NEXT I
         IF L>0 THEN I1=I1-1 \ GOTO <<SBA>>
         AMI1=AB(0) \ AMA1=AB(JA)
         IF AMI1<=AMIN AND AMA1>=AMAX GOTO <<AOK>>
         IL=0
         FOR I=1 TO N
           IF A(I)<AMI1 OR A(I)>AMA1 THEN IL=IL+1
         NEXT I
              !
<<*AST>> PRINT IL;" VALUE(S) ARE OUTSIDE YOUR BOUNDARIES. DO YOU STILL WISH" \ &
         INPUT "TO USE THESE VALUES (Y/N)";L$ \ PRINT \ L$=LEFT(L$,1)
         IF L$="Y" GOTO <<AOK>>
         IF L$<>"N" THEN PRINT AB$ \ GOTO <<AST>>
         GOTO <<ABA>>
<<*AOK>> AMIN=AMI1 \ AMAX=AMA1
         PRINT "RANGE OF VARIABLE";IC;" IS";CMIN;" TO"; CMAX \ PRINT
              !
              !     ENTER USER BOUNDARIES FOR VARIABLE C AND SORT DESCENDING
              !
<<*CBA>> PRINT "ENTER";JC+1;" INTERVAL BOUNDARIES SEPARATED BY COMMAS" \ &
         LINPUT L$ \ L$=L$+","
         FOR K=0 TO JC
<<*CGN>> IZ=INSTR(1,L$,",")
         IF IZ>0 GOTO <<CAA>>
<<*NCG>> PRINT "TYPE MORE VALUES" \ LINPUT L$ \ L$=L$+"," \ GOTO <<CGN>>
<<*CAA>> A$=LEFT(L$,IZ-1)
<<*VLC>> CB(K)=VAL(A$) \ &
         L$=RIGHT(L$,IZ+1)
         NEXT K
         I1=JC-1
<<*SBC>> L=0
         FOR I=0 TO I1
           IF CB(I)<CB(I+1) THEN Q=CB(I) \ CB(I)=CB(I+1) \ CB(I+1)=Q \ L=1
         NEXT I
         IF L>0 THEN I1=I1-1 \ GOTO <<SBC>>
         CMA1=CB(0) \ CMI1=CB(JC)
         IF CMI1<=CMIN AND CMA1>=CMAX GOTO <<COK>>
         IL=0
         FOR I=1 TO N
           IF C(I)<CMI1 OR C(I)>CMA1 THEN IL=IL+1
         NEXT I
              !
<<*CST>> PRINT IL;" VALUE(S) ARE OUTSIDE YOUR BOUNDARIES. DO YOU STILL WISH" \ &
         INPUT "TO USE THESE VALUES (Y/N)";L$ \ PRINT \ L$=LEFT(L$,1)
         IF L$="Y" GOTO <<COK>>
         IF L$<>"N" THEN PRINT AB$ \ GOTO <<CST>>
         GOTO <<CBA>>
<<*COK>> CMIN=CMI1 \ CMAX=CMA1
         GOTO <<SAC>>
              !
              !     CALCULATE BOUNDARIES FOR VARIABLES A AND C
              !
<<*PBA>> AINT=(AMAX-AMIN)/JA
         AB(0)=AMIN
         AB(I)=AB(I-1)+AINT FOR I=1 TO JA-1
         AB(JA)=AMAX
         CINT=(CMAX-CMIN)/JC
         CB(0)=CMAX
         CB(I)=CB(I-1)-CINT FOR I=1 TO JC-1
         CB(JC)=CMIN
              !
              !     GET CELL FREQUENCY COUNTS AND PRINT TABLE ROWS
              !
<<*SAC>> MAT IG=ZER
         AMA1=AMAX \ AMI1=AMIN \ AMAX=CMAX \ AMIN=CMIN
         GOSUB <<FOR>>
         V$=H$+"  +" \ AMAX=AMA1 \ AMIN=AMI1
         GOSUB <<FOR>>
         IL=(ND+1)/2
         IF JA>5 THEN C$="###  " \ D$="----+" ELSE &
           C$="   ###    " \ D$="---------+"
         I1=JC*2-1 \ K=1
         FOR I=0 TO I1
           L=I/2
           IF I=L*2 THEN PRINT USING V$,CB(L); \ PRINT \ GOTO <<NI3>>
           PRINT SPACE$(12)+CHR$(124); \ L=L+1
<<*LOP>>   IF K>N GOTO <<PRL>>
           IF C(K)>CMAX OR C(K)<CMIN GO TO <<NK1>>
           IF C(K)<CB(L) GOTO <<PRL>>
             IF A(K)<AMIN OR A(K)>AMAX GOTO <<NK1>>
             FOR KC=1 TO JA
              IF A(K)<AB(KC) THEN IG(L,KC)=IG(L,KC)+1 \ GOTO <<NK1>>
             NEXT KC
           IG(L,JA)=IG(L,JA)+1
<<*NK1>>   K=K+1
           IF K<=N GOTO <<LOP>>
<<*PRL>>   PRINT USING C$,IG(L,J); FOR J=1 TO JA \ PRINT
<<*NI3>> NEXT I
              !
              !     PRINT LABELS ALONG THE BOTTOM OF THE TABLE
              !
         PRINT USING V$,CB(JC); \ PRINT D$; FOR J=1 TO JA \ PRINT \ &
         IF JA<6 THEN PRINT SPACE$(7-IL); \ &
           PRINT USING H$,AB(J); FOR J=0 TO JA \ PRINT ELSE &
         PRINT SPACE$(7-IL); \ PRINT USING H$,AB(I); FOR I=0 TO JA STEP 2 \ &
           PRINT \ &
         PRINT SPACE$(12-IL); \ PRINT USING H$,AB(J); FOR J=1 TO JA STEP 2 \ &
           PRINT
              !
<<*CHI>> INPUT "DO YOU WISH TO COMPUTE CHI-SQUARE FOR THE ABOVE TABLE (Y/N)";L$
         PRINT \ L$=LEFT(L$,1)
         IF L$="N" GOTO <<MOR>>
         IF L$<>"Y" THEN PRINT AB$ \ GOTO <<CHI>>
              !
              !     COMPUTE CHI SQUARE AND RELATED STATISTICS
              !
         NZC=0 \ TSUM=0.
         FOR J=1 TO JA
           IG(0,J)=0
           IG(0,J)=IG(0,J)+IG(I,J) FOR I=1 TO JC
           IF IG(0,J)=0 THEN NZC=NZC+1
           TSUM=TSUM+IG(0,J)
         NEXT J
         NZR=0 \ X2=0. \ NL5=0
         FOR I=1 TO JC
           RSUM=0.
             RSUM=RSUM+IG(I,J) FOR J=1 TO JA
           IF RSUM=0. THEN NZR=NZR+1 \ E(I,J)=0. FOR J=1 TO JA \ GOTO <<NI4>>
           FOR J=1 TO JA
             IF IG(0,J)=0 THEN E(I,J)=0. ELSE &
               E(I,J)=(RSUM*IG(0,J))/TSUM \ &
               X2=X2+(IG(I,J)-E(I,J))**2/E(I,J) \ &
               IF E(I,J)<5. THEN NL5=NL5+1
           NEXT J
<<*NI4>> NEXT I
         NRG=JC-NZR \ NCG=JA-NZC \ &
         IF NRG<2 OR NCG<2 THEN PRINT "YOU HAVE ONLY";NRG;" ROW(S) AND";NCG; &
           " COLUMN(S) OF VALID DATA" \ PRINT "THIS IS INSUFFICIENT TO "+ &
           "COMPUTE CHI-SQUARE" \ PRINT \ GO TO <<END>>
         NDF=(NRG-1)*(NCG-1)
         PRINT USING "CHI-SQUARE               = #######.####",X2 \ &
         PRINT USING "DEGREES OF FREEDOM       =         ####",NDF \ PRINT
         IF NZR+NZC>0 THEN PRINT NZR;" ROW(S) AND";NZC;" COLUMN(S) HAVE ALL "+ &
          "0 ENTRIES AND WERE DISREGARDED" \ PRINT "IN THIS CALCULATION" \ PRINT
         IF NL5>0 THEN PRINT NL5;" CELL(S) USED IN CALCULATING CHI-SQUARE HA"+ &
           "VE AN EXPECTED FREQUENCY" \ PRINT "LESS THAN 5. "+ &
                 "THEREFORE THE VALUE COMPUTED MAY BE MEANINGLESS" \ PRINT
         IF NRG>2 OR NCG>2 GOTO <<PEF>>
              !
              !     FLOATING POINT ERROR OCCURS FOR TSUM>33
              !
         IF TSUM>33. GOTO <<PEF>>
              !
<<*TAG>> INPUT "DO YOU WISH TO COMPUTE THE FISHER EXACT PROBABILITY (Y/N)";L$
         PRINT
         L$=LEFT(L$,1)
         IF L$="N" GOTO <<PEF>>
         IF L$<>"Y" THEN PRINT AB$ \ GOTO <<TAG>>
         K=0 \
         FOR J=1 TO JA
           IF IG(0,J)=0 GOTO <<NJ2>>
           L=0
           FOR I=1 TO JC
           IF E(I,J)=0. GOTO <<NI5>>
             IF K+L=0 THEN A=IG(I,J) \ L=L+1 \ GOTO <<NI5>>
             IF K+L=2 THEN D=IG(I,J) \ GOTO <<OK2>>
             IF K=0 AND L=1 THEN C=IG(I,J) \ K=K+1 \ GO TO <<NJ2>> ELSE &
               B=IG(I,J) \ L=L+1
<<*NI5>>   NEXT I
<<*NJ2>> NEXT J
<<*OK2>> P1=FNF(A+B)*FNF(C+D)/FNF(TSUM)                            \ &
         P1=P1*FNF(A+C)*FNF(B+D)/(FNF(A)*FNF(B)*FNF(C)*FNF(D))    \ &
         PRINT USING "THE FISHER EXACT PROBABILITY = ###.####",P1 \ PRINT
              !
<<*PEF>> INPUT "DO YOU WISH TO PRINT EXPECTED FREQUENCIES (Y/N)";L$ \ PRINT \ &
         L$=LEFT(L$,1)
         IF L$="N" GOTO <<MOR>>
         IF L$<>"Y" THEN PRINT "PLEASE TYPE Y OR N" \ GOTO <<PEF>>
         PRINT "  EXPECTED FREQUENCY FOR EACH CELL" \ PRINT \ &
         J9=0
<<*NXC>> J8=J9+1
         J9=J9+6
         IF J9>JA THEN J9=JA
         PRINT "ROW";TAB(37);"COLUMN" \ PRINT \ &
         K=10
         FOR J=J8 TO J9
           PRINT TAB(K);J; \ K=K+11
         NEXT J
         PRINT \ PRINT
         FOR I=1 TO JC
           PRINT USING "###  ",I;
           PRINT USING " #####.####",E(I,J); FOR J=J8 TO J9
           PRINT
         NEXT I
         PRINT
         IF J9<JA GOTO <<NXC>>
              !
<<*MOR>> INPUT "DO YOU WISH TO COMPUTE ANOTHER CROSS TABLE (Y/N)"L$ \ PRINT \ &
           L$=LEFT(L$,1)
         IF L$="Y" GOTO <<TYP>>
         IF L$<>"N" THEN PRINT AB$ \ GOTO <<MOR>>
         GOTO <<END>>
              !
              !     SUBROUTINE TO GET PRINT FORMAT
              !
<<*FOR>> XMIN=ABS(AMIN)
         XMAX=ABS(AMAX)
         IF XMIN=0. THEN NIB=0 ELSE NIB=LOG10(XMIN) \ IF XMIN>=1. THEN NIB=NIB+1
         IF XMAX=0. THEN NIA=0 ELSE NIA=LOG10(XMAX) \ IF XMAX>=1. THEN NIA=NIA+1
         NAL=NIA
         IF NIB>NIA THEN NAL=NIB
         IF NAL>3 THEN NFA=0 \ GOTO <<FFD>>
         IF NAL<1 THEN NFA=-NAL+3 ELSE NFA=4-NAL
<<*FFD>> IF NIA<=0 THEN NIA=1
         IF AMAX<0. THEN NIA=NIA+1
         IF NIB<=0 THEN NIB=1
         IF AMIN<0. THEN NIB=NIB+1
         IF NIB>NIA THEN NIA=NIB
         ND=NIA+NFA
         IF ND>8 THEN S$=" ##.##^^^^" \ ND=9 \ GOTO <<ADT>>
         H$=" "
         IF ND<8 THEN H$=H$+" " FOR I=ND+1 TO 8
         H$=H$+"#" FOR I=1 TO NIA
         H$=H$+"."
         IF NFA>0 THEN H$=H$+"#" FOR I=1 TO NFA
<<*ADT>> RETURN
              !
              !     ERROR RECOVERY FOR TYPING ERRORS
              !
<<*ERR>> IF ERL=<<TYP>> OR ERL=<<INA>> OR ERL=<<INC>> OR ERL=<<VLA>> &
           OR ERL=<<VLC>> THEN &
         PRINT "YOU TYPED CHARACTERS THAT CANNOT BE INTERPRETED. SEPARATE "+ &
           "TWO OR MORE" \ PRINT "NUMBERS WITH A COMMA, BUT DO NOT END A "+ &
           "LINE WITH A COMMA" \ PRINT "PLEASE TRY AGAIN" \ PRINT
         IF ERL=<<TYP>> THEN RESUME <<TYP>>
         IF ERL=<<INA>> THEN RESUME <<INA>>
         IF ERL=<<INC>> THEN RESUME <<INC>>
         IF ERL=<<VLA>> OR ERL=<<VLC>> THEN PRINT "THE FIRST ";K;" VALUES "+ &
           "HAVE BEEN STORED"
         IF ERL=<<VLA>> THEN RESUME <<NAG>>
         IF ERL=<<VLC>> THEN RESUME <<NCG>>
         PRINT \ PRINT "CALCULATIONS CANNOT BE COMPLETED BECAUSE COMPUTATION"+ &
           " CREATED NUMBERS" \ PRINT "OUTSIDE THE RANGE OF THIS COMPUTER" \ &
         PRINT \I=ERR \ PRINT ERT$(I) \ &
         PRINT "CROSS0 ERROR";ERR;" AT LINE";ERL \ PRINT \ &
         PRINT "PLEASE RECORD THE ABOVE LINE AND CONTACT JOHN PENN IN BR "+ &
           "AT 3886" \ PRINT
         RESUME <<MOR>>
<<*END>> SUBEND