home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / anovr.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1989-11-11  |  18.3 KB  |  296 lines
  1. 1  '      2-WAY ANOVA, REPLICATED  ---  ANOVR.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 400,177,447,10 :STOP  '=start,printout,etc - CLOSE (exc 177)<UNK! {000A}><UNK! {000A}>--- Another go? ---
  8. 10  CLOSE: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. 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
  25. 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.
  26. 50  K=1:L=M
  27. 51  KX=0:FOR J=K TO L:Y$=SPACE$(10):KY=0
  28. 52  KX=KX+1:IF KX>LEN(X$) THEN IF J=L THEN 54 ELSE 57
  29. 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
  30. 54  IF Q(0) THEN Q(J)=VAL(Y$) ELSE X(I,J)=VAL(Y$)
  31. 55  NEXT J:IF KX>=LEN(X$) THEN 60
  32. 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
  33. 57  PLAY"L32O4CEG>C":PRINT"Not enough values in the line above.  Please re-do whole line.":GOTO 59
  34. 58  PLAY"L16O3CEL4>B":PRINT"That line contains a `non-numeric' entry.  Please re-do whole line."
  35. 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
  36. 60  RETURN
  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.  Also ZZ$="UTOK" if UT is acceptable.
  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 AND ZZ$<>"UTOK" 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>MXV 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  '   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  '
  58. 92  IF NEEDVARS=1 THEN PRINT"This test analyses only 1 column variable at a time.":ND=M-1
  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:KL=J
  64. 98  NEXT J
  65. 99  ' ********  Now read data values from disk
  66. 100  COLOR 23,0:PRINT"Loading numbers";:COLOR 7,0:DIM XX(N,M):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 XX(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:ERASE XX:SHELL "DIR "+DR$+"/W":GOSUB 5
  88. 138  DIM XX(MXR,1)
  89. 139  GOTO 110
  90. 159  '<UNK! {000A}>--- Show/Print Answers ---
  91. 160  PR=0:CLOSE:OPEN "SCRN:" FOR OUTPUT AS #2:QB=-(QB<>2)*QB-(QB=2)*QBB: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  QBB=QB: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: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 I=1 TO AB:FOR K=1 TO N(I):ON T% GOTO 256,255,259,258,261,260,263,262,264
  123. 255  X(I,K)=X(I,K)/100
  124. 256  IF X(I,K)>P9 THEN X(I,K)=P9 ELSE IF X(I,K)<0 THEN 266
  125. 257  X(I,K)=SQR(X(I,K)):X(I,K)=AA*ATN(X(I,K)/SQR(1-X(I,K)*X(I,K))):GOTO 265
  126. 258  X(I,K)=X(I,K)+1
  127. 259  IF X(I,K)>0 THEN X(I,K)=BB*LOG(X(I,K)):GOTO 265 ELSE 266
  128. 260  X(I,K)=X(I,K)+1
  129. 261  IF X(I,K)<>0 THEN X(I,K)=100/X(I,K):GOTO 265 ELSE 266
  130. 262  X(I,K)=X(I,K)+P5
  131. 263  IF X(I,K)>=0 THEN X(I,K)=SQR(X(I,K)):GOTO 265 ELSE 266
  132. 264  X(I,K)=X(I,K)*X(I,K)
  133. 265  NEXT K:NEXT I: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"1+INT(I/A)", Col"I-INT(I/A)", Replicate #"K: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}>*** Special Anova Subs ***
  139. 350  IF OP=1 THEN 362 ELSE R(I)=(R(I)/Y(I))^2:GOTO 362
  140. 360  SM=R(1):GR=SM:FOR I=2 TO AB:IF R(I)<SM THEN SM=R(I) ELSE IF R(I)>GR THEN GR=R(I)
  141. 361  NEXT I:IF SM<>0 THEN RR(K)=GR/SM ELSE PRINT #2,:PRINT #2,"Check aborted because one cell has NO VARIATION."
  142. 362  RETURN
  143. 370  FOR L=1 TO LEN(X$):Z$=MID$(X$,L,1):IF INSTR("-.0123456789",Z$) THEN 372
  144. 371  PLAY"L16O3CEL4>B":PRINT"That contains a `non-numeric' entry.  Please re-do.":INPUT X$:GOTO 370
  145. 372  NEXT L:RETURN
  146. 399  '<UNK! {000A}>--- Start ---
  147. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  148. 401  DEFINT I-N,Q:MXR=10:MXC=10:MXV=400:NEEDVARS=1
  149. 402  DIM I,J,K,L,M,N,QP,Z,X$,Y$,Z$,A,B,AB,SM,T,TM,S1,S2,S3,S4,S5,S6
  150. 403  DIM VN$(MXC),Q(MXC),T$(10),KIND$(3),E$(3)
  151. 404  HD$=" 2 - W A Y   A N O V A,   R e p l i c a t e d ":VER$="(RL,2)"
  152. 405  P5=0.5:S$=SPACE$(6):F$="#####.###"
  153. 406  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)
  154. 407  AT$="ANOVA TABLE  ":KIND$(1)="(EQUAL REPLICATIONS)":KIND$(2)="(WEIGHTED MEANS ANALYSIS)":KIND$(3)="(UNWEIGHTED MEANS ANALYSIS)"
  155. 408  QB=1:CLOSE:CLS:GOSUB 340:PRINT DAT$;TAB(40-LEN(HD$)\2);:COLOR 0,7:PRINT HD$;:COLOR 7,0:PRINT TAB(73)VER$:LOCATE 3,1,0:K=12
  156. 409  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  157. 410  PRINT TAB(K)"OPEN                                                       OPEN"
  158. 411  PRINT TAB(K)"OPEN       This program analyses Factorial Designs.        OPEN"
  159. 412  PRINT TAB(K)"OPEN    It compares MEANS of 2-10 ROWS and 2-10 COLS of    OPEN"
  160. 413  PRINT TAB(K)"OPEN    measurements, & tests for Row x Col INTERACTION.   OPEN"
  161. 414  PRINT TAB(K)"OPEN    Each CELL at Row and Col intersections can have    OPEN"
  162. 415  PRINT TAB(K)"OPEN      2-50 independently replicated measurements.      OPEN"
  163. 416  PRINT TAB(K)"OPEN         Total # of values mustn't exceed 400.         OPEN"
  164. 417  PRINT TAB(K)"OPEN       Data can come from keyboard or disk file.       OPEN"
  165. 418  PRINT TAB(K)"OPEN     Features vetted Free Format entry for numbers.    OPEN"
  166. 419  PRINT TAB(K)"OPEN     Simple editing & data transforms can be done.     OPEN"
  167. 420  PRINT TAB(K)"OPEN       Printouts available after viewing answers.      OPEN"
  168. 421  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  169. 422  PRINT TAB(K)"OPEN                                                       OPEN"
  170. 423  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
  171. 424  PRINT:PRINT"Options:   1.  Equal # of replicates in each cell.<UNK! {000A}>"TAB(K)"2.  Weighted   Means Analysis for Unequal replicates.<UNK! {000A}>"TAB(K)"3.  Unweighted Means Analysis for Unequal replicates.<UNK! {000A}>"TAB(K)"4.  Return to Main Menu."
  172. 425  LOCATE ,,1:PRINT
  173. 426  INPUT"===>  Which do you want (1-4) ";OP:IF OP<1 OR OP>4 THEN BEEP:GOTO 426  ELSE IF OP=4 THEN 30
  174. 427  '<UNK! {000A}>--- Get Data ---<UNK! {000A}> Note: X(I,J) with B rows & A cols, I=1 to AB cells, J=1 to N(I) reps/cell.
  175. 428  DO$="enter data from disk":GOSUB 20:PRINT:IF Z$="Y" THEN 458
  176. 429  '<UNK! {000A}>--- K/b Entry ---
  177. 430  '    Get Datatable Sizes
  178. 431  INPUT"No. of Row Levels (2-20) ";X$:B=VAL(X$):IF B<2 OR B>MXR THEN 431
  179. 432  INPUT"No. of Column Levels (2-10) ";X$:A=VAL(X$):IF A<2 OR A>MXC THEN 432
  180. 433  AB=A*B:DIM N(AB)  'to hold reps/cell
  181. 434  IF OP>1 THEN 437 INPUT"No. of Replicates per Cell (2-50) ";R:IF R<2 OR R>50 THEN 434
  182. 435  INPUT"No. of Replicates per Cell (2-50) ";X$:R=VAL(X$):IF R<2 OR R>50 THEN 435
  183. 436  N2=AB*R:IF N2>MXV THEN BEEP:PRINT "Exceeds max"MXV"measurements!":GOSUB 5:GOTO 400 ELSE N=N2:FOR I=1 TO AB:N(I)=R:NEXT I:GOTO 442
  184. 437  FOR J=1 TO B:FOR I=1 TO A
  185. 438  PRINT"No. of Replicates in Row"J", Col"I;:INPUT X$:R=VAL(X$):IF R<2 OR R>50 THEN BEEP:PRINT"No, must be 2-50.":GOTO 438
  186. 439  IF QD=1 AND N2+R>N THEN PRINT"Oops, too many!  Try again.":GOTO 438
  187. 440  N2=N2+R:N((J-1)*A+I)=R:IF R>GR THEN GR=R
  188. 441  NEXT I:NEXT J:R=GR:N=N2
  189. 442  DIM X(AB,R),NI(A),NJ(B),A(A),AM(A),B(B),BM(B),C(AB),CM(AB),GR(AB),SM(AB),R(AB),Y(AB),V(AB),AP(A),BP(B):IF QD=1 THEN RETURN
  190. 443  '<UNK! {000A}>--- Enter Data ---
  191. 444  PRINT:PRINT"Enter Measurements by Cells, with 1 Measurement per Line:":K=0
  192. 445  FOR J=1 TO B:FOR I=1 TO A:PRINT"Cell at Row"J", Col"I":":FOR K=1 TO N((J-1)*A+I):PRINT"#"K;:INPUT X$:GOSUB 370:X((J-1)*A+I,K)=VAL(X$):NEXT K:NEXT I:NEXT J:IF OP>1 THEN N=N2
  193. 446  '<UNK! {000A}>--- Show Data ---
  194. 447  QB=3:CLOSE:CLS:PRINT"DATA READ WAS:"
  195. 448  FOR J=1 TO B:FOR I=1 TO A:PRINT:PRINT"Row "MID$(STR$(J),2)", Col "MID$(STR$(I),2)":"
  196. 449  FOR K=1 TO N((J-1)*A+I):PRINT X((J-1)*A+I,K)"  ";:NEXT K:PRINT
  197. 450  '<UNK! {000A}>--- Edit ---
  198. 451  INPUT"Edit (C#=Change Datum #, SA=Show All, N=None)";Z$:IF Z$="" OR Z$="N" OR Z$="n" THEN 455
  199. 452  IF Z$="SA" OR Z$="sa" THEN 447 ELSE IF LEFT$(Z$,1)="C" OR LEFT$(Z$,1)="c" THEN Z=VAL(MID$(Z$,2)):IF Z>0 AND Z<=N((J-1)*A+I) THEN PRINT"#"Z"="X((J-1)*A+I,Z):GOTO 454
  200. 453  PRINT"SILLY.   ";:GOTO 451
  201. 454  PRINT"Right Value ";:INPUT X$:IF X$="" THEN 454 ELSE X((J-1)*A+I,Z)=VAL(X$):PRINT"Row "MID$(STR$(J),2)", Col "MID$(STR$(I),2)" is now:":GOTO 449
  202. 455  LOCATE CSRLIN-1,1:PRINT SPACE$(60);:LOCATE ,1
  203. 456  NEXT I:NEXT J:GOTO 462
  204. 457  '<UNK! {000A}>--- Disk Entry ---
  205. 458  QD=1:MNR=2:MNC=1:GOSUB 80:GOSUB 431
  206. 459  K=0:FOR I=1 TO AB:FOR J=1 TO N(I):K=K+1:X(I,J)=XX(K,1):NEXT J:NEXT I
  207. 460  GOTO 447
  208. 461  '<UNK! {000A}>--- Print Data ---
  209. 462  DO$="print this data":GOSUB 20:IF Z$="N" THEN 467 ELSE GOSUB 162:GOSUB 165:IF VN$<>"Y"THEN PRINT #2,"Variable not named." ELSE PRINT #2,"Variable #"KL"= "VN$(KL)"."
  210. 463  PRINT #2,:IF T%=0 OR T%=10 THEN PRINT #2,"DATA:" ELSE PRINT #2,"DATA, with Transform ="T$(T%)"."
  211. 464  FOR J=1 TO B:FOR I=1 TO A:PRINT #2,:PRINT #2,"Row "MID$(STR$(J),2)", Col "MID$(STR$(I),2)":":FOR K=1 TO N((J-1)*A+I):PRINT #2,X((J-1)*A+I,K);:NEXT K:PRINT #2,:NEXT I:NEXT J:PRINT #2,:GOSUB 160
  212. 465  IF T%>0 THEN 505
  213. 466  '<UNK! {000A}>--- Range Check ---
  214. 467  DO$="check EQUALITY of CELL DISPERSIONS":GOSUB 20:IF Z$="N" THEN 502
  215. 468  GOSUB 43:FOR I=1 TO AB:SM(I)=X(I,1):GR(I)=SM(I):FOR J=2 TO N(I):IF X(I,J)<SM(I) THEN SM(I)=X(I,J) ELSE IF X(I,J)>GR(I) THEN GR(I)=X(I,J)
  216. 469  NEXT J:NEXT I:SM=SM(1):FOR I=2 TO AB:IF SM(I)<SM THEN SM=SM(I)
  217. 470  NEXT I:QC=SGN(SM)
  218. 471  IF OP=1 THEN 476 ELSE CLS:PRINT"Cells have UNEQUAL REPLICATES, so enter d(n) values from BTS 27:":PRINT"d("MID$(STR$(N(1)),2)")";:INPUT Y(1)
  219. 472  FOR I=2 TO AB:FOR J=1 TO I-1:IF N(I)=N(J) THEN Y(I)=Y(J):J=I:FLAG=1
  220. 473  NEXT J:IF FLAG=1 THEN FLAG=0:GOTO 475
  221. 474  PRINT"d("MID$(STR$(N(I)),2)")";:INPUT Y(I)
  222. 475  NEXT I
  223. 476  CLS:GOSUB 160
  224. 477  F1$="#####.#":F2$="####.##":F3$="###.###":BB=0.434294
  225. 478  IF OP=1 THEN PRINT #2,SPACE$(18)"RANGE CHECK OF CELL DISPERSIONS":PRINT #2,:PRINT #2,SPACE$(12)"Range in Cell":PRINT #2,"Transform";
  226. 479  IF OP>1 THEN PRINT #2,SPACE$(24)"HARTLEY'S MAX F RATIOS":PRINT #2,:PRINT #2,SPACE$(12)"Approx Variance of Cell":PRINT #2,"Transform";
  227. 480  FOR I=1 TO AB:PRINT #2,"   #";USING"## ";I;:NEXT I:PRINT #2,
  228. 481  PRINT #2,STRING$(8,"-");:FOR I=1 TO AB:PRINT #2,STRING$(7,"-");:NEXT I:PRINT #2,
  229. 482  PRINT #2,"NONE    ";:FOR I=1 TO AB:R(I)=GR(I)-SM(I):GOSUB 350:PRINT #2,USING F1$;R(I);:NEXT I:K=1:GOSUB 360:PRINT #2,
  230. 483  IF SM=0 THEN 499
  231. 484  IF QC=-1 THEN PRINT #2,"Negative data value(s) preclude Variance-Stabilizing Transforms.":GOTO 499
  232. 485  PRINT #2,"SQRT    ";:FOR I=1 TO AB:R(I)=SQR(GR(I))-SQR(SM(I)):GOSUB 350:PRINT #2,USING F2$;R(I);:NEXT I:K=2:GOSUB 360
  233. 486  IF QC=0 THEN 489
  234. 487  PRINT #2,:PRINT #2,"LOG     ";:FOR I=1 TO AB:R(I)=BB*(LOG(GR(I))-LOG(SM(I))):GOSUB 350:PRINT #2,USING F3$;R(I);:NEXT I:K=3:GOSUB 360
  235. 488  PRINT #2,:PRINT #2,"RECI    ";:FOR I=1 TO AB:R(I)=1/SM(I)-1/GR(I):GOSUB 350:PRINT #2,USING F3$;R(I);:NEXT I:K=4:GOSUB 360:GOTO 491
  236. 489  PRINT #2,:PRINT #2,"LOG+    ";:FOR I=1 TO AB:R(I)=BB*(LOG(GR(I)+1)-LOG(SM(I)+1)):GOSUB 350:PRINT #2,USING F3$;R(I);:NEXT:K=3:GOSUB 360
  237. 490  PRINT #2,:PRINT #2,"REC+    ";:FOR I=1 TO AB:R(I)=1/(SM(I)+1)-1/(GR(I)+1):GOSUB 350:PRINT #2,USING F3$;R(I);:NEXT I:K=4:GOSUB 360
  238. 491  PRINT #2,:PRINT #2,:PRINT #2,
  239. 492  IF OP=1 THEN PRINT #2,"Using          RANGE RATIOS   (See BTS 31c, with k ="AB"& n = "MID$(STR$(N(1)),2)")"
  240. 493  IF OP>1 THEN PRINT #2,"Using          MAX F RATIOS   (See BTS 31, with k ="AB"& nu = "MID$(STR$(INT(N/AB+P5)-1),2)")"
  241. 494  PRINT #2,STRING$(63,"-")
  242. 495  PRINT #2,USING"ORIGINAL X    "+F$;RR(1):IF QC<0 THEN 499
  243. 496  PRINT #2,USING"SQRT(X) "+S$+F$;RR(2)
  244. 497  IF QC=1 THEN PRINT #2,USING"LOG(X)  "+S$+F$;RR(3):PRINT #2,USING"100/X   "+S$+F$;RR(4):GOTO 499
  245. 498  IF QC=0 THEN PRINT #2,USING"LOG(X+1)"+S$+F$;RR(3):PRINT #2,USING"100/(X+1)     "+F$;RR(4)
  246. 499  IF PR=0 THEN GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 478
  247. 500  IF PR=0 THEN GOSUB 160
  248. 501  '<UNK! {000A}>--- Transform? ---
  249. 502  IF T%>0 THEN 505 ELSE DO$="transform all the data":GOSUB 20
  250. 503  IF Z$="Y" THEN GOSUB 250:IF T%<10 THEN DO$="re-view or print that transformed data":GOSUB 20:IF Z$="Y" THEN CLS:PRINT"TRANSFORMED DATA:":GOTO 448
  251. 504  '<UNK! {000A}>--- Calc (A = # cols,  B = # rows) ---
  252. 505  QB=4:CLOSE:GOSUB 43:FOR I=1 TO AB:FOR K=1 TO N(I):C(I)=C(I)+X(I,K):V(I)=V(I)+X(I,K)*X(I,K):NEXT K:CM(I)=C(I)/N(I):S2=S2+V(I):V(I)=(V(I)-C(I)*C(I)/N(I))/(N(I)-1):S5=S5+C(I)*C(I)/N(I):NEXT I
  253. 506  FOR I=1TO A:FOR J=I TO AB STEP A:A(I)=A(I)+C(J):NI(I)=NI(I)+N(J):NEXT J:NEXT I
  254. 507  K=0:FOR J=1TO B:FOR I=1TO A:B(J)=B(J)+C(I+K):NJ(J)=NJ(J)+N(I+K):NEXT I:K=K+A:NEXT J
  255. 508  FOR I=1TO A:T=T+A(I):AM(I)=A(I)/NI(I):S3=S3+A(I)*A(I)/NI(I):NEXT I:FOR J=1TO B:BM(J)=B(J)/NJ(J):S4=S4+B(J)*B(J)/NJ(J):NEXT J:TM=T/N:S1=T*T/N
  256. 509  DA=A-1:DB=B-1:DI=(A-1)*(B-1):DT=N-1:DE=DT-DA-DB-DI:IF OP=3 THEN 544
  257. 510  SA=S3-S1:SB=S4-S1:SE=S2-S5:ST=S2-S1:SI=ST-SA-SB-SE:VA=SA/DA:VB=SB/DB:VI=SI/DI:VE=SE/DE:VT=ST/DT
  258. 511  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:E5=(SI-DI*VE)/(SI+SE):E6=-(E5>0)*SQR(ABS(E5)):E5=-(E5>0)*E5
  259. 512  '<UNK! {000A}>--- Show Results ---
  260. 513  CLS:Z$=HD$:GOSUB 46:PRINT:GOSUB 160
  261. 514  F3$=" ######.###":F4$=" ###"
  262. 515  IF SA>1 THEN F2$=" ######.##" ELSE F2$=" ###.#####"
  263. 516  IF T%=0 OR T%=10 THEN PRINT #2,SPACE$(22)"DATA SUMMARY" ELSE PRINT #2,SPACE$(12)"DATA SUMMARY"S$"Transform = "T$(T%)
  264. 517  PRINT #2,:PRINT #2,"# of Row Levels ="B;S$"# of Column Levels ="A
  265. 518  F$="=#####.###   ":PRINT #2,:PRINT #2,"Cell Means:":FOR J=1 TO B:FOR I=1 TO A:PRINT #2,"R"MID$(STR$(J),2)",C"MID$(STR$(I),2);USING F$;CM((J-1)*A+I);:NEXT I:PRINT #2,:NEXT J:IF PR=1 THEN PRINT #2, ELSE GOSUB 5
  266. 519  PRINT #2,"Cell Variances:":FOR J=1 TO B:FOR I=1 TO A:PRINT #2,"R"MID$(STR$(J),2)",C"MID$(STR$(I),2);USING F$;V((J-1)*A+I);:NEXT I:PRINT #2,:NEXT J:IF PR=1 THEN PRINT #2, ELSE GOSUB 5
  267. 520  IF OP=3 THEN PRINT #2,"   Note:  The following are UNWEIGHTED means of cell means."
  268. 521  F$="##=#####.###   ":PRINT #2,"Row Means:":FOR J=1 TO B:PRINT #2,"#";USING F$;J;BM(J);:NEXT J:PRINT #2,:GOSUB 5
  269. 522  PRINT #2,"Col Means:":FOR I=1 TO A:PRINT #2,"#";USING F$;I;AM(I);:NEXT I:PRINT #2,:PRINT #2,:PRINT #2,USING"Grand Mean =#####.###";TM
  270. 523  IF OP=3 THEN PRINT #2,"Harmonic Mean # of Replicates =";HM
  271. 524  GOSUB 5:IF PR=0 THEN CLS ELSE PRINT #2,:PRINT #2,
  272. 525  V=VA/VE:PRINT #2,SPACE$(12)AT$;KIND$(OP):PRINT #2,STRING$(63,"-")
  273. 526  PRINT #2,"   Source"SPACE$(11)"SS"SPACE$(7)"df"S$"MS"S$"Variance Ratio":PRINT #2,STRING$(63,"-")
  274. 527  PRINT #2,"Betw Columns  ";USING F2$+"   "+F4$+F2$;SA;DA;VA;
  275. 528  PRINT #2,"    F("MID$(STR$(DA),2)","MID$(STR$(DE),2)") =";USING"#####.##";V
  276. 529  IF SB>1 THEN F2$=" ######.##" ELSE F2$=" ###.#####"
  277. 530  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
  278. 531  IF ABS(SI)>1 THEN F2$=" ######.##" ELSE F2$=" ###.#####"
  279. 532  PRINT #2,"Interaction   ";USING F2$+"   "+F4$+F2$;SI;DI;VI;:PRINT #2,"    F("MID$(STR$(DI),2)","MID$(STR$(DE),2)") =";USING"#####.##";VI/VE
  280. 533  IF SE>1 THEN F2$=" ######.##" ELSE F2$=" ###.#####"
  281. 534  PRINT #2,"Within Cells  ";USING F2$+"   "+F4$+F2$;SE;DE;VE
  282. 535  PRINT #2, STRING$(63,"-"):IF OP=3 THEN 538
  283. 536  PRINT #2,USING"Total"+SPACE$(9)+F2$+"   "+F4$+F2$;ST;DT;VT
  284. 537  PRINT #2, STRING$(63,"-")
  285. 538  PRINT #2,"   Note: Above F values are based on Within Cells MS.":IF OP=3 THEN 541
  286. 539  PRINT #2,:PRINT #2,USING"Betw Cols:  Kelley's Epsilon Sq =####.###,    Epsilon = ###.###";E1;E2:PRINT #2,USING"Betw Rows:  Kelley's Epsilon Sq =####.###,    Epsilon = ###.###";E3;E4
  287. 540  PRINT #2,USING"Interactn:  Kelley's Epsilon Sq =####.###,    Epsilon = ###.###";E5;E6
  288. 541  IF PR=0 THEN PRINT #2,:GOSUB 5:GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 515
  289. 542  GOSUB 160:GOTO 10
  290. 543  '<UNK! {000A}>--- Unweighted Means ---
  291. 544  FOR I=1 TO AB:HM=HM+1/N(I):NEXT I:HM=AB/HM:FOR J=1 TO B:FOR I=1 TO A:S6=S6+CM((J-1)*A+I)*CM((J-1)*A+I):AP(I)=AP(I)+CM((J-1)*A+I):BP(J)=BP(J)+CM((J-1)*A+I):NEXT I:TP=TP+BP(J):NEXT J
  292. 545  S3=0:FOR I=1 TO A:AM(I)=AP(I)/B:S3=S3+AP(I)*AP(I):NEXT I:S3=S3/B:S4=0:FOR J=1 TO B:BM(J)=BP(J)/A:S4=S4+BP(J)*BP(J):NEXT J
  293. 546  S4=S4/A:TM=TP/AB:S1=TP*TP/AB:SE=S2-S5:SA=HM*(S3-S1):SB=HM*(S4-S1):SI=HM*(S6-S3-S4+S1):IF SI<0THEN SI=0
  294. 547  VA=SA/DA:VB=SB/DB:VI=SI/DI:VE=SE/DE:GOTO 513
  295. 548  'end
  296.