home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / anovu.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1989-08-16  |  18.8 KB  |  301 lines
  1. 1  '      2-WAY ANOVA, UNREPLICATED  --  ANOVU.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. 6  PRINT TAB(14);:PRINT "Press <Enter> to continue, or `/' to end viewing.";:IN$=INKEY$:WHILE IN$<>CHR$(13) AND IN$<>"/":IN$=INKEY$:WEND:LOCATE,14:PRINT SPACE$(50):IF IN$="/" THEN I=N:RETURN ELSE RETURN
  6. 7  '<UNK! {000A}>*** Redirect to Block ***
  7. 9  ON QB GOTO 2,177,10,30:STOP  '=start,printout,re-run,quit.<UNK! {000A}><UNK! {000A}>*** Another go? ***
  8. 10  CLOSE:IF QB<>3 THEN IF HEAD=1 THEN LPRINT CHR$(10)STRING$(79,61)STRING$(4,10)
  9. 11  DO$="run this program again now":GOSUB 20:IF Z$="Y" THEN 2 ELSE 30
  10. 19  '<UNK! {000A}>--- Yes/No? ---
  11. 20  PRINT:PRINT"Do you want to "+DO$;
  12. 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
  13. 29  '<UNK! {000A}>--- Errors & End ---
  14. 30  IF ERR THEN BEEP ELSE RUN "MENU"
  15. 31  IF ERR=70 THEN LINE INPUT"Can't write to that disk.  Remove its Write-Protect tab, then press <Enter>.";Z$:RESUME
  16. 32  IF ERR=71 THEN LINE INPUT"That drive is empty or its gate is open.  Fix, then press <Enter>.";Z$:RESUME
  17. 33  IF ERR=210 THEN RESUME 9  'from #86
  18. 39  ON ERROR GOTO 0:END'<UNK! {000A}><UNK! {000A}>--- Messages ---
  19. 40  BEEP:PRINT "---> Sorry, that entry is illegal.":RETURN
  20. 41  BEEP:PRINT "---> Sorry, double quotes are not allowed here.":RETURN
  21. 42  BEEP:PRINT"* * * Can't Do That.":QB=4:GOTO 9
  22. 43  COLOR 23,0:PRINT:PRINT"Working";:COLOR 7,0:RETURN
  23. 44  LOCATE,1:PRINT"Ok, done.";:GOTO 5
  24. 49  '<UNK! {000A}>--- Vetted Decoding of FF X(I,J) from X$ ---<UNK! {000A}>    Needs I, M, Q(0) from #96 or #256, & UT>0 if UT matrix.
  25. 50  K=1:L=M
  26. 51  KX=0:FOR J=K TO L:Y$=SPACE$(10):KY=0
  27. 52  KX=KX+1:IF KX>LEN(X$) THEN IF J=L THEN 54 ELSE 57
  28. 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
  29. 54  IF Q(0) THEN Q(J)=VAL(Y$) ELSE X(I,J)=VAL(Y$)
  30. 55  NEXT J:IF KX>=LEN(X$) THEN 60
  31. 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
  32. 57  PLAY"L32O4CEG>C":PRINT"Not enough values in the line above.  Please re-do whole line.":GOTO 59
  33. 58  PLAY"L16O3CEL4>B":PRINT"That line contains a `non-numeric' entry.  Please re-do whole line."
  34. 59  IF Q(0)=1 THEN 61 ELSE 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
  35. 60  RETURN
  36. 61  INPUT X$:IF X$="" THEN 61 ELSE 51
  37. 69  '<UNK! {000A}>--- K/b Input of all X(I,J) in FF ---<UNK! {000A}>    Needs first I, M, Q>0 (sample #), KN(Q), & if UT matrix UT>0.  Returns N.
  38. 70  PRINT"Enter data from keyboard, ";:IF M=1 THEN PRINT "pressing <Enter> after each number.":GOTO 72
  39. 71  PRINT"in Free Format, pressing <Enter> at end of each row.":IF UT THEN 73
  40. 72  PRINT"Null entry duplicates previous row.  Signal `end-of-data' by entering a `/'"
  41. 73  PRINT "Row"STR$(I);:INPUT X$:IF UT>0 AND I=M THEN N=M:GOTO 75 ELSE IF X$=""THEN IF I>1 THEN FOR J=1 TO M:X(I,J)=X(I-1,J):NEXT J:I=I+1:LOCATE CSRLIN-1,POS(0)+9:PRINT"Ditto":GOTO 73
  42. 74  IF RIGHT$(X$,1)="/" THEN X$=LEFT$(X$,LEN(X$)-1):N=I+(X$=""):IF X$="" THEN 76
  43. 75  GOSUB 50:IF N=0 THEN IF I<MXR THEN I=I+1:GOTO 73 ELSE N=MXR
  44. 76  RETURN
  45. 79  '<UNK! {000A}>*** Disk Input of X(I,J), N, M, etc ***<UNK! {000A}>    Needs MNR, MNC, & NEEDVARS.
  46. 80  QD=1:IO$="I":GOSUB 110:CLS:PRINT "Loading data from disk.":INPUT #1,FL$,VR$
  47. 81  IF LEFT$(VR$,4)<>"(RL," THEN BEEP:PRINT "Unreadable file --- not made by our Data Filer/Editor program.":GOTO 86
  48. 82  INPUT #1,DT$,ID$,N,M,UT,VN$:PRINT "Filename: "FL$,"Made: "DT$,"Version: "VR$:PRINT"ID: "ID$:PRINT
  49. 83  IF UT>0 THEN PRINT "This file is an upper triangular matrix, which this program can't use!":GOTO 86
  50. 84  PRINT"File has"N"rows of data. ";:IF N<MNR THEN PRINT "--- Not enough!":GOTO 86 ELSE IF N>MXR THEN PRINT"--- Too many!":GOTO 86
  51. 85  PRINT:PRINT"File has"M"column variables. ";:IF M<MNC THEN PRINT "--- Not enough!" ELSE IF M>MXC THEN PRINT"Too many!" ELSE 88
  52. 86  CLOSE:BEEP:GOSUB 5:ERROR 210
  53. 87  A=M:B=N:GOSUB 433 ' set dimensions<UNK! {000A}><UNK! {000A}>---Select variables
  54. 88  PRINT:IF VN$="N" THEN PRINT "The"M"variables are not named.":GOTO 90
  55. 89  PRINT "Variables in file are:":FOR J=1 TO M:INPUT #1,VN$(J):PRINT J;VN$(J),:NEXT J:PRINT
  56. 90  IF M=MNC OR UT>0 THEN 100 ELSE PRINT
  57. 91  IF NEEDVARS=0 THEN PRINT"How many filed column variables are to be IGNORED (0-"MID$(STR$(M-MNC),2)")";:INPUT ND:IF ND<0 OR ND>M-MNC THEN 91 ELSE IF ND=0 THEN 100
  58. 92  '
  59. 93  '
  60. 94  IF ND=1 THEN PRINT "Number of the variable to be IGNORED (1-"MID$(STR$(M),2)")";:INPUT X$:Q(1)=VAL(X$):IF Q(1)<1 OR Q(1)>M THEN GOSUB 40:GOTO 94 ELSE 97
  61. 95  PRINT MID$(STR$(ND),2)" numbers of variables to be IGNORED (in ascending order & Free Format):":INPUT X$:IF VAL(X$)<1 THEN GOSUB 40:GOTO 95
  62. 96  Q(0)=1:MM=M:M=ND:GOSUB 50:Q(0)=0:M=MM
  63. 97  KK=1:L=1:FOR J=1 TO M:IF J=Q(KK) THEN KK=KK+1 ELSE VN$(L)=VN$(J):L=L+1
  64. 98  NEXT J
  65. 99  '   Now read numerical data from disk
  66. 100  COLOR 23,0:PRINT"Loading numbers";:COLOR 7,0:FOR I=1 TO N:KK=1:LL=1:L=M
  67. 101  FOR J=1 TO L:INPUT #1,Z
  68. 102  IF J=Q(KK) THEN KK=KK+1 ELSE X(I,LL)=Z:LL=LL+1
  69. 103  NEXT J:NEXT I:CLOSE:LOCATE,1:M=M-ND:RETURN
  70. 109  '<UNK! {000A}>--- Get Filespec ---
  71. 110  IF IO$="O" THEN STOP
  72. 111  LINE INPUT "Filename (I will add .DAT extension)? ";FL$:IF FL$="" THEN 111 ELSE IF MID$(FL$,2,1)=":" THEN DR$=LEFT$(FL$,1):FL$=MID$(FL$,3)
  73. 112  ER=0:FOR I=1 TO LEN(FL$):Z$=MID$(FL$,I,1):IF INSTR(" .,/\|?*:;[]+="+CHR$(34),Z$) THEN ER=1
  74. 113  NEXT I
  75. 114  IF ER=0 AND FL$>"" AND LEN(FL$)<9 THEN FL$=FL$+".DAT" ELSE BEEP:PRINT "Invalid filename.  Will you try again";:GOSUB 21:IF Z$="Y" THEN 111 ELSE 2
  76. 115  INPUT "Which drive (A,B,C,D)";DR$:IF DR$="" THEN 115
  77. 116  DR$=CHR$(ASC(DR$) AND 95):IF INSTR("ABCD",DR$)=0 THEN 115
  78. 117  INPUT "Which directory (e.g. WORK, MYDATA, or Null Entry if root) ";DR2$:IF DR2$="" THEN DR$=DR$+":" ELSE DR$=DR$+":\"+DR2$+"\"
  79. 129  '<UNK! {000A}>--- Open File, IO$= "I" or "O" ---
  80. 130  IF IO$="I" THEN 134 ELSE STOP
  81. 131  '
  82. 132  '
  83. 133  '
  84. 134  ON ERROR GOTO 136:OPEN DR$+FL$ FOR INPUT AS #1  'for input
  85. 135  ON ERROR GOTO 30:RETURN   'input #1,A$,B$:close
  86. 136  PRINT FL$" not found on Drive "DR$:RESUME 137
  87. 137  GOSUB 5:ON ERROR GOTO 30:CLS:SHELL "DIR "+DR$+"/W":GOSUB 5
  88. 138  DIM X(MXR,MXC) ' or replace MXC ....
  89. 139  GOTO 110
  90. 159  '<UNK! {000A}>*** Show/Print Answers ***
  91. 160  QB=3:PR=0:CLOSE:OPEN "SCRN:" FOR OUTPUT AS #2:RETURN
  92. 161  DO$="print these results":GOSUB 20:IF Z$="N" THEN PR=0:RETURN
  93. 162  PR=1:IF ID$="" THEN LINE INPUT "Problem ID? ";ID$:GOTO 164
  94. 163  LINE INPUT"Problem ID (null = unchanged)? ";Z$:IF Z$>"" THEN ID$=Z$
  95. 164  RETURN
  96. 165  QB=2:CLS:LOCATE 8,1
  97. 166  PRINT TAB(12)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  98. 167  PRINT TAB(12)"OPEN                                                       OPEN"
  99. 168  PRINT TAB(12)"OPEN                TURN  PRINTER  ON.                     OPEN"
  100. 169  PRINT TAB(12)"OPEN                                                       OPEN"
  101. 170  PRINT TAB(12)"OPEN    Then PRESS <ENTER> to start printing ..... or ..   OPEN"
  102. 171  PRINT TAB(12)"OPEN                                                       OPEN"
  103. 172  PRINT TAB(12)"OPEN    To send Printer Codes in Basic before printing,    OPEN"
  104. 173  PRINT TAB(12)"OPEN    press <Ctrl-Break>, & start printing by GOTO 9.    OPEN"
  105. 174  PRINT TAB(12)"OPEN                                                       OPEN"
  106. 175  PRINT TAB(12)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":IN$=INKEY$
  107. 176  IN$=INKEY$:IF IN$<>CHR$(13) THEN 176
  108. 177  CLS:PRINT"Printing .....":LOCATE 4,1:CLOSE:OPEN "LPT1:" FOR OUTPUT AS #2
  109. 178  IF HEAD=0 THEN PRINT #2,STRING$(79,61):PRINT #2,DAT$;TAB(42-LEN(HD$)\2);HD$;TAB(73)VER$:PRINT #2,STRING$(79,61):HEAD=1
  110. 179  PRINT #2,CHR$(10)"Problem: "ID$;CHR$(10)
  111. 180  RETURN
  112. 199  '<UNK! {000A}>--- Show a Row of Data ---
  113. 200  PRINT"Row"STR$(I)": ";:FOR J=1 TO M:PRINT X(I,J);:NEXT J:PRINT:RETURN
  114. 209  '<UNK! {000A}>--- Varnames ---
  115. 210  IF VN$="Y" THEN RETURN ELSE FOR L=1 TO M:IF L<10 THEN VN$(L)="Var #"+STR$(L) ELSE VN$(L)="Var #"+MID$(STR$(L),2)
  116. 211  NEXT L:RETURN
  117. 249  '<UNK! {000A}>*** Transform Sub ***
  118. 250  K=20:CLS:LOCATE,24,0:PRINT "TRANSFORM MENU<UNK! {000A}><UNK! {000A}>"TAB(K)"1   Arcsin (Sqrt (p))<UNK! {000A}>"TAB(K)"2   Arcsin (Sqrt (p%/100))<UNK! {000A}>"TAB(K)"3   Log (X)<UNK! {000A}>"TAB(K)"4   Log (X+1)<UNK! {000A}>"TAB(K)"5   Reciprocal 100/X";
  119. 251  PRINT"<UNK! {000A}>"TAB(K)"6   Reciprocal Plus, 100/(X+1)<UNK! {000A}>"TAB(K)"7   Sqrt (X)<UNK! {000A}>"TAB(K)"8   Sqrt (X+0.5)<UNK! {000A}>"TAB(K)"9   X Squared<UNK! {000A}>"TAB(K-1)"10   None (leaving data unchanged)"
  120. 252  PRINT:LOCATE,,1:AA=57.2958:BB=0.434294:H=100:P9=0.99999:E$(0)=""
  121. 253  INPUT"Which transform (1 to 10)";T%:IF T%=10 THEN 267 ELSE IF T%<1 OR T%>9 THEN PRINT"WHAT?  ";:GOTO 253
  122. 254  FOR J=1 TO B:FOR I=1 TO A:ON T% GOTO 256,255,259,258,261,260,263,262,264
  123. 255  X(J,I)=X(J,I)/H
  124. 256  IF X(J,I)>P9 THEN X(J,I)=P9 ELSE IF X(J,I)<0 THEN 266
  125. 257  X(J,I)=SQR(X(J,I)):X(J,I)=AA*ATN(X(J,I)/SQR(1-X(J,I)*X(J,I))):GOTO 265
  126. 258  X(J,I)=X(J,I)+1
  127. 259  IF X(J,I)>0 THEN X(J,I)=BB*LOG(X(J,I)):GOTO 265 ELSE 266
  128. 260  X(J,I)=X(J,I)+1
  129. 261  IF X(J,I)<>0 THEN X(J,I)=H/X(J,I):GOTO 265 ELSE 266
  130. 262  X(J,I)=X(J,I)+P5
  131. 263  IF X(J,I)>=0 THEN X(J,I)=SQR(X(J,I)):GOTO 265 ELSE 266
  132. 264  X(J,I)=X(J,I)*X(J,I)
  133. 265  NEXT I:NEXT J:IF E$(0)="" THEN GOSUB 44:GOTO 267
  134. 266  BEEP:E$(0)="PROPORTION < 0":E$(1)="LOG 0 or Negative Number":E$(2)="DIVISION by 0":E$(3)="SQRT of Negative Number":PRINT:PRINT"Fatal Error: "E$((T%-1)/2)", Row"I:GOSUB 5:END
  135. 267  RETURN
  136. 339  '<UNK! {000A}>--- Date ---
  137. 340  DAT$=MID$(DATE$,4,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",-2+3*VAL(LEFT$(DATE$,2)),3)+" "+RIGHT$(DATE$,4):RETURN
  138. 349  '<UNK! {000A}>--- Anova Specials ---
  139. 350  SM=R(1):GR=SM:FOR I=2 TO A:IF R(I)<SM THEN SM=R(I) ELSE IF R(I)>GR THEN GR=R(I)
  140. 351  NEXT I:RR(K)=GR/SM:PRINT #2,:RETURN
  141. 359  '<UNK! {000A}>--- Inverse of Diag C(M,M) ---
  142. 360  D=1:FLAG=0:FOR I=1 TO M:IP(I)=0:NEXT I:FOR I=1 TO M:Z=0:FOR J=1 TO M:IF IP(J)=1 THEN 365
  143. 361  FOR K=1 TO M:ON SGN(IP(K)-1)+2 GOTO 363,364,362
  144. 362  I=M:J=M:K=M:FLAG=1:GOTO 364
  145. 363  IF Z < ABS(C(J,K)) THEN IR=J:IC=K:Z=C(J,K)
  146. 364  NEXT K
  147. 365  NEXT J:IF FLAG=1 THEN 371
  148. 366  IP(IC)=IP(IC)+1:IF IR<>IC THEN D=-D:FOR L=1 TO M:Z=C(IR,L):C(IR,L)=C(IC,L):C(IC,L)=Z:NEXT L
  149. 367  KR(I)=IR:KC(I)=IC:P(I)=C(IC,IC):D=D*P(I):IF ABS(P(I))<=9.99E-07 THEN D=0:I=M:GOTO 371
  150. 368  C(IC,IC)=1:FOR L=1 TO M:C(IC,L)=C(IC,L)/P(I):NEXT L
  151. 369  FOR K=1 TO M:IF K<>IC THEN Z=C(K,IC):C(K,IC)=0:FOR L=1 TO M:C(K,L)=C(K,L)-C(IC,L)*Z:NEXT L
  152. 370  NEXT K
  153. 371  NEXT I:IF FLAG=1 OR D=0 THEN 375
  154. 372  FOR I=1 TO M:Q=M-I+1:IF KR(Q)=KC(Q) THEN 374 ELSE K=KR(Q):L=KC(Q)
  155. 373  FOR J=1 TO M:Z=C(J,K):C(J,K)=C(J,L):C(J,L)=Z:NEXT J
  156. 374  NEXT I
  157. 375  RETURN
  158. 399  '<UNK! {000A}>--- Start ---
  159. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  160. 401  DEFINT I-N,Q:MXR=20:MXC=10:NEEDVARS=0:QB=1
  161. 402  DIM I,J,K,L,M,N,QP,Z,X$,Y$,Z$,ID$,A,B,S,T,TM,S1,S2,S3,S4,S5,S6
  162. 403  DIM VN$(MXC),Q(MXC),RR(4),T$(10),E$(3)
  163. 404  P5=0.5:S$=SPACE$(6):F$="#####.###"
  164. 405  T$(1)="Arcsin (Sqrt(p))":T$(2)="Arcsin (Sqrt(p%/100))":T$(3)="Log(X)":T$(4)="Log(X+1)":T$(5)="Reciprocal, 100/X":T$(6)="Reciprocal Plus, 100/(X+1)":T$(7)="Sqrt(X)":T$(8)="Sqrt(X+0.5)":T$(9)="X Squared":T$(10)="None":T$(0)=T$(10)
  165. 406  HD$=" 2 - W A Y   A N O V A,   U n r e p l i c a t e d ":VER$="(RL,2)"
  166. 407  QB=4:CLOSE:CLS:GOSUB 340:PRINT DAT$;TAB(40-LEN(HD$)\2);:COLOR 0,7:PRINT HD$;:COLOR 7,0:PRINT TAB(73)VER$:LOCATE 4,1,0:K=12
  167. 408  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  168. 409  PRINT TAB(K)"OPEN                                                       OPEN"
  169. 410  PRINT TAB(K)"OPEN     Compares MEANS of row & column measurements       OPEN"
  170. 411  PRINT TAB(K)"OPEN  with 2-20 ROWS (persons) & 2-10 COLS (treatments),   OPEN"
  171. 412  PRINT TAB(K)"OPEN   if each person is measured on only 1 treatment.     OPEN"
  172. 413  PRINT TAB(K)"OPEN                                                       OPEN"
  173. 414  PRINT TAB(K)"OPEN        Data can be from keyboard or disk file.        OPEN"
  174. 415  PRINT TAB(K)"OPEN     Features vetted Free Format entry for numbers.    OPEN"
  175. 416  PRINT TAB(K)"OPEN    Simple editing & data transforms are available.    OPEN"
  176. 417  PRINT TAB(K)"OPEN                                                       OPEN"
  177. 418  PRINT TAB(K)"OPEN   Tests assumption of Equal Correlations between all  OPEN"
  178. 419  PRINT TAB(K)"OPEN     pairs of cols (if cols > 2, & if rows >= cols).   OPEN"
  179. 420  PRINT TAB(K)"OPEN                                                       OPEN"
  180. 421  PRINT TAB(K)"OPEN       Printouts available after viewing answers.      OPEN"
  181. 422  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  182. 423  PRINT TAB(K)"OPEN                                                       OPEN"
  183. 424  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE ,,1
  184. 425  '<UNK! {000A}>--- Get Data:  X(J,I) with B rows & A cols ---
  185. 426  DO$="enter data from disk":GOSUB 20:QB=1:IF Z$="N" THEN 430
  186. 427  '<UNK! {000A}>--- Disk Entry ---
  187. 428  QD=1:MNR=2:MNC=2:GOSUB 80:A=M:B=N:GOSUB 5:GOTO 436
  188. 429  '<UNK! {000A}>--- K/b Entry ---
  189. 430  QD=0:INPUT "No. of Rows (2-20) ";X$:B=VAL(X$):IF B<2 OR B>MXR THEN 430
  190. 431  INPUT "No. of Columns (2-10) ";X$:A=VAL(X$):IF A<2 OR A>MXC THEN 431
  191. 432  DIM X(B,A)
  192. 433  DIM N(B),A(A),AM(A),B(B),BM(B),GR(A),SM(A),S(A),R(A),AL(A),BE(B),TU(B),D(A,A),C(A,A),IP(A),P(A),KR(A),KC(A),CM(A-1):IF QD=1 THEN RETURN
  193. 434  PRINT"Enter measurements by rows, in Free Format ---":M=A:I=1
  194. 435  PRINT"Row"I;:INPUT X$:IF X$="" THEN 435 ELSE GOSUB 50:IF I<B THEN I=I+1:GOTO 435
  195. 436  CLS:PRINT"Data read was:":M=A:FOR I=1 TO B:GOSUB 200:NEXT I:GOSUB 5
  196. 437  '<UNK! {000A}>--- Edit ---
  197. 438  INPUT "Edit (C#=Change row, SA=Show all, Null=Proceed) ";Z$
  198. 439  IF Z$="" THEN 445 ELSE IF Z$="SA" OR Z$="sa" THEN 436
  199. 440  LZ$=LEFT$(Z$,1):IF LZ$="C" OR LZ$="c" THEN J=VAL(MID$(Z$,2)):IF J>0 AND J<=B THEN 442
  200. 441  PRINT"Sorry. Try again.":GOTO 438
  201. 442  PRINT"For row "MID$(STR$(J),2)", enter VARIABLE # (1-"MID$(STR$(A),2)") & new VALUE (Free Format) ";:INPUT X$:IF X$="" THEN 442 ELSE Q=J:I=J:Q(0)=1:M=2:GOSUB 50:J=Q:Q(0)=0:M=A
  202. 443  IF Q(1)<1 OR Q(1)>A THEN 441 ELSE X(J,Q(1))=Q(2):PRINT"Row"J"now =";:FOR I=1 TO A:PRINT X(J,I);:NEXT I:PRINT:GOTO 438
  203. 444  '<UNK! {000A}>--- Print Data? ---
  204. 445  DO$="print data":GOSUB 20:IF Z$="N" THEN 448 ELSE GOSUB 162:GOSUB 165:IF VN$<>"Y" THEN PRINT #2,"Columns are not named." ELSE FOR I=1 TO A:PRINT #2,"Col"I"= "VN$(I)"  ";:NEXT I:PRINT #2,
  205. 446  PRINT #2,:PRINT #2,"Data used:":FOR J=1 TO B:PRINT #2,USING "Row##: ";J;:FOR I=1 TO A:PRINT #2,X(J,I);:NEXT I:PRINT #2,:NEXT J:PRINT #2,:GOSUB 160
  206. 447  '<UNK! {000A}>--- Range Check ---
  207. 448  QB=3:PRINT:DO$="check EQUALITY of COLUMN DISPERSIONS"::GOSUB 20:IF Z$="N" THEN 474
  208. 449  GOSUB 43:FOR I=1 TO A:SM(I)=X(1,I):GR(I)=SM(I):FOR J=2 TO B:IF X(J,I)<SM(I) THEN SM(I)=X(J,I) ELSE IF X(J,I)>GR(I) THEN GR(I)=X(J,I)
  209. 450  NEXT J:NEXT I:SM=SM(1):FOR I=2 TO A:IF SM(I)<SM THEN SM=SM(I)
  210. 451  NEXT I:QC=SGN(SM)
  211. 452  CLS:GOSUB 160
  212. 453  F1$="#####.#":F2$="####.##":F3$="###.###":BB=0.434294
  213. 454  PRINT #2,SPACE$(18)"RANGE CHECK OF COLUMN DISPERSIONS"CHR$(10)CHR$(10)SPACE$(12)"Range in Column":PRINT #2,"Transform";
  214. 455  FOR I=1 TO A:PRINT #2,"   #";USING "## ";I;:NEXT I:PRINT #2,
  215. 456  PRINT #2,STRING$(8,"-");:FOR I=1 TO A:PRINT #2,STRING$(7,"-");:NEXT I:PRINT #2,
  216. 457  PRINT #2,"NONE    ";:FOR I=1 TO A:R(I)=GR(I)-SM(I):PRINT #2,USING F1$;R(I);:NEXT I:K=1:GOSUB 350
  217. 458  IF QC=-1 THEN PRINT #2,"Negative data value(s) preclude variance-stabilizing transforms.";:GOTO 465
  218. 459  PRINT #2,"SQRT    ";:FOR I=1 TO A:R(I)=SQR(GR(I))-SQR(SM(I)):PRINT #2,USING F2$;R(I);:NEXT I:K=2:GOSUB 350
  219. 460  IF QC=0 THEN 463
  220. 461  PRINT #2,"LOG     ";:FOR I=1 TO A:R(I)=BB*(LOG(GR(I))-LOG(SM(I))):PRINT #2,USING F3$;R(I);:NEXT I:K=3:GOSUB 350
  221. 462  PRINT #2,"RECI    ";:FOR I=1 TO A:R(I)=1/SM(I)-1/GR(I):PRINT #2,USING F3$;R(I);:NEXT I:K=4:GOSUB 350:GOTO 465
  222. 463  PRINT #2,"LOG+    ";:FOR I=1 TO A:R(I)=BB*(LOG(GR(I)+1)-LOG(SM(I)+1)):PRINT #2,USING F3$;R(I);:NEXT I:K=3:GOSUB 350
  223. 464  PRINT #2,"REC+    ";:FOR I=1 TO A:R(I)=1/(SM(I)+1)-1/(GR(I)+1):PRINT #2,USING F3$;R(I);:NEXT I:K=4:GOSUB 350
  224. 465  PRINT #2,:PRINT #2,:PRINT #2,"Using          RANGE RATIOS   (See BTS 31c, with k ="A"& n = "MID$(STR$(B),2)")"
  225. 466  PRINT #2,STRING$(63,"-")
  226. 467  PRINT #2,USING "ORIGINAL X    "+F$;RR(1):IF QC<0 THEN 471
  227. 468  PRINT #2,USING "SQRT(X) "+S$+F$;RR(2)
  228. 469  IF QC=1 THEN PRINT #2,USING "LOG(X)  "+S$+F$;RR(3):PRINT #2,USING "100/X   "+S$+F$;RR(4):GOTO 471
  229. 470  IF QC=0 THEN PRINT #2,USING"LOG(X+1)"+S$+F$;RR(3):PRINT #2,USING "100/(X+1)     "+F$;RR(4)
  230. 471  IF PR=0 THEN GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 454
  231. 472  IF PR=1 THEN PRINT #2,:GOSUB 160
  232. 473  '<UNK! {000A}>--- Transform? ---
  233. 474  IF T%=0 THEN DO$="transform all the data":GOSUB 20
  234. 475  IF Z$="Y" THEN GOSUB 250:IF T%<10 THEN DO$="re-view or print that transformed data":GOSUB 20:IF Z$="Y" THEN 436
  235. 476  '<UNK! {000A}>--- Calc  (A = M = # cols.   B = N = # rows) ---
  236. 477  GOSUB 43:FOR I=1 TO A:S(I)=0:FOR J=1 TO B:A(I)=A(I)+X(J,I):S(I)=S(I)+X(J,I)*X(J,I):NEXT J:AM(I)=A(I)/B:S2=S2+S(I):S(I)=(S(I)-A(I)*AM(I))/(B-1):S3=S3+A(I)*A(I):T=T+A(I):NEXT I
  237. 478  FOR J=1 TO B:FOR I=1 TO A:B(J)=B(J)+X(J,I):NEXT I:BM(J)=B(J)/A:S4=S4+B(J)*B(J):NEXT J
  238. 479  N=A*B:TM=T/N:S1=T/N*T:S3=S3/B:S4=S4/A:DA=A-1:DB=B-1:DT=N-1:DE=DT-DA-DB:SA=S3-S1:SB=S4-S1:ST=S2-S1:SE=ST-SA-SB:VA=SA/DA:VB=SB/DB:VE=SE/DE:VT=ST/DT
  239. 480  E1=(SA-DA*VE)/(SA+SE):E2=-(E1>0)*SQR(ABS(E1)):E1=-(E1>0)*E1:E3=(SB-DB*VE)/(SB+SE):E4=-(E3>0)*SQR(ABS(E3)):E3=-(E3>0)*E3
  240. 481  '<UNK! {000A}>--- Tukey's Non-additivity Test ---
  241. 482  S=0:FOR I=1 TO A-1:AL(I)=AM(I)-TM:S=S+AL(I):S5=S5+AL(I)*AL(I):NEXT I:AL(A)=-S:S5=S5+S*S:S=0:FOR J=1 TO B-1:BE(J)=BM(J)-TM:S=S+BE(J):S6=S6+BE(J)*BE(J):NEXT J
  242. 483  BE(B)=-S:S6=S6+S*S:FOR J=1 TO B:FOR I=1 TO A:TU(J)=TU(J)+X(J,I)*AL(I):NEXT I:NEXT J
  243. 484  S=0:FOR J=1 TO B:S=S+TU(J)*BE(J):NEXT J:SN=S*S/S5/S6:SR=SE-SN:DR=DE-1:VR=SR/DR
  244. 485  '<UNK! {000A}>--- Box's M ---
  245. 486  IF A<3 OR B<A THEN 500
  246. 487  FOR I=1 TO B:FOR J=1 TO A:FOR K=J TO A:D(J,K)=D(J,K)+X(I,J)*X(I,K):NEXT K:NEXT J:NEXT I
  247. 488  FOR J=1 TO A:FOR K=J TO A:D(J,K)=(D(J,K)-A(J)*AM(K))/(B-1):D(K,J)=D(J,K):C(J,K)=D(J,K):C(K,J)=C(J,K):NEXT K:NEXT J:M=A:GOSUB 360:D1=D
  248. 489  IF D1<=0 THEN 495 ELSE FOR I=1 TO M:DIAG=DIAG+D(I,I):NEXT I:DIAG=DIAG/M
  249. 490  FOR I=1 TO M-1:FOR J=I+1 TO M:ODIAG=ODIAG+D(I,J):NEXT J:NEXT I:ODIAG=ODIAG/(M*(M-1)/2)
  250. 491  FOR I=1 TO M:FOR J=1 TO M:IF I=J THEN C(I,I)=DIAG:D(I,I)=DIAG ELSE C(I,J)=ODIAG:D(I,J)=ODIAG
  251. 492  NEXT J:NEXT I:GOSUB 360:D2=D
  252. 493  BM=(1-B)*LOG(D1/D2):BC=(A*(A+1)^2*(2*A-3))/(6*(B-1)*(A-1)*(A^2+A-4)):BC=(1-BC)*BM:BD=(A^2+A-4)/2
  253. 494  '<UNK! {000A}>--- Hotelling's T Squared ---
  254. 495  N=B:M=A-1:FOR I=1 TO N:FOR J=1 TO M:X(I,J)=X(I,J)-X(I,J+1):NEXT J:NEXT I:FOR J=1 TO M:FOR K=J TO M:D(J,K)=0:NEXT K:NEXT J
  255. 496  FOR I=1 TO N:FOR J=1 TO M:CM(J)=CM(J)+X(I,J):FOR K=J TO M:D(J,K)=D(J,K)+X(I,J)*X(I,K):NEXT K:NEXT J:NEXT I
  256. 497  FOR J=1 TO M:FOR K=J TO M:D(J,K)=(D(J,K)-CM(J)/N*CM(K))/(N-1):D(K,J)=D(J,K):C(J,K)=D(J,K):C(K,J)=C(J,K):NEXT K:NEXT J:FOR J=1 TO M:CM(J)=CM(J)/N:NEXT J:GOSUB 360:IF D=0 THEN 500
  257. 498  FOR J=1 TO M:X(1,J)=0:FOR K=1 TO M:X(1,J)=X(1,J)+CM(K)*C(K,J):NEXT K:NEXT J:FOR J=1 TO M:HOT=HOT+X(1,J)*CM(J):NEXT J:HOT=HOT*N:HF=HOT*(N-M)/(N-1)/M
  258. 499  '          df for Hot's F = M, N-M<UNK! {000A}><UNK! {000A}>--- Show Results ---
  259. 500  CLS:PRINT SPACE$(15)HD$:PRINT STRING$(79,"-"):F3$=" ######.###":F4$=" ###":GOSUB 160
  260. 501  IF SA>1 THEN F2$=" ######.##" ELSE F2$=" ###.#####"
  261. 502  PRINT #2,:PRINT #2,"DATA SUMMARY";:IF T%>0 AND T%<10 THEN PRINT #2,S$"Transform = "T$(T%);
  262. 503  PRINT #2,S$;"Rows ="B;S$"Columns ="A:PRINT #2,:IF QD=1 THEN IF VN$="Y" THEN PRINT #2,"Columns are:":FOR I=1 TO A:PRINT #2,"#"USING"##=\        \  ";I;VN$(I);:NEXT I:PRINT #2,:PRINT #2,
  263. 504  F$="##=#####.###   ":PRINT #2,USING"Grand Mean =#####.###";TM:PRINT #2,:PRINT #2,"Row Means:":FOR J=1 TO B:PRINT #2,"#"USING F$;J;BM(J);:NEXT J:PRINT #2,:PRINT #2,"Col Means:":FOR I=1 TO A:PRINT #2,"#"USING F$;I;AM(I);:NEXT I:PRINT #2,
  264. 505  PRINT#2,:PRINT #2,"Col Variances:":FOR I=1 TO A:PRINT #2,"#"USING F$;I;S(I);:NEXT I:PRINT #2,:IF PR=0 THEN GOSUB 5:CLS ELSE PRINT #2,:PRINT #2,
  265. 506  PRINT #2,"2-Way ANOVA assumes EQUAL CORRELATIONS between all pairs of TREATMENTS."
  266. 507  IF A<3 OR B<A OR D1<=0 THEN 508 ELSE 511
  267. 508  PRINT #2,"However, Box's Test for Equal Correlations cannot be done in the present case":PRINT #2,"because ";
  268. 509  IF A<3 THEN PRINT #2,"there are only 2 columns." ELSE IF B<A THEN PRINT #2,"there are more columns than rows." ELSE IF D1<=0 THEN PRINT #2,"the dispersion matrix has DET <= 0."
  269. 510  PRINT #2,:GOTO 513
  270. 511  PRINT #2,:PRINT #2,"Box's Test for Equal Correlations (Compound Symmetry):"
  271. 512  PRINT #2,USING"   Det (DMAT)     = #.####^^^^";D1:PRINT #2,USING"   Det (Ave DMAT) = #.####^^^^";D2:PRINT #2,USING"   Box's M =#####.##";BM:PRINT #2,USING"   Chi-Sq  =#####.##       d.f.=###";BC;BD
  272. 513  GOSUB 5:IF PR=0 THEN CLS ELSE PRINT #2,:PRINT #2,
  273. 514  PRINT #2,SPACE$(12)"ANOVA TABLE  (assumes equal correlations)":PRINT #2,STRING$(63,"-")
  274. 515  PRINT #2,"   Source"SPACE$(11)"SS"SPACE$(7)"df"SPACE$(6)"MS"SPACE$(6)"Variance ratio":PRINT #2,STRING$(63,"-"):PRINT #2,"Betw Columns  ";USING F2$+"   "+F4$+F2$;SA;DA;VA;
  275. 516  PRINT #2,"    F("MID$(STR$(DA),2)","MID$(STR$(DE),2)") =";USING"#####.##";VA/VE
  276. 517  IF SB>1 THEN F2$=" ######.##" ELSE F2$=" ###.#####"
  277. 518  PRINT #2,"Betw Rows     "USING F2$+"   "+F4$+F2$;SB;DB;VB;:PRINT #2,"    F("MID$(STR$(DB),2)","MID$(STR$(DE),2)") ="USING"#####.##";VB/VE:IF SE>1 THEN F2$=" ######.##" ELSE F2$=" ###.#####"
  278. 519  PRINT #2,"Residual Error"USING F2$+"   "+F4$+F2$;SE;DE;VE
  279. 520  PRINT #2,"   Tukey's":PRINT #2,"Non-Additivity";USING F2$+"   "+F4$+F2$;SN;1;SN;:PRINT #2,"    F(1,"MID$(STR$(DR),2)") =";USING"#####.##";SN/VR
  280. 521  PRINT #2,"   Remainder  "USING F2$+"   "+F4$+F2$;SR;DR;VR:PRINT #2,STRING$(63,"-")
  281. 522  PRINT #2,USING"Total"+SPACE$(9)+F2$+"   "+F4$+F2$;ST;DT;VT:PRINT #2,STRING$(63,"-")
  282. 523  PRINT #2,USING"Betw COLS Kelley's Epsilon SQ =####.###,  Epsilon = ###.###";E1;E2
  283. 524  PRINT #2,USING"Betw ROWS Kelley's Epsilon SQ =####.###,  Epsilon = ###.###";E3;E4:PRINT #2,
  284. 525  GOSUB 5:IF PR=0 THEN CLS ELSE PRINT #2,
  285. 526  PRINT #2,"MULTIVARIATE ANOVA  (doesn't assume equal correlations)":PRINT #2,STRING$(18,"-"):PRINT #2,
  286. 527  IF A<3 THEN PRINT #2,"....Can't be done with only 2 columns.":GOTO 539 ELSE IF B<A THEN PRINT #2,"....Can't be done since more columns than rows.":GOTO 539
  287. 528  PRINT #2,"TESTING EQUALITY OF COLUMN MEANS:":PRINT #2,"     Hotelling's T-Squared =";USING"#####.###";HOT
  288. 529  PRINT #2,"     F ("MID$(STR$(M),2)","MID$(STR$(N-M),2)") =";:PRINT #2,USING"#####.##";HF:PRINT #2,:PRINT #2,USING"     Det (CMAT) = #.####^^^^";D
  289. 530  IF PR=0 THEN PRINT #2,:PRINT #2,:PRINT #2,"Do you want to see Means & Dispersion Matrix of CHANGE SCORES,":PRINT #2,"for further analyses of columns";:GOSUB 21:IF Z$="Y" THEN ZC=1:CLS
  290. 531  IF ZC=0 THEN 539
  291. 532  PRINT #2,:PRINT #2,:PRINT #2,"CHANGE SCORE MEANS:":FOR I=1 TO M:PRINT #2,"#";USING F$;I;CM(I);:NEXT I:PRINT #2,:L=2:MM=M:AD=ABS(D(1,1))
  292. 533  IF AD<10 THEN FF$="####.##### " ELSE IF AD<1000 THEN FF$="#####.#### " ELSE FF$="########.# "
  293. 534  PRINT #2,:PRINT #2,"CHANGE SCORE DMAT:":FOR I=1 TO MM:PRINT #2,USING"Row##: ";I;:IF MM>5 THEN M=5 ELSE M=MM
  294. 535  FOR J=1 TO M:PRINT #2,USING FF$;D(I,J);:NEXT J:PRINT #2,:GOSUB 538
  295. 536  IF MM>5 THEN PRINT #2,SPACE$(7);:FOR J=6 TO MM:PRINT #2,USING FF$;D(I,J);:NEXT J:PRINT #2,:GOSUB 538
  296. 537  NEXT I:GOTO 539
  297. 538  IF PR=1 THEN RETURN ELSE L=L+1:IF L<16 THEN RETURN ELSE GOSUB 5:L=1:RETURN
  298. 539  IF PR=0 THEN GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 501
  299. 540  GOSUB 160:GOTO 10
  300. 541  ' end
  301.