home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / conty.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1989-07-05  |  14.8 KB  |  258 lines
  1. 1  '        CONTINGENCY TABLES  ---  CONTY.BAS  ---  by  Dr Russell Langley
  2. 2  GOTO 400
  3. 4  '<UNK! {000A}>--- Press Enter ---
  4. 5  IF PR THEN RETURN ELSE PRINT TAB(40);:PRINT "Press <Enter> to continue.";:IN$=INKEY$:WHILE INKEY$<>CHR$(13):WEND:LOCATE,40:PRINT SPACE$(26):RETURN
  5. 7  '<UNK! {000A}>*** Redirect to Block ***
  6. 9  ON QB GOTO 405,177 :STOP  '=start,printout.<UNK! {000A}><UNK! {000A}>--- Another go? ---
  7. 10  CLOSE:IF HEAD=1 THEN LPRINT" ":LPRINT STRING$(79,61)STRING$(4,10)
  8. 11  DO$="run this program again now":GOSUB 20:IF Z$="Y" THEN 2 ELSE 30
  9. 19  '<UNK! {000A}>--- Yes/No? ---
  10. 20  PRINT:PRINT"Do you want to "+DO$;
  11. 21  INPUT" (Y/N)";Z$:IF Z$="" THEN Z$="N":RETURN ELSE Z$=CHR$(ASC(Z$) AND 95):IF Z$="Y" OR Z$="N" THEN RETURN ELSE PRINT"WHAT?  ";:GOTO 21
  12. 29  '<UNK! {000A}>--- Errors & End ---
  13. 30  IF ERR THEN BEEP ELSE RUN"MENU"
  14. 39  ON ERROR GOTO 0:END'<UNK! {000A}><UNK! {000A}>--- Messages ---
  15. 40  BEEP:PRINT "---> Sorry, that entry is illegal.":RETURN
  16. 43  COLOR 23,0:PRINT:PRINT"Working";:COLOR 7,0:RETURN
  17. 46  ZZ$=STRING$(37-LEN(Z$)\2,177):LOCATE 1,1:PRINT ZZ$"  ";:COLOR 15,0:PRINT Z$;:COLOR 7,0:PRINT"  "ZZ$:RETURN 'Display brightened Z$ at top of screen
  18. 49  '<UNK! {000A}>*** Vetted Decoding of FF X(I,J) from X$ ***<UNK! {000A}>    Needs I, M.
  19. 50  K=1:L=M
  20. 51  KX=0:FOR J=K TO L:Y$=SPACE$(10):KY=0
  21. 52  KX=KX+1:IF KX>LEN(X$) THEN IF J=L THEN 54 ELSE 57
  22. 53  Z$=MID$(X$,KX,1):IF INSTR("-.0123456789",Z$) THEN KY=KY+1:MID$(Y$,KY,1)=Z$:GOTO 52 ELSE IF Z$<>" " THEN 58 ELSE IF KY=0 THEN 52
  23. 54  X(I,J)=VAL(Y$)
  24. 55  NEXT J:IF KX>=LEN(X$) THEN 60
  25. 56  PLAY"L8O3CO2C":PRINT"Only the first"L"values have been read in that line.  Re-do it";:GOSUB 21:IF Z$="Y" THEN 59 ELSE 60
  26. 57  PLAY"L32O4CEG>C":PRINT"Not enough values in the line above.  Please re-do whole line.":GOTO 59
  27. 58  PLAY"L16O3CEL4>B":PRINT"That line contains a `non-numeric' entry.  Please re-do whole line."
  28. 59  PRINT"Row"STR$(I);:INPUT X$:IF RIGHT$(X$,1)<>"/" THEN 51 ELSE X$=LEFT$(X$,LEN(X$)-1):N=I+(X$=""):IF X$>"" THEN 51
  29. 60  RETURN
  30. 159  '<UNK! {000A}>--- Show/Print Answers ---
  31. 160  PR=0:CLOSE:OPEN "SCRN:" FOR OUTPUT AS #2:QB=-(QB<>2)*QB-(QB=2)*QBB:RETURN
  32. 161  DO$="print these results":GOSUB 20:IF Z$="N" THEN PR=0:RETURN
  33. 162  PR=1:IF ID$="" THEN LINE INPUT "Problem ID? ";ID$:GOTO 164
  34. 163  LINE INPUT"Problem ID (null = unchanged)? ";Z$:IF Z$>"" THEN ID$=Z$
  35. 164  RETURN
  36. 165  QBB=QB:QB=2:CLS:LOCATE 8,1
  37. 166  PRINT TAB(12)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  38. 167  PRINT TAB(12)"OPEN                                                       OPEN"
  39. 168  PRINT TAB(12)"OPEN                TURN  PRINTER  ON.                     OPEN"
  40. 169  PRINT TAB(12)"OPEN                                                       OPEN"
  41. 170  PRINT TAB(12)"OPEN    Then PRESS <ENTER> to start printing ..... or ..   OPEN"
  42. 171  PRINT TAB(12)"OPEN                                                       OPEN"
  43. 172  PRINT TAB(12)"OPEN    To send Printer Codes in Basic before printing,    OPEN"
  44. 173  PRINT TAB(12)"OPEN    press <Ctrl-Break>, & start printing by GOTO 9.    OPEN"
  45. 174  PRINT TAB(12)"OPEN                                                       OPEN"
  46. 175  PRINT TAB(12)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":IN$=INKEY$
  47. 176  IN$=INKEY$:IF IN$<>CHR$(13) THEN 176
  48. 177  CLS:PRINT"Printing .....":LOCATE 4,1:CLOSE:OPEN "LPT1:" FOR OUTPUT AS #2
  49. 178  PRINT #2,STRING$(79,61):PRINT #2,DAT$;TAB(42-LEN(T$(OP))\2);T$(OP);TAB(73)VER$:PRINT #2,STRING$(79,61):HEAD=1
  50. 179  PRINT #2,CHR$(10)"Problem: "ID$;CHR$(10)
  51. 180  RETURN
  52. 199  '<UNK! {000A}>*** Show a Row of Data ***
  53. 200  PRINT"Row"STR$(I)": ";:FOR J=1 TO M:PRINT USING"#######";X(I,J);:NEXT J:PRINT:RETURN
  54. 339  '<UNK! {000A}>--- Date ---
  55. 340  DAT$=MID$(DATE$,4,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",-2+3*VAL(LEFT$(DATE$,2)),3)+" "+RIGHT$(DATE$,4):RETURN
  56. 349  '<UNK! {000A}>                  *** Contingency Specials ***<UNK! {000A}>---  Ln X!  ---
  57. 350  LF=0:IF X>1 THEN FOR J=2 TO X:LF=LF+LOG(J):NEXT J
  58. 351  RETURN
  59. 359  '<UNK! {000A}>---  L Tail Prob ---
  60. 360  CP=P(A):FOR I=1 TO A-1:I1=I-1:P(A-I)=P(A-I1)*(A-I1)*(D-I1)/(B+I)/(C+I):CP=CP+P(A-I):IF P(A-I)<=9.8E-08 THEN I=A
  61. 361  NEXT I:RETURN
  62. 370  P(0)=P(1)*(D-A)/R1/C1:RETURN
  63. 379  '<UNK! {000A}>--- R Tail Prob ---
  64. 380  FOR I=1 TO AA-2:J=I-1:IF DD=0 THEN 382
  65. 381  PP(AA-I)=PP(AA-J)*(AA-J)*(DD-J)/(BB+I)/(CC+I):CQ=CQ+PP(AA-I):GOTO 383
  66. 382  PP(AA-I)=PP(AA-J)*(AA-J)/(BB+I)/(CC+I):CQ=CQ+PP(AA-I)
  67. 383  IF CQ>CP THEN CQ=CQ-PP(AA-I):I=AA
  68. 384  NEXT I:RETURN
  69. 389  '<UNK! {000A}>--- Screen Headers ---
  70. 390  CLS:GOSUB 340:PRINT DAT$;TAB(40-LEN(T$(OP))\2);:COLOR 0,7:PRINT " "T$(OP)" ";:COLOR 7,0:PRINT TAB(73)VER$:LOCATE 3,1,0:K=12:RETURN
  71. 399  '<UNK! {000A}>--- Start ---
  72. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  73. 401  DEFINT I-K:MXR=20:MXC=10:HEAD=0:VER$="(RL,4)"
  74. 402  DIM X(MXR,MXC),E(MXR,MXC),R(MXR),C(MXC),XI(MXR),XJ(MXC),P(100),PP(100),T$(4)
  75. 403  T$(1)="CHI-SQUARED FOR 2 x 3 OR LARGER TABLES":T$(2)="YATES' CHI-SQUARED FOR 2 x 2 TABLES":T$(3)="FISHER'S EXACT TEST FOR 2 x 2 TABLES":T$(4)="CHI-SQUARED GOODNESS OF FIT, R x 1 TABLES"
  76. 404  MA$=", & MEASURES OF ASSOCIATION"
  77. 405  QB=1:QBB=QB:CLOSE:CLS:Z$="M E N U   F O R   C O N T I N G E N C Y   T A B L E S":GOSUB 46
  78. 406  LOCATE 3,8:PRINT"Press the NUMBER of your choice, and then press <ENTER> to run it.":PRINT STRING$(80,196)
  79. 407  LOCATE 6,1:K=6:PRINT"<UNK! {000A}>"TAB(K)"1.  "T$(1)MA$".<UNK! {000A}><UNK! {000A}>"TAB(K)"2.  "T$(2)MA$".<UNK! {000A}><UNK! {000A}>"TAB(K)"3.  "T$(3)"."
  80. 408  PRINT"<UNK! {000A}>"TAB(K)"4.  "T$(4)".<UNK! {000A}><UNK! {000A}>"TAB(K)"5.  Return to Main Menu."
  81. 409  PRINT:PRINT"     Note:  Data entry only from keyboard for these analyses.":PRINT
  82. 410  LOCATE,K-3:INPUT"===>  Option (1-5) ";OP:ON OP GOTO 467,452,412,553,30:BEEP:PRINT"No, please enter 1, 2, 3, 4, or 5.":GOTO 410
  83. 411  '<UNK! {000A}>--- Fisher's Tests ---
  84. 412  QB=1:GOSUB 390
  85. 413  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  86. 414  PRINT TAB(K)"OPEN                                                       OPEN"
  87. 415  PRINT TAB(K)"OPEN  This computes probabilities for cell frequencies in  OPEN"
  88. 416  PRINT TAB(K)"OPEN        2 x 2 contingency tables, provided that        OPEN"
  89. 417  PRINT TAB(K)"OPEN    both 1st row total & 1st column total are < 101.   OPEN"
  90. 418  PRINT TAB(K)"OPEN                                                       OPEN"
  91. 419  PRINT TAB(K)"OPEN It compares PROPORTIONS in 2 random binomial samples, OPEN"
  92. 420  PRINT TAB(K)"OPEN  or seeks ASSOCIATION between 2 qualities tallied as  OPEN"
  93. 421  PRINT TAB(K)"OPEN       matched observations from 1 random sample.      OPEN"
  94. 422  PRINT TAB(K)"OPEN                                                       OPEN"
  95. 423  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  96. 424  PRINT TAB(K)"OPEN                                                       OPEN"
  97. 425  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE ,,1
  98. 426  PRINT:PRINT TAB(9)"Enter your 2 x 2 table of cell counts by ROWS, in Free Format,":PRINT TAB(9)"with the first cell (A) the smallest or equal smallest count.":PRINT
  99. 427  INPUT"Row 1 ";X$:IF X$="" THEN 427 ELSE I=1:M=2:GOSUB 50:A=X(1,1):B=X(1,2)
  100. 428  INPUT"Row 2 ";X$:IF X$="" THEN 428 ELSE I=2:GOSUB 50:C=X(2,1):D=X(2,2):R1=A+B:R2=C+D:C1=A+C:C2=B+D:N=R1+R2
  101. 429  IF R1>100 THEN BEEP:PRINT"Sorry, your Row 1 Total exceeds 100.":GOTO 11
  102. 430  IF C1>100 THEN BEEP:PRINT"Sorry, your Column 1 Total exceeds 100.":GOTO 11
  103. 431  GOSUB 43:X=R1:GOSUB 350:LT=LF:X=R2:GOSUB 350:LT=LT+LF:X=C1:GOSUB 350:LT=LT+LF:X=C2:GOSUB 350:LT=LT+LF:X=N:GOSUB 350:LT=LT-LF:X=A:GOSUB 350
  104. 432  LB=LF:X=B:GOSUB 350:LB=LB+LF:X=C:GOSUB 350:LB=LB+LF:X=D:GOSUB 350:LB=LB+LF:P(A)=EXP(LT-LB):CP=P(A):IF A=0 THEN 436 ELSE IF A=1 THEN 435
  105. 433  FOR I=1 TO A-1:J=I-1:P(A-I)=P(A-J)*(A-J)*(D-J)/(B+I)/(C+I):CP=CP+P(A-I):IF P(A-I)<=9.8E-08 THEN I=A:FLAG=1
  106. 434  NEXT I:IF FLAG=1 THEN FLAG=0:GOTO 436
  107. 435  P(0)=P(1)*(D-A)/R1/C1:CP=CP+P(0)
  108. 436  IF R1=R2 OR C1=C2 THEN CQ=CP:GOTO 444 ELSE IF A<R1*C1/N THEN 442
  109. 437  ' --- If A > EXP ---
  110. 438  CP=1-CP+P(A):IF CP>0.5 THEN CQ=CP:GOTO 444
  111. 439  CQ=0:FOR I=0 TO A:CQ=CQ+P(I):IF CQ>CP THEN CQ=CQ-P(I):I=A
  112. 440  NEXT I:GOTO 444
  113. 441  ' --- If A < EXP, calc R Tail ---
  114. 442  IF R1<C1 THEN AA=R1 ELSE AA=C1
  115. 443  BB=R1-AA:CC=C1-AA:DD=R2-CC:LB=0:X=AA:GOSUB 350:LB=LF:X=BB:GOSUB 350:LB=LB+LF:X=CC:GOSUB 350:LB=LB+LF:X=DD:GOSUB 350:LB=LB+LF:PP(AA)=EXP(LT-LB):CQ=PP(AA):IF CQ<CP THEN GOSUB 380 ELSE CQ=0
  116. 444  LOCATE ,1:PRINT SPACE$(10);:LOCATE ,1:GOSUB 160:F$="#### ####":CQ=CP+CQ:IF CQ>1 THEN CQ=1
  117. 445  PRINT #2,"DATA:":PRINT #2,USING F$;A;B:PRINT #2,USING F$;C;D
  118. 446  PRINT #2,:PRINT #2,USING"Probability (this particular table) =###.#!";P(A)*100;"%"
  119. 447  PRINT #2,USING"1-Tail Probability (this or any more extreme table) = ###.#!";CP*100;"%":PRINT #2,USING"2-Tail Probability (this or any less likely table)  = ###.#!";CQ*100;"%"
  120. 448  ' --- Printout? ---
  121. 449  IF PR=0 THEN GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 445
  122. 450  GOSUB 160:GOTO 10
  123. 451  '<UNK! {000A}>--- Yates' Chi-Sq ---
  124. 452  QB=1:GOSUB 390
  125. 453  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  126. 454  PRINT TAB(K)"OPEN                                                       OPEN"
  127. 455  PRINT TAB(K)"OPEN   This computes probabilities for cell frequencies    OPEN"
  128. 456  PRINT TAB(K)"OPEN              in 2 x 2 contingency tables.             OPEN"
  129. 457  PRINT TAB(K)"OPEN                                                       OPEN"
  130. 458  PRINT TAB(K)"OPEN It compares PROPORTIONS in 2 random binomial samples, OPEN"
  131. 459  PRINT TAB(K)"OPEN   or seeks ASSOCIATION between 2 qualities tallied    OPEN"
  132. 460  PRINT TAB(K)"OPEN     as matched observations from 1 random sample.     OPEN"
  133. 461  PRINT TAB(K)"OPEN                                                       OPEN"
  134. 462  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  135. 463  PRINT TAB(K)"OPEN                                                       OPEN"
  136. 464  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE ,,1
  137. 465  R=2:C=2:LC=1:GOTO 486
  138. 466  '<UNK! {000A}>--- Ordinary Chi-Sq ---
  139. 467  QB=1:GOSUB 390
  140. 468  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  141. 469  PRINT TAB(K)"OPEN                                                       OPEN"
  142. 470  PRINT TAB(K)"OPEN   This computes probabilities for cell frequencies    OPEN"
  143. 471  PRINT TAB(K)"OPEN              in large contingency tables.             OPEN"
  144. 472  PRINT TAB(K)"OPEN                                                       OPEN"
  145. 473  PRINT TAB(K)"OPEN     It compares PROPORTIONS in 1 or more samples      OPEN"
  146. 474  PRINT TAB(K)"OPEN         of counts of various kinds, or seeks          OPEN"
  147. 475  PRINT TAB(K)"OPEN  ASSOCIATION between 2 multinomial qualities tallied  OPEN"
  148. 476  PRINT TAB(K)"OPEN     as matched observations from 1 random sample.     OPEN"
  149. 477  PRINT TAB(K)"OPEN                                                       OPEN"
  150. 478  PRINT TAB(K)"OPEN  Entries are vetted & can be corrected if necessary.  OPEN"
  151. 479  PRINT TAB(K)"OPEN                                                       OPEN"
  152. 480  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  153. 481  PRINT TAB(K)"OPEN                                                       OPEN"
  154. 482  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE ,,1:PRINT
  155. 483  PRINT"How many ROWS (2-"RIGHT$(STR$(MXR),2)") ";:INPUT R:IF R<2 OR R>MXR THEN BEEP:GOTO 483
  156. 484  PRINT"How many COLS (2-"RIGHT$(STR$(MXC),2)") ";:INPUT C:IF C<2 OR C>MXC THEN BEEP:GOTO 484
  157. 485  IF C<10 THEN LC=1 ELSE LC=2
  158. 486  PRINT:PRINT"Enter"STR$(R)" x "RIGHT$(STR$(C),LC)" Contingency Table by ROWS (in Free Format):":PRINT:M=C:I=1
  159. 487  PRINT"Row"I;:INPUT X$:IF X$="" THEN 487 ELSE GOSUB 50:I=I+1:IF I<=R THEN 487
  160. 488  IF OP=2 THEN 494 ELSE CLS:PRINT"DATA READ WAS:":PRINT:PRINT SPACE$(7);:FOR J=1 TO C:PRINT USING"  Col #";J;:NEXT J:PRINT:FOR I=1 TO R:GOSUB 200:IF I=10 THEN GOSUB 5
  161. 489  NEXT I
  162. 490  DO$="make any CHANGES to those values":GOSUB 20:IF Z$="N" THEN 494
  163. 491  INPUT"Change which ROW ";RR:IF RR<1 OR RR>R THEN 491
  164. 492  INPUT"Change which COL ";CC:IF CC<1 OR CC>C THEN 492
  165. 493  PRINT"Present value ="X(RR,CC);:INPUT"   Correct value ";X(RR,CC):IF OP=4 THEN 570 ELSE 488
  166. 494  GOSUB 43:N=0:FOR I=1 TO R:R(I)=0:FOR J=1 TO C:R(I)=R(I)+X(I,J):NEXT J:N=N+R(I):NEXT I:FOR J=1 TO C:C(J)=0:FOR I=1 TO R:C(J)=C(J)+X(I,J):NEXT I:NEXT J
  167. 495  GOSUB 538:CLS:F1$="#####  ":F2$=" :#####":F3$="#####.#"
  168. 496  '  --- Answers ---
  169. 497  GOSUB 160
  170. 498  PRINT #2,"OBSERVED & EXPECTED VALUES, CONTRIBUTIONS TO CHI-SQUARED, & MARGINAL TOTALS.":PRINT #2,SPACE$(17)".... Any E < 5 will be marked `---' ...."
  171. 499  CH=0:FOR I=1 TO R:X=R(I)/N
  172. 500  PRINT #2,:PRINT #2,USING"Row##: ";I;:FOR J=1 TO C:PRINT #2,USING F1$;X(I,J);:NEXT J:PRINT #2,USING F2$;R(I):PRINT #2,"Expec: ";
  173. 501  FOR J=1 TO C:E(I,J)=X*C(J)
  174. 502  IF E(I,J)>=5 THEN PRINT #2,USING F3$;E(I,J); ELSE PRINT #2," ---";USING"#.#";E(I,J);
  175. 503  NEXT J:PRINT #2,:PRINT #2,"Contr: ";
  176. 504  IF OP=2 THEN 506
  177. 505  FOR J=1 TO C:T=(X(I,J)-E(I,J))^2/E(I,J):CH=CH+T:PRINT #2,USING F3$;T;:NEXT J:PRINT #2,:GOTO 507
  178. 506  FOR J=1 TO C:T=(ABS(X(I,J)-E(I,J))-0.5)^2/E(I,J):CH=CH+T:PRINT #2,USING F3$;T;:NEXT J:PRINT #2,
  179. 507  IF I/5=INT(I/5) THEN GOSUB 5
  180. 508  NEXT I
  181. 509  FOR J=1 TO C+2:PRINT #2,STRING$(7,".");:NEXT J:PRINT #2,:PRINT #2,"Total: ";:FOR J=1 TO C:PRINT #2,USING F1$;C(J);:NEXT J:PRINT #2,USING F2$;N
  182. 510  '   --- Larger Tables ---
  183. 511  IF OP=2 THEN 517 ELSE PRINT #2,:PRINT #2,USING"CHI-SQUARED =#####.##,    d.f. =####";CH;(R-1)*(C-1):GOSUB 5:IF R<C THEN X=R-1 ELSE X=C-1
  184. 512  PRINT #2,USING"Cramer's C  =###.####";SQR(CH/(X*N)):GOSUB 548
  185. 513  '    ---  Printout?  ---
  186. 514  IF PR=0 THEN GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 498
  187. 515  GOSUB 160:GOTO 10
  188. 516  '   --- Yates' Phi, Phi-Limits, Yule's Q ---
  189. 517  TP=X(1,1)*X(2,2)-X(1,2)*X(2,1):PH=TP/SQR(R(1)*R(2))/SQR(C(1)*C(2)):TM=R(1):OT=C(1):IF R(2)>TM THEN TM=R(2):OT=C(2)
  190. 518  IF C(1)>TM THEN TM=C(1):OT=R(1)
  191. 519  IF C(2)>TM THEN TM=C(2):OT=R(2)
  192. 520  PU=SQR(((N-TM)/TM)*(OT/(N-OT))):PL=-SQR(((N-TM)/TM)*((N-OT)/OT)):YQ=TP/(X(1,1)*X(2,2)+X(1,2)*X(2,1))
  193. 521  '  --- Odds Ratio & S.E. LN ODS (SO) ---
  194. 522  K=0:IF X(1,1)=0 OR X(2,2)=0 THEN K=1:OD=0 ELSE IF X(1,2)=0 OR X(2,1)=0 THEN K=2
  195. 523  IF K=0 THEN OD=X(1,1)*X(2,2)/X(1,2)/X(2,1):SO=SQR(1/X(1,1)+1/X(1,2)+1/X(2,1)+1/X(2,2)):GOTO 525
  196. 524  SO=SQR(1/(X(1,1)+0.5)+1/(X(1,2)+0.5)+1/(X(2,1)+0.5)+1/(X(2,2)+0.5))
  197. 525  PRINT #2,
  198. 526  PRINT #2,USING"Yates' CHI-SQ   =#####.##,   d.f. = 1";CH:GOSUB 5
  199. 527  PRINT #2,USING"PHI Coefficient =###.####";PH
  200. 528  PRINT #2,USING"PHI Limits here =###.####  !####.####";PL;"&";PU
  201. 529  PRINT #2,USING"Yule's Q        =###.####";YQ
  202. 530  PRINT #2,USING"S.E. of Q       =###.####";(1-YQ^2)*0.5*SO
  203. 531  PRINT #2,
  204. 532  IF K=2 OR OD>1E+08 THEN PRINT #2,"Odds Ratio      = Infinity":PRINT #2,"Ln Odds Ratio   = Infinity":GOSUB 548:GOTO 514
  205. 533  IF K=0 AND OD>100 THEN PRINT #2,USING"Odds Ratio      =########.##";OD:GOTO 535
  206. 534  IF K=0 THEN PRINT #2,USING"Odds Ratio      =######.####";OD
  207. 535  IF K=0 THEN PRINT #2,USING"Ln Odds Ratio   =######.####";LOG(OD):PRINT #2,USING "S.E. Ln Odds    =######.####";SO:GOSUB 548:GOTO 514
  208. 536  PRINT #2,USING"Odds Ratio      =#######.####";OD:PRINT #2,"Ln Odds Ratio   = Minus Infinity":GOSUB 548:GOTO 514
  209. 537  '   ---  Lambda ---
  210. 538  FOR I=1 TO R:XI(I)=X(I,1):FOR J=2 TO C:IF X(I,J)>XI(I) THEN XI(I)=X(I,J)
  211. 539  NEXT J:NEXT I
  212. 540  FOR J=1 TO C:XJ(J)=X(1,J):FOR I=2 TO R:IF X(I,J)>XJ(J) THEN XJ(J)=X(I,J)
  213. 541  NEXT I:NEXT J
  214. 542  RM=R(1):FOR I=2 TO R:IF R(I)>RM THEN RM=R(I)
  215. 543  NEXT I
  216. 544  CM=C(1):FOR J=2 TO C:IF C(J)>CM THEN CM=C(J)
  217. 545  NEXT J
  218. 546  TA=0:FOR J=1 TO C:TA=TA+XJ(J):NEXT J:TA=TA-RM:TB=0:FOR I=1 TO R:TB=TB+XI(I):NEXT I:TB=TB-CM:BA=N-RM:BB=N-CM
  219. 547  RETURN
  220. 548  PRINT #2,
  221. 549  PRINT #2,USING"Lambda (A), for predicting ROW =##.####";TA/BA
  222. 550  PRINT #2,USING"Lambda (B), for predicting COL =##.####";TB/BB
  223. 551  PRINT #2,USING"Lambda (Symmetric Version)     =##.####";(TA+TB)/(BA+BB):RETURN
  224. 552  '<UNK! {000A}>---  R x 1  Tables  ---
  225. 553  QB=1:GOSUB 390:F1$="         OBSERVED    EXPECTED ":F2$=": ######    ######.###"
  226. 554  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  227. 555  PRINT TAB(K)"OPEN                                                       OPEN"
  228. 556  PRINT TAB(K)"OPEN        This compares a column of 2-20 OBSERVED        OPEN"
  229. 557  PRINT TAB(K)"OPEN        cell counts with their EXPECTED values.        OPEN"
  230. 558  PRINT TAB(K)"OPEN                                                       OPEN"
  231. 559  PRINT TAB(K)"OPEN    It computes a Chi-Squared value which tells the    OPEN"
  232. 560  PRINT TAB(K)"OPEN  probability of the differences being due to chance.  OPEN"
  233. 561  PRINT TAB(K)"OPEN                                                       OPEN"
  234. 562  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  235. 563  PRINT TAB(K)"OPEN                                                       OPEN"
  236. 564  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE ,,1
  237. 565  PRINT:PRINT"Your R x 1 Frequency Table is to be entered as R rows, each with 2 entries ---<UNK! {000A}>an OBSERVED count (whole number), & its EXPECTED value (up to 3 decimal places).":PRINT
  238. 566  'PRINT"Observed counts will be whole numbers, but expected values can have<UNK! {000A}>up to 3 decimal places if necessary.":?
  239. 567  PRINT"How many rows (2-"RIGHT$(STR$(MXR),2)") ";:INPUT R:IF R<2 OR R>MXR THEN BEEP:GOTO 567
  240. 568  PRINT"Enter OBSERVED & EXPECTED frequencies (in Free Format):":C=2:M=C:I=1
  241. 569  PRINT"Row"I;:INPUT X$:IF X$=""THEN 569 ELSE GOSUB 50:I=I+1:IF I<=R THEN 569
  242. 570  SO=0:SE=0:FOR I=1 TO R:SO=SO+X(I,1):SE=SE+X(I,2):NEXT I
  243. 571  CLS:PRINT"DATA READ WAS:":PRINT:PRINT F1$:FOR I=1 TO R:PRINT USING"Row###"+F2$;I;X(I,1);X(I,2):IF I=15 THEN GOSUB 5
  244. 572  NEXT I
  245. 573  PRINT STRING$(28,"."):PRINT USING"Totals"+F2$;SO;SE
  246. 574  IF ABS(SO-SE)>0.000899999 THEN BEEP:PRINT:PRINT"Note:  OBSERVED & EXPECTED TOTALS DIFFER.  FIX THIS!!!<UNK! {000A}>":GOTO 491
  247. 575  DO$="make any CHANGES to those values":GOSUB 20:IF Z$="Y" THEN 491
  248. 576  CH=0:FOR I=1 TO R:P(I)=(X(I,1)-X(I,2))^2/X(I,2):CH=CH+P(I):NEXT I:IF PR=0 THEN CLS:GOSUB 160
  249. 577  '   --- Show data & answers ---
  250. 578  PRINT #2,F1$+"  CONTRIB TO CHI-SQ"
  251. 579  FOR I=1 TO R:PRINT #2,USING"Row###"+F2$+"    ######.##";I;X(I,1);X(I,2);P(I):IF I=15 THEN GOSUB 5
  252. 580  NEXT I
  253. 581  PRINT #2,STRING$(28,"."):PRINT #2,USING"TOTALS"+F2$;SO;SE
  254. 582  PRINT #2,:PRINT #2,USING"CHI-SQUARED =#####.##";CH:PRINT #2,"NOTE: The d.f. depend on the number of constraints when calculating the E's."
  255. 583  IF PR=0 THEN GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 578
  256. 584  IF PR=1 THEN GOSUB 160:GOTO 10
  257. 585  'end
  258.