home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / ancov.bas (.txt) next >
Encoding:
GW-BASIC  |  1989-09-02  |  20.6 KB  |  329 lines
  1. 1  '  ANCOVA & COMPARING REGRESSION LINES -- ANCOV.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 10,177,405,449:STOP  '=start,printout,etc - CLOSE (exc 177)<UNK! {000A}><UNK! {000A}>--- Another go? ---
  8. 10  CLOSE:IF HD$="" THEN LPRINT 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. 43  COLOR 23,0:PRINT"Working";:COLOR 7,0:RETURN
  21. 44  LOCATE,1:PRINT"Ok, done.";:GOTO 5
  22. 49  '<UNK! {000A}>--- Vetted Decoding of FF X(I,J) from X$ ---<UNK! {000A}>    Needs I, M, Q(0) from #96 or #256.
  23. 50  K=1:L=M
  24. 51  KX=0:FOR J=K TO L:Y$=SPACE$(10):KY=0
  25. 52  KX=KX+1:IF KX>LEN(X$) THEN IF J=L THEN 54 ELSE 57
  26. 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
  27. 54  IF Q(0) THEN Q(J)=VAL(Y$) ELSE X(I,J)=VAL(Y$)
  28. 55  NEXT J:IF KX>=LEN(X$) THEN 60
  29. 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
  30. 57  PLAY"L32O4CEG>C":PRINT"Not enough values in the line above.  Please re-do whole line.":GOTO 59
  31. 58  PLAY"L16O3CEL4>B":PRINT"That line contains a `non-numeric' entry.  Please re-do whole line."
  32. 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
  33. 60  RETURN
  34. 69  '<UNK! {000A}>*** K/b Input of all X(I,J) in FF ***<UNK! {000A}>    Needs first I, M, MXR.  Returns N.
  35. 70  'PRINT"Enter data from keyboard, ";:IF M=1 THEN PRINT "pressing <Enter> after each number.":GOTO 72
  36. 71  'PRINT"in Free Format, pressing <Enter> at end of each row.":IF UT>0 THEN 73
  37. 72  PRINT"Null entry duplicates previous row.  Signal `end-of-all-data' by entering a `/'.":PRINT
  38. 73  PRINT "Row"STR$(I);:INPUT X$: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
  39. 74  IF RIGHT$(X$,1)="/" THEN X$=LEFT$(X$,LEN(X$)-1):N=I+(X$=""):IF X$="" THEN 76
  40. 75  GOSUB 50:IF N=0 THEN IF I<MXR THEN I=I+1:GOTO 73 ELSE N=MXR
  41. 76  RETURN
  42. 79  '<UNK! {000A}>--- Disk Input of X(I,J), N, M, etc ---<UNK! {000A}>    Needs MNR, MNC, & NEEDVARS.
  43. 80  QD=1:IO$="I":GOSUB 110:CLS:PRINT "Loading data from disk.":INPUT #1,FL$,VR$
  44. 81  IF LEFT$(VR$,4)<>"(RL," THEN BEEP:PRINT "Unreadable file --- not made by our Data Filer/Editor program.":GOTO 86
  45. 82  INPUT #1,DT$,ID$,N,M,UT,VN$:PRINT "Filename: "FL$,"Made: "DT$,"Version: "VR$:PRINT"ID: "ID$:PRINT
  46. 83  IF UT>0 THEN IF ZZ$<>"UTOK" THEN PRINT "This file is an upper triangular matrix, which this program can't use!":GOTO 86
  47. 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
  48. 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
  49. 86  CLOSE:BEEP:GOSUB 5:ERROR 210
  50. 87  '   Select variables
  51. 88  PRINT:IF VN$="N" THEN PRINT "The"M"variables are not named.":GOTO 90
  52. 89  PRINT "Variables in file are:":FOR J=1 TO M:INPUT #1,VN$(J):PRINT J;VN$(J),:NEXT J:PRINT
  53. 90  IF M=MNC OR UT>0 THEN 100 ELSE PRINT
  54. 91  '
  55. 92  '
  56. 93  IF NEEDVARS=2 THEN PRINT"This test analyses only 2 column variables.":ND=M-2
  57. 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
  58. 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
  59. 96  Q(0)=1:MM=M:M=ND:GOSUB 50:Q(0)=0:M=MM
  60. 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
  61. 98  NEXT J
  62. 99  '   Now read numerical data from disk
  63. 100  COLOR 23,0:PRINT"Loading numbers";:COLOR 7,0:FOR I=1 TO N:KK=1:LL=1:L=M
  64. 101  FOR J=1 TO L:INPUT #1,Z
  65. 102  IF J=Q(KK) THEN KK=KK+1 ELSE X(I,LL)=Z:LL=LL+1
  66. 103  NEXT J:NEXT I:CLOSE:LOCATE,1:M=M-ND:RETURN
  67. 109  '<UNK! {000A}>--- Get Filespec ---
  68. 110  IF IO$="O" THEN STOP:END
  69. 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)
  70. 112  ER=0:FOR I=1 TO LEN(FL$):Z$=MID$(FL$,I,1):IF INSTR(" .,/\|?*:;[]+="+CHR$(34),Z$) THEN ER=1
  71. 113  NEXT I
  72. 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
  73. 115  INPUT "Which drive (A,B,C,D)";DR$:IF DR$="" THEN 115
  74. 116  DR$=CHR$(ASC(DR$) AND 95):IF INSTR("ABCD",DR$)=0 THEN 115
  75. 117  INPUT "Which directory (e.g. WORK, MYDATA, or Null Entry if root) ";DR2$:IF DR2$="" THEN DR$=DR$+":" ELSE DR$=DR$+":\"+DR2$+"\"
  76. 129  '<UNK! {000A}>--- Open File, IO$= "I" ---
  77. 130  IF IO$="I" THEN 134 ELSE STOP:END
  78. 131  '
  79. 132  '
  80. 133  '
  81. 134  ON ERROR GOTO 136:OPEN DR$+FL$ FOR INPUT AS #1   'for input
  82. 135  ON ERROR GOTO 30:RETURN   'input #1,A$,B$:close
  83. 136  PRINT FL$" not found on Drive "DR$:RESUME 137
  84. 137  GOSUB 5:ON ERROR GOTO 30:CLS:ERASE X:SHELL "DIR "+DR$+"/W":GOSUB 5
  85. 138  DIM X(MXR,MXC):GOTO 110
  86. 159  '<UNK! {000A}>--- Show/Print Answers ---
  87. 160  PR=0:CLOSE:OPEN "SCRN:" FOR OUTPUT AS #2:QB=-(QB<>2)*QB-(QB=2)*QBB:RETURN
  88. 161  DO$="print these results":GOSUB 20:IF Z$="N" THEN PR=0:RETURN
  89. 162  PR=1:IF SHOWN$="y" THEN 164 ELSE IF ID$="" THEN LINE INPUT "Problem ID? ";ID$:GOTO 164
  90. 163  LINE INPUT"Problem ID (null = unchanged)? ";Z$:IF Z$>"" THEN ID$=Z$
  91. 164  RETURN
  92. 165  QBB=QB:QB=2:CLS:LOCATE 8,1
  93. 166  PRINT TAB(12)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  94. 167  PRINT TAB(12)"OPEN                                                       OPEN"
  95. 168  PRINT TAB(12)"OPEN                TURN  PRINTER  ON.                     OPEN"
  96. 169  PRINT TAB(12)"OPEN                                                       OPEN"
  97. 170  PRINT TAB(12)"OPEN    Then PRESS <ENTER> to start printing ..... or ..   OPEN"
  98. 171  PRINT TAB(12)"OPEN                                                       OPEN"
  99. 172  PRINT TAB(12)"OPEN    To send Printer Codes in Basic before printing,    OPEN"
  100. 173  PRINT TAB(12)"OPEN    press <Ctrl-Break>, & start printing by GOTO 9.    OPEN"
  101. 174  PRINT TAB(12)"OPEN                                                       OPEN"
  102. 175  PRINT TAB(12)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":IN$=INKEY$
  103. 176  IN$=INKEY$:IF IN$<>CHR$(13) THEN 176
  104. 177  CLS:PRINT"Printing .....":LOCATE 4,1:CLOSE:OPEN "LPT1:" FOR OUTPUT AS #2
  105. 178  IF HD$>"" THEN PRINT #2,STRING$(79,61):PRINT #2,DAT$;TAB(42-LEN(HD$)\2);HD$;TAB(73)VER$:PRINT #2,STRING$(79,61):HD$=""
  106. 179  IF SHOWN$="" THEN PRINT #2,CHR$(10)"Problem: "ID$;CHR$(10):SHOWN$="y"
  107. 180  RETURN
  108. 199  '<UNK! {000A}>--- Show a Row of Data ---
  109. 200  PRINT"Row"STR$(I)": ";:FOR J=1 TO M:PRINT X(I,J);:NEXT J:PRINT:RETURN
  110. 249  '<UNK! {000A}>--- Transform Sub ---
  111. 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";
  112. 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)"
  113. 252  PRINT"<UNK! {000A}>"TAB(10)"Negative codes reverse transforms (e.g. -3 = Antilog)<UNK! {000A}>":LOCATE,,1
  114. 253  INPUT"Which transform (+/- 1 to 9, or 10)";T%:IF T%=10 THEN 273 ELSE IF ABS(T%)<1 OR ABS(T%)>9 THEN PRINT"WHAT?  ";:GOTO 253
  115. 254  IF M=1 THEN NT=1:Q(1)=1:GOTO 257 ELSE PRINT"How many variables are to have this transform (max"STR$(M)")";:INPUT NT:IF NT<1 OR NT>M THEN 254 ELSE IF NT=M THEN FOR J=1 TO M:Q(J)=J:NEXT J:GOTO 257
  116. 255  IF NT=1 THEN INPUT"Which variable # ";X$:Q(1)=VAL(X$):IF Q(1)<1 OR Q(1)>M THEN PRINT"Silly":GOTO 255 ELSE 257
  117. 256  PRINT"Which"NT"variables (#'s in Free Format)";:INPUT X$:I=1:MM=M:M=NT:Q(0)=1:GOSUB 50:Q(0)=0:M=MM:FOR J=1 TO NT:IF Q(J)>0 AND Q(J)<=M THEN NEXT J ELSE PRINT"Value"J"is out-of-bounds.  Try again.":GOTO 256
  118. 257  GOSUB 43:A=57.2958:B=0.434294:Z=0:U=1:H=100:P5=0.5:P9=0.99999:E$(0)=""
  119. 258  FOR J=1 TO NT:K=Q(J):FOR I=1 TO N:ON T%+10 GOTO 269,270,270,267,267,265,265,262,262,39,260,259,264,263,267,266,269,268,270
  120. 259  X(I,K)=X(I,K)/H
  121. 260  IF X(I,K)>P9 THEN X(I,K)=P9 ELSE IF X(I,K)<Z THEN 272
  122. 261  X(I,K)=SQR(X(I,K)):X(I,K)=A*ATN(X(I,K)/SQR(U-X(I,K)*X(I,K))):GOTO 271
  123. 262  IF X(I,K)>=Z THEN X(I,K)=(SIN(X(I,K)/A))^2:IF T%=-U THEN 271 ELSE X(I,K)=H*X(I,K):GOTO 271 ELSE T%=U:GOTO 272
  124. 263  X(I,K)=X(I,K)+U
  125. 264  IF X(I,K)>Z THEN X(I,K)=B*LOG(X(I,K)):GOTO 271 ELSE 272
  126. 265  X(I,K)=EXP(X(I,K)/B):IF T%=-3 THEN 271 ELSE X(I,K)=X(I,K)-U:GOTO 271
  127. 266  X(I,K)=X(I,K)+U
  128. 267  IF X(I,K)<>Z THEN X(I,K)=H/X(I,K):IF T%=-6 THEN X(I,K)=X(I,K)-U:GOTO 271 ELSE 271 ELSE 272
  129. 268  X(I,K)=X(I,K)+P5
  130. 269  IF X(I,K)>=Z THEN X(I,K)=SQR(X(I,K)):GOTO 271 ELSE T%=7:GOTO 272
  131. 270  X(I,K)=X(I,K)*X(I,K):IF T%=-8 THEN X(I,K)=X(I,K)-P5
  132. 271  NEXT I:NEXT J:IF E$(0)=""THEN GOSUB 44:GOTO 273
  133. 272  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$((ABS(T%)-1)/2)", Row"I:GOSUB 5:END
  134. 273  RETURN
  135. 339  '<UNK! {000A}>--- Date ---
  136. 340  DAT$=MID$(DATE$,4,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",-2+3*VAL(LEFT$(DATE$,2)),3)+" "+RIGHT$(DATE$,4):RETURN
  137. 359  '<UNK! {000A}>--- Probabilities ---
  138. 360  IND=1:IF DA*DB*F<=0 THEN 364 ELSE IF F>=1 THEN A1=DA:B1=DB:FF=F ELSE A1=DB:B1=DA:FF=1/F
  139. 361  AA=2/(9*A1):BB=2/(9*B1):Z=ABS(((1-BB)*FF^(1/3)-1+AA)/SQR(BB*FF^(2/3)+AA)):IF B1<4 THEN Z=Z*(1+0.08*Z^4/B1^3)
  140. 362  P=50*((1+Z*0.196854+Z^2*0.115194+Z^3*0.000343649+Z^4*0.019527)^-4):IF F<1 THEN P=100-P
  141. 363  IF P<10 THEN IF P>5 THEN IND=2 ELSE IF P>1 THEN IND=3 ELSE IF P>0.1 THEN IND=4 ELSE IND=5
  142. 364  RETURN
  143. 369  '<UNK! {000A}>--- Special Error Messages ---
  144. 370  BEEP:PRINT:PRINT"<< ERROR >>   Can't continue because Variable X in Sample"G"has no variation.":GOTO 579
  145. 371  BEEP:PRINT:PRINT"<< ERROR >>   Can't continue because Variable Y in Sample"G"has no variation.":GOTO 579
  146. 372  BEEP:PRINT:PRINT"< ERROR >  Can't continue because X and Y in Sample"G"are perfectly correlated.":GOTO 579
  147. 399  '<UNK! {000A}>--- Start ---
  148. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  149. 401  DEFINT I-N,Q:MXR=400:MXC=20:MG=20:MNC=2:M=2:NEEDVARS=2
  150. 402  DIM X(MXR,M),O$(41),N(MG),KN(MG),DF(MG),XX(MG),YY(MG),XY(MG),XM(MG),YM(MG),PA(MG),SR(MG),SE(MG),VE(MG),TX(M),TY(M),TM(M),SK(MG),SL(MG),EK(MG),V(MXC),VN$(MXC),Q(MXC),XP(5),T$(10),P$(5),E$(3)
  151. 403  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)
  152. 404  HD$="  ANCOVA  &  COMPARING REGRESSION LINES  ":VER$="(RL,2)"
  153. 405  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 4,1,0:K=12
  154. 406  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  155. 407  PRINT TAB(K)"OPEN                This performs either:                  OPEN"
  156. 408  PRINT TAB(K)"OPEN 1. 1-Way ANCOVA with 1 covariate X & 1 criterion Y, orOPEN"
  157. 409  PRINT TAB(K)"OPEN 2. Comparison of 2-20 REGRESSION LINES for slope etc. OPEN"
  158. 410  PRINT TAB(K)"OPEN                                                       OPEN"
  159. 411  PRINT TAB(K)"OPEN     Data (from keyboard or disk) will consist of      OPEN"
  160. 412  PRINT TAB(K)"OPEN       up to a total of 400 rows of X Y pairs,         OPEN"
  161. 413  PRINT TAB(K)"OPEN             from 2-20 samples or groups.              OPEN"
  162. 414  PRINT TAB(K)"OPEN      Each sample must have 3 or more X Y pairs.       OPEN"
  163. 415  PRINT TAB(K)"OPEN                                                       OPEN"
  164. 416  PRINT TAB(K)"OPEN  Entire data must be entered in sequence, 1st sample  OPEN"
  165. 417  PRINT TAB(K)"OPEN  followed by 2nd sample, etc, without sample breaks.  OPEN"
  166. 418  PRINT TAB(K)"OPEN    (Prior REGROUP can arrange this for datafiles.)    OPEN"
  167. 419  PRINT TAB(K)"OPEN                                                       OPEN"
  168. 420  PRINT TAB(K)"OPEN        Editing & data transforms are available.       OPEN"
  169. 421  PRINT TAB(K)"OPEN      Printouts are offered after showing answers.     OPEN"
  170. 422  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  171. 423  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE ,,1
  172. 424  P5=0.5:SC$="SCATTERGRAM":C$="*23456789ABCDEFGHIJKLMNOPQRSTUVWXYZ#":S6$=SPACE$(6):S12$=SPACE$(12)
  173. 425  XM$="XBAR   ":YM$="YBAR   ":MR$="MS(Reg)":MS$="MS(Res)"
  174. 426  F2$=" =######.##":F4$=" =######.####":FA$="\     \"+F4$+SPACE$(8)+"\     \"+F4$:FB$="     "+FA$:F1$=SPACE$(5)+FA$:FF$="     F(##!###) =######.##\   \":TS$="Test of Slope:  F(1!###) =######.##\   \"+CHR$(10)
  175. 427  P$(1)=" (NS)":P$(2)=" (D) ":P$(3)=" *   ":P$(4)=" **  ":P$(5)=" *** "
  176. 428  '<UNK! {000A}>--- Get Data ---
  177. 429  ITER=0
  178. 430  DO$="enter data from disk":GOSUB 20:IF Z$="N" THEN 434
  179. 431  '<UNK! {000A}>--- Disk Entry ---
  180. 432  QD=1:MNR=2:MNC=2:GOSUB 80:PRINT"Finished ......":GOSUB 5:GOTO 438
  181. 433  '<UNK! {000A}>--- K/b Entry ---
  182. 434  QD=0:CLS
  183. 435  PRINT"Enter up to"MXR"pairs of X Y values (non-stop), 1 pair per line, in Free Format."
  184. 436  I=1:GOSUB 72
  185. 437  '<UNK! {000A}>--- Show Data ---
  186. 438  QB=3:I=1:PRINT:IF QR=0 THEN PRINT"DATA READ WAS ---"ELSE PRINT"REVISED DATA IS ---"
  187. 439  GOSUB 200:IF I MOD 20=0 THEN GOSUB 6
  188. 440  I=I+1:IF I<=N THEN 439
  189. 441  IF VN$<>"Y" THEN VN$(1)=" X      ":VN$(2)=" Y      "
  190. 442  IF QD=1 THEN IF VN$="N" THEN PRINT"Variables not named." ELSE FOR J=1 TO M:PRINT USING "Var##=";J;:PRINT VN$(J),:NEXT J:PRINT
  191. 443  '<UNK! {000A}>--- Get # of Groups, NG ---
  192. 444  ITER=ITER+1:IF ITER>1 THEN 446
  193. 445  PRINT:PRINT"How many samples or regression lines (2-"MID$(STR$(MG),2)") ";:INPUT NG:IF NG<2 OR NG>MG THEN 445
  194. 446  IF N<3*NG THEN BEEP:PRINT:PRINT"Sorry, but total N ="N"is NOT enough data for"NG"samples.":PRINT"Each sample must have at least 3 pairs of measurements for this analysis.":GOTO 11
  195. 447  IF ITER>1 THEN GOSUB 5
  196. 448  '<UNK! {000A}>--- Commands ---
  197. 449  QB=4:CLOSE:CLS:PRINT TAB(26)"COMMAND MENU":LOCATE 4,1,0:PRINT"Indicate your requirements thus---":K=20
  198. 450  PRINT"<UNK! {000A}>"TAB(K)"SA = Show all data again<UNK! {000A}>"TAB(K)"C# = Change row #<UNK! {000A}>"TAB(K)"D# = Delete row #";
  199. 451  PRINT"<UNK! {000A}>"TAB(K)"I# = Insert row # (in Free Format)<UNK! {000A}>"TAB(K)"T  = Transform variables<UNK! {000A}>"TAB(K)"A  = Analyse now<UNK! {000A}>"TAB(K)"Q  = Quit or Re-run":PRINT
  200. 452  INPUT"====> Option (SA, C#, D#, I#, T, A, Q) ";Z$:IF Z$="" THEN 452
  201. 453  IF Z$="SA" OR Z$="sa" THEN 438 ELSE IF Z$="T" OR Z$="t" THEN 466 ELSE IF Z$="A" OR Z$="a" THEN 468 ELSE IF Z$="Q" OR Z$="q" THEN 10
  202. 454  LZ$=CHR$(ASC(LEFT$(Z$,1)) AND 95):I=VAL(MID$(Z$,2)):IF I>0 AND I<=N THEN IF LZ$="C" THEN 457 ELSE IF LZ$="D" THEN 462 ELSE IF LZ$="I" THEN 463
  203. 455  GOSUB 40:GOTO 452
  204. 456  '<UNK! {000A}>--- Change Row ---
  205. 457  QR=1:GOSUB 200
  206. 458  INPUT "Change which variable # (1 or 2)";Z$:J=VAL(Z$):IF J<1 OR J>2 THEN BEEP:GOTO 458
  207. 459  PRINT"Old value ="X(I,J);TAB(28);"New value";:INPUT Z$:FOR K=1 TO LEN(Z$):IF INSTR("-.0123456789",MID$(Z$,K,1)) THEN NEXT K:X(I,J)=VAL(Z$) ELSE PLAY"L16O3CEL4>B":PRINT"That contains a `non-numeric' entry.  Please re-do.":GOTO 459
  208. 460  PRINT"Revised Row"STR$(I)": ";:FOR J=1 TO M:PRINT X(I,J);:NEXT J:PRINT:DO$="change that row again":GOSUB 20:IF Z$="Y" THEN 458 ELSE 449
  209. 461  '<UNK! {000A}>--- Delete & Insert Row ---
  210. 462  QR=1:N=N-1:FOR K=I TO N:FOR J=1 TO M:X(K,J)=X(K+1,J):NEXT J:NEXT K:PRINT:PRINT"Row"I"now deleted.";:GOSUB 5:GOTO 449
  211. 463  QR=1:IF N=MXR THEN PRINT"No Room":GOSUB 5:GOTO 449 ELSE N=N+1:FOR K=N TO I+1 STEP -1:FOR J=1 TO M:X(K,J)=X(K-1,J):NEXT J:NEXT K
  212. 464  PRINT"Row"STR$(I);:INPUT X$:GOSUB 50:PRINT"New ";:GOSUB 200:GOSUB 5:GOTO 449
  213. 465  '<UNK! {000A}>--- Transforms ---
  214. 466  CLS:GOSUB 250:GOTO 449
  215. 467  '<UNK! {000A}>--- Analyse Now ---
  216. 468  CLS:LOCATE ,1,0:K=12
  217. 469  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  218. 470  PRINT TAB(K)"OPEN   At this point, you must tell me your SAMPLE SIZES.  OPEN"
  219. 471  PRINT TAB(K)"OPEN   You will then be able to:                           OPEN"
  220. 472  PRINT TAB(K)"OPEN           See/print data.                             OPEN"
  221. 473  PRINT TAB(K)"OPEN           See/print scattergrams.                     OPEN"
  222. 474  PRINT TAB(K)"OPEN           See/print statistical results.              OPEN"
  223. 475  PRINT TAB(K)"OPEN                                                       OPEN"
  224. 476  PRINT TAB(K)"OPEN    At the end, you will be offered the option of      OPEN"
  225. 477  PRINT TAB(K)"OPEN  re-cycling to remove outliers or re-transform data.  OPEN"
  226. 478  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE ,,1
  227. 479  '<UNK! {000A}>--- Get Sample Sizes N(G) & Cum Sizes KN(G) ---
  228. 480  PRINT:PRINT"Total ="N"pairs of measurements.   You specified"NG"Samples.":PRINT
  229. 481  FOR G=1 TO NG:KN(G)=0:QE=0
  230. 482  PRINT"How many pairs of measurements belong to Sample";G;:INPUT N(G):IF N(G)<3 THEN QE=1:G=NG ELSE KN(G)=KN(G-1)+N(G):IF KN(G)>N THEN QE=2:G=NG
  231. 483  NEXT G:ON QE GOTO 486,485
  232. 484  IF KN(NG)=N THEN 489
  233. 485  BEEP:PRINT:PRINT"---> ERROR.  Those sample sizes add up to"KN(NG)"instead of"N:GOTO 487
  234. 486  BEEP:PRINT:PRINT"--> ERROR. This analysis needs at least 3 pairs of measurements in each sample."
  235. 487  GOSUB 5:GOTO 449
  236. 488  '<UNK! {000A}>--- Print Data? ---
  237. 489  DO$="print all the data used":GOSUB 20:IF Z$="N" THEN 494 ELSE GOSUB 162:GOSUB 165
  238. 490  PRINT #2,:PRINT #2,"DATA USED:"
  239. 491  FOR G=1 TO NG:PRINT #2,"SAMPLE #"G;SPACE$(4)"N ="N(G):PRINT #2,SPACE$(7);VN$(1);SPACE$(9);VN$(2):FOR I=1+KN(G-1)TO KN(G):PRINT #2,USING"  ######.##        ######.##";X(I,1);X(I,2):NEXT I:PRINT #2,:NEXT G:PRINT #2,
  240. 492  GOSUB 160
  241. 493  '<UNK! {000A}>--- Start Computations, Offer Scattergrams ---
  242. 494  G=1:TX(1)=0:TX(2)=0:TY(1)=0:TY(2)=0:T3=0:P1=0:P2=0:P3=0
  243. 495  DO$="see SCATTERGRAMS for visual check of linearities":GOSUB 20:IF Z$="N" THEN QS=0:GOSUB 43:GOTO 498
  244. 496  QS=1:CLS:GOSUB 43
  245. 497  J=1:L=1:K=2:IF PR=1 THEN 506
  246. 498  DF(G)=N(G)-2:X1=0:X2=0:X3=0:Y1=0:Y2=0:Y3=0:XY=0
  247. 499  FOR I=1+KN(G-1) TO KN(G):X=X(I,1)-X(1,1):X1=X1+X:X2=X2+X*X:X3=X3+X*X*X:Y=X(I,2)-X(1,2):Y1=Y1+Y:Y2=Y2+Y*Y:Y3=Y3+Y*Y*Y:XY=XY+X*Y:NEXT I
  248. 500  TX(1)=TX(1)+X1:TX(2)=TX(2)+X2:TY(1)=TY(1)+Y1:TY(2)=TY(2)+Y2:T3=T3+XY:XM(G)=X(1,1)+X1/N(G):YM(G)=X(1,2)+Y1/N(G)
  249. 501  XX(G)=X2-X1*X1/N(G):YY(G)=Y2-Y1*Y1/N(G):XY(G)=XY-X1*Y1/N(G):P1=P1+XX(G):P2=P2+YY(G):P3=P3+XY(G):IF XX(G)=0 THEN 370 ELSE IF YY(G)=0 THEN 371
  250. 502  IF QS=0 THEN 542
  251. 503  '<UNK! {000A}>--- Skewness Coefficients ---
  252. 504  X3=X3-3*X2*X1/N(G)+2*X1*X1*X1/N(G)/N(G):SK(G)=X3/(SQR(XX(G)*XX(G)*XX(G)/N(G))):Y3=Y3-3*Y2*Y1/N(G)+2*Y1*Y1*Y1/N(G)/N(G)
  253. 505  SL(G)=Y3/(SQR(YY(G)*YY(G)*YY(G)/N(G))):EK(G)=SQR(6*DF(G)/(N(G)+1)/(N(G)+3))
  254. 506  S=X(1+KN(G-1),L):B=S
  255. 507  FOR I=2+KN(G-1) TO KN(G):IF X(I,L)<S THEN S=X(I,L) ELSE IF X(I,L)>B THEN B=X(I,L)
  256. 508  NEXT I
  257. 509  IF B-S<9.999E-06 THEN BEEP:PRINT"<< ERROR >>  Can't proceed because Variable"L"in Sample"G"has no variation.":QS=0:GOTO 579
  258. 510  IF L=J THEN H=4 ELSE H=1.5
  259. 511  '<UNK! {000A}>--- Select Scales ---
  260. 512  Q=1:KT=0
  261. 513  R=B-S:C=S
  262. 514  IF R<=1 THEN KT=KT+1:R=R*10:GOTO 514
  263. 515  IF R>10 THEN KT=KT-1:R=R/10:GOTO 515
  264. 516  IF Q>2 THEN 518 ELSE C=C*10^KT:IF C<0 AND C<>INT(C) THEN C=C-1
  265. 517  C=INT(C)/10^KT:R=(B-C)/H:KT=0:Q=Q+2:GOTO 514
  266. 518  F=INT(R):IF F<>R THEN F=F+1
  267. 519  IF R<P5 THEN F=F-P5
  268. 520  F=F/10^KT:IF Q<>4THEN IF(B-S)/(H*F)<=0.8THEN KT=1:Q=2:GOTO 513
  269. 521  S=C:D=F*INT(C/F):IF D<0AND D<>C THEN D=D-F
  270. 522  IF D+H*F>=B THEN S=D
  271. 523  IF L=J THEN X=S:U=F:L=K:GOTO 506 ELSE Y=S:V=F
  272. 524  NX=41:LX=5:NY=16:A=10/U:B=10/V:IF PR=0 THEN GOSUB 160:CLS
  273. 525  '<UNK! {000A}>--- Show Scattergram ---
  274. 526  PRINT #2,SC$" #"MID$(STR$(G),2);:PRINT #2,USING"    Skew(X)=+##.##    Skew(Y)=+##.##    SE(Skew)=##.##";SK(G);SL(G);EK(G):PRINT #2,
  275. 527  O=0:FOR KN=1TO LX:XP(KN)=X+O*U:O=O+1:NEXT KN:FOR I=1TO NY:Q=I-1:IL=NY-Q:FOR I2=1TO NX:O$(I2)=" ":NEXT I2
  276. 528  FOR L=1+KN(G-1) TO KN(G):IX=((X(L,J)-X)*A)+1:IF IX<1 OR IX>NX THEN 532 ELSE IY=((X(L,K)-Y)*B)+1:IF IY<>IL THEN 532 ELSE IF O$(IX)=" " THEN O$(IX)="*":GOTO 532
  277. 529  IF O$(IX)="#" THEN 532
  278. 530  FOR KK=1 TO 35:IF O$(IX)=MID$(C$,KK,1) THEN O$(IX)=MID$(C$,KK+1,1):KK=35
  279. 531  NEXT KK
  280. 532  NEXT L
  281. 533  FOR L=41 TO 1 STEP -1:IF O$(L)=" "THEN NEXT L:LN=1 ELSE LN=L
  282. 534  IF Q MOD 5<>0 THEN 537
  283. 535  GG=Q:O=H-GG/10:D=Y+O*V:IF D<100000 THEN PRINT #2,USING"##########.#";D;:PRINT #2,"+ ";:FOR L=1 TO LN:PRINT #2,O$(L);:NEXT L:GOTO 539
  284. 536  IY=INT(D+P5):PRINT #2,USING"############";IY;:PRINT #2,"+ ";:FOR L=1 TO LN:PRINT #2,O$(L);:NEXT L:GOTO 539
  285. 537  IF I<>3 THEN PRINT #2,S12$; ELSE PRINT #2,USING"\        \  ";VN$(K);
  286. 538  PRINT #2,"! ";:FOR L=1 TO LN:PRINT #2,O$(L);:NEXT L
  287. 539  PRINT #2,:NEXT I
  288. 540  PRINT #2,S12$"  +";:FOR I=1 TO 4:PRINT #2,"---------+";:NEXT I:PRINT #2,:PRINT #2,S6$;:FOR I=1 TO LX:PRINT #2,USING"########.#";XP(I);:NEXT I:PRINT #2,:PRINT #2,SPACE$(38)VN$(J)
  289. 541  IF PR=1 THEN PRINT #2,:GOSUB 160 ELSE GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 497
  290. 542  G=G+1:IF G<=NG THEN IF QS=1 THEN 496 ELSE 498
  291. 543  '<UNK! {000A}>--- Show Sample Stats ---
  292. 544  CLS:PRINT TAB(25)"Probability Levels":PRINT"   (NS) = P>10%     (D) = P<10%     * = P<5%     ** = P<1%     *** = P<0.1%":PRINT STRING$(79,"-")
  293. 545  SR=0:SE=0:PB=P3/P1:PG=PB*P3:PE=P2-PG:PV=PE/(N-NG-1)
  294. 546  T1=TX(2)-TX(1)*TX(1)/N:T2=TY(2)-TY(1)*TY(1)/N:T3=T3-TX(1)*TY(1)/N:TM(1)=X(1,1)+TX(1)/N:TM(2)=X(1,2)+TY(1)/N:TB=T3/T1:TA=TM(2)-TB*TM(1):TR=TB*T3:TE=T2-TR
  295. 547  GOSUB 160
  296. 548  PRINT #2,TAB(24)"SAMPLE STATISTICS":PRINT #2,
  297. 549  FOR G=1 TO NG
  298. 550  PRINT #2,"SAMPLE #"G;SPACE$(10)"N ="N(G):PRINT #2,USING FA$;"XBAR   ";XM(G);"YBAR   ";YM(G):B=XY(G)/XX(G):A=YM(G)-B*XM(G):PRINT #2,USING FA$;"A      ";A;"B      ";B
  299. 551  IF PR=0 THEN SR(G)=B*XY(G):SR=SR+SR(G):SE(G)=YY(G)-SR(G):VE(G)=SE(G)/DF(G):SE=SE+SE(G):DA=1:IF SE(G)=0 THEN 372
  300. 552  DB=DF(G):F=SR(G)/VE(G):GOSUB 360:PRINT #2,USING FA$;MR$;SR(G);MS$;VE(G):PRINT #2,USING TS$;",";DF(G);F;P$(IND):IF PR=0 THEN PA(G)=YM(G)-PB*XM(G):IF G MOD 2=0 THEN GOSUB 5
  301. 553  NEXT G:DA=1:DB=N-2:F=TR/TE*DB:GOSUB 360:PRINT #2,"TOTAL DATA (Pooled Samples)"S6$" N ="N
  302. 554  PRINT #2,USING FA$;XM$;TM(1);YM$;TM(2):PRINT #2,USING FA$;"TOTAL A";TA;"TOTAL B";TB:PRINT #2,USING FA$;MR$;TR;MS$;TE/DB:PRINT #2,USING TS$;",";DB;F;P$(IND)
  303. 555  IF PR=1 THEN GOSUB 160 ELSE GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 548
  304. 556  '<UNK! {000A}>--- Show Regression Line Comparisons ---
  305. 557  CLS:GOSUB 43:S=VE(1):B=S:FOR G=2 TO NG:IF VE(G)<S THEN S=VE(G) ELSE IF VE(G)>B THEN B=VE(G)
  306. 558  NEXT G:HD=INT((N-2*NG)/NG+0.5):CLS
  307. 559  PRINT #2,TAB(20)"COMPARING REGRESSION LINES"
  308. 560  PRINT #2,:PRINT #2,"(1)  HARTLEY'S MAX F RATIO (for homoscedasticity of residuals)":PRINT #2,USING FB$;"MS(Max)";B;"MS(Min)";S:PRINT #2,USING"     F (df=##)";HD;:PRINT #2,USING F2$;B/S;:PRINT #2," (BTS Table 31)"
  309. 561  DA=NG:DB=N-2*NG:SV=SE/DB:F=SR/NG/SV:GOSUB 360
  310. 562  PRINT #2,:PRINT #2,"(2)  ALL LINES (overall testing regr of Y on X, if homoscedastic)":PRINT #2,USING F1$;MR$;SR/NG;:PRINT #2,USING FA$;MS$;SV:PRINT #2,USING FF$;DA;",";DB;F;P$(IND)
  311. 563  DA=NG-1:F=(PE-SE)/DA/SE*DB:GOSUB 360
  312. 564  PRINT #2,:PRINT #2,"(3)  PARALLELISM TEST (if significant overall regression)":PRINT #2,USING F1$;MR$;(PE-SE)/DA;:PRINT #2,USING FA$;MS$;SE/DB:PRINT #2,USING FF$;DA;",";DB;F;P$(IND)
  313. 565  IF PR=0 THEN GOSUB 5 ELSE PRINT #2,
  314. 566  PRINT #2,"IF PARALLEL, LINES THRU CENTROIDS HAVE SLOPE & INTERCEPTS THUS:":PRINT #2,USING SPACE$(5)+"B"+CHR$(34)+SPACE$(5)+F4$;PB
  315. 567  FOR G=1 TO NG:PRINT #2,SPACE$(5)"A"CHR$(34)USING"(##) ";G;:PRINT #2,USING F4$;PA(G):IF G MOD 15=0 THEN GOSUB 5
  316. 568  NEXT G
  317. 569  PRINT #2,:PRINT #2,"WITH THESE PARALLEL LINES ---":FOR G=1 TO NG:PRINT #2,USING SPACE$(5)+"Adjusted YBAR(##)";G;:PRINT #2,USING F4$;YM(G)-PB*(XM(G)-TM(1)):IF G MOD 15=0 THEN GOSUB 5
  318. 570  NEXT G:GOSUB 5
  319. 571  DA=1:DB=N-NG-1:F=PG/PV:GOSUB 360
  320. 572  PRINT #2,:PRINT #2,"(4)  COMMON SLOPE TEST (if parallel)":PRINT #2,USING F1$;MR$;PG;:PRINT #2,USING FA$;MS$;PV:PRINT #2,USING FF$;1;",";DB;F;P$(IND)
  321. 573  DA=NG-1:F=(TE-PE)/DA/PV:GOSUB 360
  322. 574  PRINT #2,:PRINT #2,"(5)  HEIGHT DIFFERENCES (if parallel)":PRINT #2,USING F1$;MR$;(TE-PE)/DA;:PRINT #2,USING FA$;MS$;PV:PRINT #2,USING FF$;DA;",";DB;F;P$(IND)
  323. 575  PRINT #2,:PRINT #2,"(6)  SINGLE SLOPE TEST (if heights are the same)":PRINT #2,SPACE$(5);"See TOTAL DATA (Pooled Samples) line & test, above."
  324. 576  SX=0:FOR G=1 TO NG:SX=SX+XX(G):NEXT G:AM=PV*(1+((T1-SX)/(NG-1)/SX))
  325. 577  PRINT #2,:PRINT #2,"FOR PLANNED COMPARISONS, Sum of SS(X)   ";:PRINT #2,USING F4$;SX:PRINT #2,"FOR POST-HOC TESTS, Ave (MS residual)   ";:PRINT #2,USING F4$;AM:PRINT #2,
  326. 578  IF PR=0 THEN GOSUB 161:IF PR=1 THEN GOSUB 165:GOTO 559
  327. 579  GOSUB 160:PRINT:DO$="modify this data & re-analyse it":GOSUB 20:IF Z$="Y" THEN 449 ELSE 10
  328. 580  'end
  329.