home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / corel.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-03-09  |  23.8 KB  |  361 lines
  1. 1  '           CORRELATIONS  ---  COREL.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}><UNK! {000A}>*** Redirect to Block ***
  7. 9  ON QB GOTO 400,177,412: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  GOTO 400
  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 INPUT"Can't write to that disk.  Remove its Write-Protect tab, then press <Enter>.";Z$:RESUME
  16. 32  IF ERR=71 THEN 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.<UNK! {000A}>    Signals NEG=1 for Spearman's r.
  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$):IF X(I,J)<0 THEN NEG=1
  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."
  40. 72  PRINT"Null entry duplicates previous row.  Signal `end-of-data' by entering a `/'"
  41. 73  PRINT "Row"STR$(I-KN(Q-1));: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
  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>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  '   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  IF NEEDVARS=1 THEN PRINT"This test analyses only 1 column variable at a time.":ND=M-1
  59. 93  IF NEEDVARS=2 THEN PRINT"This test analyses only 2 column variables.":ND=M-2
  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  PRINT: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:PRINT SPACE$(15):M=M-ND:RETURN
  70. 109  '<UNK! {000A}>--- Get Filespec ---
  71. 110  IF IO$="O" AND FL$>"" THEN PRINT "Will you file this data under the name "FL$;:GOSUB 21:IF Z$="Y" THEN 115
  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" ***
  80. 130  IF IO$="O" THEN 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 X:SHELL "DIR "+DR$+"/W":GOSUB 5:DIM X(MXR,2):GOTO 110 ' MXC replaced
  88. 159  '<UNK! {000A}>--- Show/Print Answers ---
  89. 160  QB=1:PR=0:CLOSE:OPEN "SCRN:" FOR OUTPUT AS #2:RETURN
  90. 161  DO$="print these results":GOSUB 20:IF Z$="N" THEN PR=0:RETURN
  91. 162  PR=1:IF ID$="" THEN LINE INPUT "Problem ID? ";ID$:GOTO 164
  92. 163  LINE INPUT"Problem ID (null = unchanged)? ";Z$:IF Z$>"" THEN ID$=Z$
  93. 164  RETURN
  94. 165  QB=2:CLS:LOCATE 8,1
  95. 166  PRINT TAB(12)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  96. 167  PRINT TAB(12)"OPEN                                                       OPEN"
  97. 168  PRINT TAB(12)"OPEN                TURN  PRINTER  ON.                     OPEN"
  98. 169  PRINT TAB(12)"OPEN                                                       OPEN"
  99. 170  PRINT TAB(12)"OPEN    Then PRESS <ENTER> to start printing ..... or ..   OPEN"
  100. 171  PRINT TAB(12)"OPEN                                                       OPEN"
  101. 172  PRINT TAB(12)"OPEN    To send Printer Codes in Basic before printing,    OPEN"
  102. 173  PRINT TAB(12)"OPEN    press <Ctrl-Break>, & start printing by GOTO 9.    OPEN"
  103. 174  PRINT TAB(12)"OPEN                                                       OPEN"
  104. 175  PRINT TAB(12)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":IN$=INKEY$
  105. 176  IN$=INKEY$:IF IN$<>CHR$(13) THEN 176
  106. 177  CLS:PRINT"Printing .....":LOCATE 4,1:CLOSE:OPEN "LPT1:" FOR OUTPUT AS #2
  107. 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$=""
  108. 179  PRINT #2,CHR$(10)"Problem: "ID$;CHR$(10)
  109. 180  RETURN
  110. 189  '<UNK! {000A}>--- Print Data ---<UNK! {000A}>   Needs X( , ) & NEEDVARS=1 or 2: if=1, then NS,N( ),KN( ,1) else J,K,VN$( ).
  111. 190  DO$="print all the data used":GOSUB 20:IF Z$="N" THEN 193
  112. 191  PRINT #2,STRING$(2,10)"DATA USED: ":IF NEEDVARS=1 THEN FOR J=1 TO NS:PRINT #2,"Sample "CHR$(J+64)":":FOR I=1 TO N(J):PRINT #2,X(I+KN(J-1),1);:NEXT I:PRINT #2,:NEXT J:GOTO 193
  113. 192  IF NEEDVARS=2 THEN PRINT #2,VN$(1)", & "VN$(2):FOR I=1 TO N:PRINT #2,X(I,1);X(I,2),:NEXT I
  114. 193  PR=0:PRINT #2,:CLOSE:RETURN
  115. 199  '<UNK! {000A}>--- Show a Row of Data ---
  116. 200  PRINT"Row"STR$(I)": ";:FOR J=1 TO M:PRINT X(I,J);:NEXT J:PRINT:RETURN
  117. 211  NEXT L:RETURN
  118. 249  '<UNK! {000A}>--- Transform Sub ---
  119. 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";
  120. 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)"
  121. 252  PRINT"<UNK! {000A}>"TAB(10)"Negative codes reverse transforms (e.g. -3 = Antilog)<UNK! {000A}>":LOCATE,,1
  122. 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
  123. 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
  124. 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
  125. 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
  126. 257  GOSUB 43:A=57.2958:B=0.434294:Z=0:U=1:H=100:P5=0.5:P9=0.99999:E$(0)=""
  127. 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
  128. 259  X(I,K)=X(I,K)/H
  129. 260  IF X(I,K)>P9 THEN X(I,K)=P9 ELSE IF X(I,K)<Z THEN 272
  130. 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
  131. 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
  132. 263  X(I,K)=X(I,K)+U
  133. 264  IF X(I,K)>Z THEN X(I,K)=B*LOG(X(I,K)):GOTO 271 ELSE 272
  134. 265  X(I,K)=EXP(X(I,K)/B):IF T%=-3 THEN 271 ELSE X(I,K)=X(I,K)-U:GOTO 271
  135. 266  X(I,K)=X(I,K)+U
  136. 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
  137. 268  X(I,K)=X(I,K)+P5
  138. 269  IF X(I,K)>=Z THEN X(I,K)=SQR(X(I,K)):GOTO 271 ELSE T%=7:GOTO 272
  139. 270  X(I,K)=X(I,K)*X(I,K):IF T%=-8 THEN X(I,K)=X(I,K)-P5
  140. 271  NEXT I:NEXT J:IF E$(0)=""THEN GOSUB 44:GOTO 273
  141. 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
  142. 273  RETURN
  143. 279  '<UNK! {000A}>--- Rank & Tie Corr Sub ---<UNK! {000A}>    Ranks input X(II,Q), II=1 to NN, Q= a constant (e.g. 0).<UNK! {000A}>    Returns ranks in RK(II), ave ranks if tied, & usually tie correction (TC).<UNK! {000A}>    Alters II, JJ, LK(II), SM, EQ, AR!, & KT.
  144. 280  ERASE RK,LK:DIM RK(NN),LK(NN):FOR II=1 TO NN:IF RK(II)>0 THEN 284 ELSE SM=0:EQ=0:FOR JJ=1 TO NN:IF X(JJ,Q)<X(II,Q) THEN SM=SM+1 ELSE IF X(JJ,Q)=X(II,Q) THEN EQ=EQ+1:RK(JJ)=-1
  145. 281  NEXT JJ:IF EQ<2 THEN RK(II)=SM+1:GOTO 284
  146. 282  AR!=SM+(EQ+1)/2:FOR JJ=II TO NN:IF RK(JJ)=-1 THEN RK(JJ)=AR!
  147. 283  NEXT JJ
  148. 284  NEXT II:IF NO.TC THEN RETURN
  149. 285  '  Tie Correction
  150. 286  TC=0:FOR II=1 TO NN-1:IF LK(II) THEN 288 ELSE KT=1:FOR JJ=II+1 TO NN:IF ABS(RK(II)-RK(JJ))<0.1 THEN KT=KT+1:LK(JJ)=1
  151. 287  NEXT JJ:IF KT>1 THEN TC=TC+KT*KT*KT-KT
  152. 288  NEXT II:TC=TC/12:RETURN  'for Spearman & Rank Biserial.
  153. 339  '<UNK! {000A}>--- Date ---
  154. 340  DAT$=MID$(DATE$,4,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",-2+3*VAL(LEFT$(DATE$,2)),3)+" "+RIGHT$(DATE$,4):RETURN
  155. 349  '<UNK! {000A}>--- Number Sorter ---<UNK! {000A}>Convert numbers to sortable strings, then sort string array by:<UNK! {000A}>      DEF SEG: STRSORT=VARPTR(STRSORT%(0)):CALL STRSORT(n,x$(0))<UNK! {000A}>where n = no. of elements, & x$(0) = 1st element of string array (J. Dorner).
  156. 350  PRINT:INPUT"Maximum number of decimal places in your data (0-5)";NDP:IF NDP<0 OR NDP>5 THEN 350 ELSE I=NDP-(NDP>0)+(NDP=5):DP#=10^I    'DP enhanced if NDP=1-4 to ensure accurate estimates of medians
  157. 351  DEF FNNUM2STR$(X#,DP#,MXDIG%)=MID$("-0",(X#<0)+2,1)+RIGHT$(STRING$(MXDIG%,"0")+MID$(STR$(INT(X#*DP#)),2),MXDIG%)'<UNK! {000A}>    X=number, DP=dec factor, MXDIG=max digits/number (L. Rosenfelder)
  158. 352  DEC=10^(NDP+1):DEF FNROUND(X)=INT(X*DEC+0.5)/DEC  'Rounds to 1 dec more than in data entered.
  159. 353  DIM STRSORT%(33):RESTORE 354:FOR I=0 TO 33:READ STRSORT%(I):NEXT I:DEF SEG:STRSORT=VARPTR(STRSORT%(0)):RETURN
  160. 354  DATA &H5590,&HEC8B,&H1BA,&H8B00,&H876,&HC8B,&H7449,&H8B30
  161. 355  DATA &H676,&HDB33,&H1C8A,&H5646,&H8B51,&H37C,&H348B,&HCB8B
  162. 356  DATA &H5756,&HA6F3,&H5E5F,&HC7E,&HCB8B,&H58A,&H88A4,&HFF44
  163. 357  DATA &HF8E2,&HD233,&H5E59,&H4646,&HE246,&HBDC,&H74D2,&H5DC5
  164. 358  DATA &H4CA,&H0
  165. 359  '<UNK! {000A}>               --- Corel Specials ---
  166. 360  ZZ$=MID$(STR$(ZZ),2):IF OP<9 OR Q9=0 THEN RETURN
  167. 361  PRINT #2,"r("ZZ$")=";USING F$+"     ";R(I);:RETURN
  168. 362  ZZ=I:GOSUB 360:PRINT #2,"r("ZZ$")";:RETURN
  169. 363  R=(R(I)-R(J)*R(K))/SQR((1-R(J)*R(J))*(1-R(K)*R(K))):RETURN'<UNK! {000A}><UNK! {000A}>--- Set binomial X(I,B) = 0 or 1 ---
  170. 364  X=X(1,B):FOR I=2 TO N:IF X(I,B)>X THEN I=N ELSE IF X(I,B)<X THEN X=X(I,B):I=N
  171. 365  NEXT I:NB=0:FOR I=1 TO N:IF X(I,B)=X THEN X(I,B)=0 ELSE X(I,B)=1:NB=NB+1
  172. 366  NEXT I:RETURN'<UNK! {000A}><UNK! {000A}>--- Pearson r ---
  173. 370  A=0:B=0:C=0:D=0:E=0:FOR I=1 TO N:A=A+X(I,1):B=B+X(I,1)*X(I,1):C=C+X(I,2):D=D+X(I,2)*X(I,2):E=E+X(I,1)*X(I,2):NEXT I:B=B-A*A/N:D=D-C*C/N:E=E-A*C/N:R=E/SQR(B*D):DF=N-2:RQ=1-R*R:IF RQ>0 THEN T=R*SQR(DF/RQ):RETURN ELSE T=100000:RETURN
  174. 374  '<UNK! {000A}>--- Z for given P (Hastings p 191) ---
  175. 375  ET=SQR(LOG(1/P^2)):Z=ET-((2.30753+ET*0.27061)/(1+ET*(0.99229+ET*0.04481))):H=2.71828^(Z*Z/-2)/2.50663:RETURN'<UNK! {000A}><UNK! {000A}>--- Fisher's z ---
  176. 380  FZ=LOG((1+R)/(1-R))/2:SEZ=1/SQR(W):RETURN
  177. 381  Z=EXP(2*Z):RR=(Z-1)/(Z+1):RETURN
  178. 382  '<UNK! {000A}>--- Input & Validate Correlations for Partials ---
  179. 383  GOSUB 362:INPUT X$:GOSUB 390:IF L=501 OR L=-1 THEN 383 ELSE RETURN
  180. 384  '<UNK! {000A}>--- Input Correlations for Ave & Compares ---<UNK! {000A}>  Needs I, J.  Uses X$, L.  Returns X(I,J) & N.
  181. 385  INPUT;" r: ",X$:IF X$="" THEN 385 ELSE IF X$="/" THEN N=I-1:GOTO 387
  182. 386  GOSUB 390:IF L=501 OR L=-1 THEN 385 ELSE X(I,J)=VAL(X$)
  183. 387  RETURN
  184. 389  '<UNK! {000A}>--- Validate X$ as a number (uses L) ---
  185. 390  FOR L=1 TO LEN(X$):IF INSTR("+-.0123456789",MID$(X$,L,1))=0 THEN PLAY"L16O3CEL4>B":PRINT"  That contains a `non-numeric' entry.  Please re-do.":L=500
  186. 391  NEXT L:IF L=501 OR J=2 AND (OP=7 OR OP=8) THEN 393
  187. 392  IF VAL(X$)<=-1 OR VAL(X$)>=1 THEN BEEP:PRINT"  Correlations must be between -1 and +1.":L=-1
  188. 393  RETURN
  189. 394  '<UNK! {000A}>--- Start Showing Answers ---
  190. 395  CLS:GOSUB 160:PRINT #2,TAB(38-LEN(HD$)\2)HD$:PRINT #2,TAB(38-LEN(HD$)\2)STRING$(LEN(HD$),61);CHR$(10):RETURN
  191. 396  Q1=21:Q2=50:PRINT #2,TAB(Q1)VN$(1);TAB(Q2)VN$(2):PRINT #2,
  192. 397  PRINT #2,"First 3 data pairs:";:FOR I=1 TO 3:PRINT #2,TAB(Q1)X(I,1);TAB(Q2)X(I,2):NEXT I:PRINT #2,:PRINT #2,"Sample size, n"TAB(36)N:RETURN
  193. 399  '<UNK! {000A}>--- Start ---
  194. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  195. 401  DEFINT I-N,Q:Q$=CHR$(34):MXR=400:MXC=20
  196. 402  DIM I,J,K,L,M,N,Q,Z,X$,Y$,Z$,X(MXR,2),Z$(MXR),VN$(MXC),Q(MXC),RK(MXR),LK(MXR),ED$(1),E$(3),T$(9)  'T$()=type of correlation
  197. 403  T$(1)=" Pearson's r ":T$(2)=" Spearman's r ":T$(3)=" Point Biserial r ":T$(4)=" Rank Biserial r ":T$(5)=" Biserial r ":T$(6)=" Tetrachoric r "
  198. 404  C$=" Correlations ":T$(7)=" Averaging"+C$:T$(8)=" Comparing"+C$:T$(9)=" Partial"+C$
  199. 405  P5=0.5:Z5=1.96:Z9=2.5758:S$=SPACE$(10):F$="+##.###":ED$(0)="C#=Change, D#=Delete, X=Extra data, Null=Proceed":ED$(1)="C#=Change, Null=Proceed":STDF$="Student's t =#####.###  df =":CL$="% Confidence Limits for Rho"
  200. 406  RH$=" ="+F$+"  ! "+F$:F5$=CHR$(10)+"95"+CL$+RH$:F9$="99"+CL$+RH$
  201. 407  QB=1:CLOSE:CLS:Z$="M E N U   F O R   C O R R E L A T I O N S":GOSUB 46
  202. 408  LOCATE 3,8:PRINT"Press the NUMBER of your choice, and then press <ENTER> to run it.":PRINT STRING$(80,196)
  203. 409  LOCATE 6,1:K=16:PRINT"<UNK! {000A}>"TAB(K)"1 "T$(1)"<UNK! {000A}>"TAB(K)"2 "T$(2)"<UNK! {000A}>"TAB(K)"3 "T$(3)"<UNK! {000A}>"TAB(K)"4 "T$(4)"<UNK! {000A}>"TAB(K)"5 "T$(5);
  204. 410  PRINT"<UNK! {000A}>"TAB(K)"6 "T$(6)TAB(43)"<--Data from keyboard (not files).<UNK! {000A}>"TAB(K)"7 "T$(7)TAB(43)"<--Ditto.<UNK! {000A}>"TAB(K)"8 "T$(8)TAB(43)"<--Ditto.<UNK! {000A}>"TAB(K)"9 "T$(9)TAB(43)"<--Ditto, with 3-4 variables.<UNK! {000A}>"TAB(K-1)"10  Return to Main Menu.<UNK! {000A}>"
  205. 411  PRINT:LOCATE,K-3:INPUT"===>  Option (1-10) ";OP:IF OP=10 THEN 30 ELSE IF OP<1 OR OP>10 THEN PRINT"No, please enter a number from 1 to 10":GOTO 411 ELSE HD$=T$(OP):VER$="(RL,5)"
  206. 412  QB=3: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:IF OP>5 THEN 444 ELSE NEEDVARS=2
  207. 413  '<UNK! {000A}>                   --- Options 1 to 5 ---
  208. 414  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  209. 415  PRINT TAB(K)"OPEN                                                       OPEN"
  210. 416  PRINT TAB(K)"OPEN        Data can be from keyboard or disk file.        OPEN"
  211. 417  PRINT TAB(K)"OPEN Computes correlation between 2 variables from a sampleOPEN"
  212. 418  PRINT TAB(K)"OPEN  of 4-400 rows of paired measurements in Free Format. OPEN"
  213. 419  PRINT TAB(K)"OPEN   Only simple editing if data comes from disk file.   OPEN"
  214. 420  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  215. 421  PRINT TAB(K)"OPEN                                                       OPEN"
  216. 422  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE,,1
  217. 423  '<UNK! {000A}>--- Get Data ---
  218. 424  DO$="enter data from disk":GOSUB 20:PRINT:IF Z$="N" THEN 428
  219. 425  '<UNK! {000A}>--- Disk Entry ---
  220. 426  QD=1:MNR=4:MNC=2:GOSUB 80:GOSUB 5:GOTO 430
  221. 427  '<UNK! {000A}>--- K/b Entry ---
  222. 428  QD=0:PRINT"Ok, enter 4-400 paired values, 1 pair per line in Free Format, from keyboard.":IF OP>2 THEN PRINT TAB(5)"Note --->  Either can be the Binomial Variable, valued say 0 and 1."
  223. 429  I=1:M=2:Q=1:GOSUB 72
  224. 430  CLS:PRINT"Data read was:":FOR I=1 TO N:PRINT"Row #"MID$(STR$(I),2)": ";:FOR J=1 TO M:PRINT X(I,J);:NEXT J:PRINT:NEXT I:IF OP<6 AND N<4 THEN PRINT"Not enough rows to analyse.  Will you add others";:GOSUB 21:IF Z$="N" THEN 2 ELSE 441
  225. 431  '<UNK! {000A}>--- Edit ---
  226. 432  PRINT:PRINT ED$(QD);:INPUT Z$:IF Z$="" THEN 442 ELSE LZ$=CHR$(ASC(Z$) AND 95):I=VAL(MID$(Z$,2))
  227. 433  IF LZ$="C" THEN 435 ELSE IF QD THEN 434 ELSE IF LZ$="D" THEN 439 ELSE IF LZ$="X" THEN 440
  228. 434  BEEP:IF QD=0 AND (LZ$="C" OR LZ$="D") THEN PRINT"C or D need a valid row number.":GOTO 432 ELSE PRINT"WHAT?":GOTO 432
  229. 435  IF I<1 OR I>N THEN 434 ELSE GOSUB 200
  230. 436  PRINT"Change which variable # (1 or 2)";:INPUT Z$:IF Z$="" THEN 432 ELSE J=VAL(Z$):IF J<1 OR J>M THEN BEEP:GOTO 436
  231. 437  PRINT"Old value = "X(I,J)"     New value";:INPUT X$:IF X$="" THEN 432 ELSE FOR L=1 TO LEN(X$):IF INSTR("-+.0123456789",MID$(X$,L,1))=0 THEN PLAY"L16O3CEL4>B":PRINT"That contains a `non-numeric' entry.  Please re-do it.":GOTO 437
  232. 438  NEXT L:X(I,J)=VAL(X$):PRINT"New ";:IF X(I,J)<0 THEN NEG=1:GOTO 430 ELSE 430
  233. 439  IF I<1 OR I>N OR (N<5 AND OP<6) THEN GOSUB 40:GOTO 432 ELSE N=N-1:FOR K=I TO N:FOR L=1 TO M:X(K,L)=X(K+1,L):NEXT L:NEXT K:PRINT"Ok, Row"I"Deleted.":GOSUB 5:GOTO 430
  234. 440  IF N=MXR THEN PRINT"No, you have maximum rows already.":GOTO 432
  235. 441  PRINT"Ok, you can add up to"MXR-N"extra rows in Free Format.":I=N+1:N=0:Q=1:GOSUB 72:GOTO 430
  236. 442  IF OP>5 THEN RETURN ELSE IF OP=1 OR OP=5 THEN DO$="transform this data":GOSUB 20:IF Z$="Y" THEN GOSUB 250:GOTO 430
  237. 443  '<UNK! {000A}>--- Branch ---
  238. 444  IF OP=6 THEN 750
  239. 445  IF OP<6 AND VN$<>"Y" THEN VN$(1)="Var #1":VN$(2)="Var #2"
  240. 446  IF OP=1 OR OP=3 THEN GOSUB 43
  241. 447  ON OP GOTO 500,550,600,650,650,750,800,800,900:STOP
  242. 499  '<UNK! {000A}>--- Pearson ---
  243. 500  GOSUB 370:W=N-3:GOSUB 380:Z=FZ-Z5*SEZ:GOSUB 381:C1=RR:Z=FZ+Z5*SEZ:GOSUB 381:C2=RR:Z=FZ-Z9*SEZ:GOSUB 381:C3=RR:Z=FZ+Z9*SEZ:GOSUB 381:C4=RR:GOSUB 395
  244. 501  F23$="#########.###              ##########.###"
  245. 502  GOSUB 396:PRINT #2,"Mean"S$;USING F23$;A/N;C/N:PRINT #2,"S.D."S$;USING F23$;SQR(B/(N-1));SQR(D/(N-1))
  246. 503  PRINT #2,"SS  "S$;USING F23$;B;D:PRINT #2,"SP"S$S$;USING"     ##########.###";E
  247. 504  PRINT #2,CHR$(10);TAB(10);USING T$(1)+"="+F$+"     "+STDF$;R;T;:PRINT #2,DF:PRINT #2,USING F5$;C1;"&";C2:PRINT #2,USING F9$;C3;"&";C4
  248. 505  IF PR THEN J=1:K=2:GOSUB 190 ELSE PRINT:GOSUB 161:IF PR THEN GOSUB 165:GOTO 502
  249. 506  QB=3:DO$="edit or transform that data & re-run this test":GOSUB 20:IF Z$="Y" THEN 430 ELSE 10
  250. 549  '<UNK! {000A}>--- Spearman ---
  251. 550  GOSUB 350:CLS:GOSUB 43:Q=0:CONST=0:IF NEG=0 THEN 554 ELSE FOR I=1 TO N:IF X(I,1)<CONST THEN CONST=X(I,1)
  252. 551  IF X(I,2)<CONST THEN CONST=X(I,2)
  253. 552  NEXT I
  254. 553  FOR J=1 TO 2:FOR I=1 TO N:X(I,J)=X(I,J)-CONST:NEXT I:NEXT J
  255. 554  FOR J=1 TO 2:FOR I=1 TO N:Z$(I-1)=FNNUM2STR$(X(I,J),DP#,8):NEXT I
  256. 555  DEF SEG:STRSORT=VARPTR(STRSORT%(0)):CALL STRSORT(N,Z$(0))
  257. 556  Q=J:NN=N:GOSUB 280:IF J=2 THEN TY=TC ELSE TX=TC:FOR I=1 TO N:X(I,0)=RK(I):NEXT I
  258. 557  NEXT J
  259. 558  FOR I=1 TO N:SUMDSQ=SUMDSQ+(RK(I)-X(I,0))^2:NEXT I
  260. 559  DF=N-2:ZN=N*N*N-N:TC=TX+TY:IF TC>0.1 THEN 562
  261. 560  R=1-SUMDSQ/ZN*6:RQ=1-R*R:IF RQ>0 AND N>13 THEN T=R*SQR(DF/RQ)
  262. 561  GOTO 565
  263. 562  SSX=ZN/12-TX:SSY=ZN/12-TY:R=(SSX+SSY-SUMDSQ)/2/SQR(SSX*SSY):RQ=1-R*R:IF RQ>0 AND N>13 THEN T=R*SQR(DF/RQ) ELSE T=100000
  264. 563  R2=1-(SUMDSQ+TC)/ZN*6:RQ=1-R2*R2:IF RQ>0 AND N>13 THEN T2=R2*SQR(DF/RQ) ELSE T2=100000
  265. 564  '<UNK! {000A}>--- Spearman Answers ---
  266. 565  PS$="  (Langley, `PRAC STATS', p 204)"
  267. 566  GOSUB 395:FOR I=1 TO 3:X(I,1)=X(I,1)+CONST:X(I,2)=X(I,2)+CONST:NEXT I
  268. 567  GOSUB 396:IF TC>0.1 THEN 570
  269. 568  PRINT #2,CHR$(10)"No ties."STRING$(2,10)"    Sum D Squared ="SUMDSQ;PS$
  270. 569  PRINT #2,TAB(4);USING T$(2)+" ="+F$;R:IF N>13 AND RQ>0 THEN PRINT #2,TAB(5)USING STDF$;T;:PRINT #2,DF:GOTO 574 ELSE PRINT #2,:GOTO 574
  271. 570  PRINT #2,CHR$(10)"Ties present, so for AGREEMENT between "VN$(1)" & "VN$(2)":":PRINT #2,"    Sum D Squared ="SUMDSQ;PS$
  272. 571  PRINT #2,TAB(4)T$(2)" =";USING F$;R;:IF N>13 AND T<>100000 THEN PRINT #2,TAB(5)USING STDF$;T;:PRINT #2,DF ELSE PRINT #2,
  273. 572  PRINT #2,CHR$(10)"or....for ACCURACY of "VN$(1)" or "VN$(2)":":PRINT #2,"    Sum D Squared + Tie Correction ="SUMDSQ+TC;PS$
  274. 573  PRINT #2,TAB(4);USING T$(2)+" ="+F$;R2;:IF N>13 AND T2<>100000 THEN PRINT #2,TAB(5)USING STDF$;T2;:PRINT #2,DF ELSE PRINT #2,
  275. 574  IF PR THEN J=1:K=2:GOSUB 190 ELSE GOSUB 161:IF PR THEN GOSUB 165:GOTO 567
  276. 575  GOTO 10
  277. 599  '<UNK! {000A}>--- Point Biserial ---
  278. 600  GOSUB 370:GOSUB 395
  279. 601  GOSUB 396
  280. 602  PRINT #2,:PRINT#2,TAB(7)T$(3)" =";USING F$;R;:PRINT #2,TAB(40)USING STDF$;T;:PRINT #2,DF:PRINT #2,CHR$(10)TAB(18)"95% & 99"CL$":":PRINT #2,TAB(8)"See Perry & Michael, `EDUC.PSYCHOL.MSMT.' 1954, p. 715"
  281. 603  IF PR THEN J=1:K=2:GOSUB 190 ELSE GOSUB 161:IF PR THEN GOSUB 165:GOTO 601
  282. 604  GOTO 10
  283. 649  '<UNK! {000A}>--- Rank Bis r ---
  284. 650  INPUT"<UNK! {000A}>Which # is your binomial variable (1 or 2)";B:IF B<1 OR B>2 THEN GOSUB 40:GOTO 650 ELSE PRINT"Ok, I will recode that variable to 0 and 1 (if it's not already scored so).":PRINT:GOSUB 5:GOSUB 43:IF OP=5 THEN 700
  285. 651  NN=N:Q=3-B:GOSUB 280:GOSUB 364
  286. 652  FOR I=1 TO N:XY=XY+RK(I)*X(I,B):NEXT I:R=(2*XY/NB-N-1)/(N-NB):GOSUB 395
  287. 653  GOSUB 396:PRINT #2,"<UNK! {000A}><UNK! {000A}>"TAB(20)T$(4)" =";USING F$;R:PRINT #2,CHR$(10)TAB(12)"Use Wilcoxon's Sum of Ranks for Significance."
  288. 654  IF PR THEN J=1:K=2:GOSUB 190 ELSE GOSUB 161:IF PR THEN GOSUB 165:GOTO 653
  289. 655  GOTO 10
  290. 699  '<UNK! {000A}>--- Biserial r ---
  291. 700  GOSUB 364:GOSUB 370:P=NB/N:GOSUB 375:R=R*SQR(P*(1-P))/H:T=R*H*SQR(N/P/(1-P)):GOSUB 395
  292. 701  GOSUB 396:PRINT #2,:PRINT #2,"Assuming the binomial variable really has a Normal Distribution:"
  293. 702  PRINT #2,:PRINT #2,TAB(9)T$(5)" =";USING F$;R;:PRINT #2,TAB(37)USING STDF$;T;:PRINT #2,DF
  294. 703  IF PR THEN J=1:K=2:GOSUB 190 ELSE GOSUB 161:IF PR THEN GOSUB 165:GOTO 701
  295. 704  GOTO 10
  296. 749  '<UNK! {000A}>--- Tetrachoric ---
  297. 750  PRINT"Enter cell frequencies in this 2 x 2 contingency table:":LOCATE 6,1
  298. 751  PRINT TAB(18)"            +                -"
  299. 752  PRINT TAB(18)  "KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  300. 753  PRINT TAB(16)"+ OPEN     A:               B:                  OPEN"
  301. 754  PRINT TAB(18)  "OPEN                                          OPEN"
  302. 755  PRINT TAB(16)"- OPEN     C:               D:                  OPEN"
  303. 756  PRINT TAB(18)  "OPEN                                          OPEN"
  304. 757  PRINT TAB(18)  "SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE,,1
  305. 758  LOCATE 8,28,,6,7:INPUT;" ",A:LOCATE 8,45:INPUT;" ",B:LOCATE 10,28:INPUT;" ",C:LOCATE 10,45:INPUT;" ",D:LOCATE 13,1,,7,7
  306. 759  R=COS(3.14159/(1+SQR(A*D/B/C))):R1=A+B:R2=C+D:C1=A+C:C2=B+D:N=R1+R2
  307. 760  P=R1/N:GOSUB 375:H1=H:P=C1/N:GOSUB 375:T=R*H1*H*SQR(N/R1*N/R2*N/C1*N/C2*N)
  308. 761  U$="Assuming both variables really have Normal Distributions, and using the         Cosine PI Formula:":T$="        Z =###.##":GOSUB 160:PRINT#2,SPACE$(20)
  309. 762  PRINT #2,U$:PRINT #2,:PRINT #2,TAB(17);T$(6)" =";USING F$+T$;R;T
  310. 763  GOSUB 161:IF PR=0 THEN 771 ELSE GOSUB 165
  311. 764  PRINT #2,TAB(18)"            +                -"
  312. 765  PRINT #2,TAB(18)         "+------------------------------------------+"
  313. 766  PRINT #2,TAB(16);USING "+ |      A:#####          B:#####            |";A;B
  314. 767  PRINT #2,TAB(18)         "|                                          |"
  315. 768  PRINT #2,TAB(16);USING "- |      C:#####          D:#####            |";C;D
  316. 769  PRINT #2,TAB(18)         "+------------------------------------------+"
  317. 770  PRINT #2,:PRINT #2,U$:PRINT #2,:PRINT #2,TAB(17);T$(6)" =";USING F$+T$;R;T
  318. 771  GOSUB 193:GOTO 10
  319. 799  '<UNK! {000A}>--- Ave r & Comparing r's ---
  320. 800  PRINT"Enter your"C$"& Sample Sizes, with `/' End-Signal:":M=2:N=0:I=0
  321. 801  I=I+1:J=1:PRINT:PRINT"#"I;:GOSUB 385:IF N THEN 804
  322. 802  J=2:LOCATE ,20:INPUT;"n: ",X$:IF X$="" THEN 802 ELSE IF RIGHT$(X$,1)="/" THEN X$=LEFT$(X$,LEN(X$)-1):IF X$>"" THEN N=I ELSE GOSUB 40:GOTO 802
  323. 803  GOSUB 390:IF L=501 THEN 802 ELSE IF VAL(X$)<1 THEN GOSUB 40:GOTO 802 ELSE X(I,J)=VAL(X$):IF N=0 THEN 801
  324. 804  PRINT:GOSUB 432:GOSUB 43
  325. 805  CS$="Sample Sizes   "+C$+"   Fisher's z":INF$=" Infinity":U$="Using Fisher's z:":FC$="####         +##.#####      +##.#####"
  326. 806  FOR I=1 TO N:R=X(I,1):W=X(I,2)-3:GOSUB 380:RK(I)=FZ:TOP=TOP+W*FZ:BOT=BOT+W:SQ=SQ+W*FZ*FZ:NEXT I
  327. 807  ZBAR=TOP/BOT:Z=ZBAR:GOSUB 381:RBAR=RR:SE=1/SQR(BOT):TAV=ZBAR/SE:Z=ZBAR-Z5*SE:GOSUB 381:C1=RR:Z=ZBAR+Z5*SE:GOSUB 381:C2=RR:Z=ZBAR-Z9*SE:GOSUB 381:C3=RR:Z=ZBAR+Z9*SE:GOSUB 381:C4=RR
  328. 808  GOSUB 395
  329. 809  PRINT #2,CS$:FOR I=1 TO N:ZZ=I:GOSUB 360:PRINT #2,"#"ZZ$"= ";USING FC$;X(I,2);X(I,1);RK(I):IF I MOD 20=0 THEN GOSUB 5
  330. 810  NEXT I:PRINT #2,:IF OP=8 THEN 850 ELSE PRINT #2,U$
  331. 811  PRINT #2,USING"Ave r ="+F$+"     "+STDF$+INF$;RBAR;TAV:PRINT #2,USING F5$;C1;"&";C2:PRINT #2,USING F9$;C3;"&";C4
  332. 812  IF PR THEN GOSUB 193 ELSE GOSUB 161:IF PR THEN GOSUB 165:ON OP-6 GOTO 809,851:STOP
  333. 813  GOTO 10
  334. 849  '<UNK! {000A}>--- Comparing r's, contd ---
  335. 850  TE$="Test of Equality of Independent"+C$+U$:INS$="If not significant, pooling gives:"
  336. 851  IF N=2 THEN T=(RK(1)-RK(2))/(SQR(1/(X(1,2)-3)+1/(X(2,2)-3))):PRINT #2,TE$:PRINT #2,USING STDF$+INF$;T:PRINT #2,:PRINT #2,INS$:GOTO 811
  337. 852  CH$="       Chi squared =####.##    df =###":CH=SQ-TOP*TOP/BOT:PRINT #2,TE$:PRINT #2,USING CH$;CH;N-1:PRINT #2,:PRINT #2,INS$:GOTO 811
  338. 899  '<UNK! {000A}>--- Partials ---
  339. 900  QB=1:P$=" ORDER PARTIALS:  ":P1$="<UNK! {000A}><UNK! {000A}>1st"+P$:P2$="<UNK! {000A}><UNK! {000A}>2nd"+P$
  340. 901  ERASE X,RK:DIM X(40),R(40)
  341. 902  INPUT"How many variables (3 or 4)";N:IF N<3 OR N>4 THEN BEEP:GOTO 902 ELSE GOSUB 160:IF N=4 THEN 908
  342. 903  X(0)=12.3:X(1)=13.2:X(2)=23.1:I=12:PRINT:GOSUB 383:R(I)=VAL(X$):I=13:PRINT:GOSUB 383:R(I)=VAL(X$):I=23:PRINT:GOSUB 383:R(I)=VAL(X$):GOSUB 43
  343. 904  Q9=1:I=12:J=13:K=23:GOSUB 363:R(0)=R:I=13:J=12:GOSUB 363:R(1)=R:I=23:K=13:GOSUB 363:R(2)=R:PQ=1:GOSUB 395
  344. 905  PRINT #2,"DATA:  ";:I=12:ZZ=I:GOSUB 360:I=13:ZZ=I:GOSUB 360:I=23:ZZ=I:GOSUB 360:PRINT #2,P1$;:FOR I=0 TO 2:ZZ=X(I):GOSUB 360:NEXT I:PRINT #2,
  345. 906  IF PR THEN GOSUB 193 ELSE GOSUB 161:IF PR THEN GOSUB 165:GOTO 905
  346. 907  GOTO 10
  347. 908  X(0)=12.3:X(1)=12.4:X(2)=13.2:X(3)=13.4:X(4)=14.2:X(5)=14.3:X(6)=23.1:X(7)=23.4:X(8)=24.1:X(9)=24.3:X(10)=34.1:X(11)=34.2:X(35)=12.34:X(36)=13.24:X(37)=14.23:X(38)=23.14:X(39)=24.13:X(40)=34.12
  348. 909  PRINT:FOR I=12 TO 14:GOSUB 383:R(I)=VAL(X$):NEXT I:FOR I=23 TO 24:GOSUB 383:R(I)=VAL(X$):NEXT I:I=34:GOSUB 383:R(I)=VAL(X$):GOSUB 43
  349. 910  I=12:J=13:K=23:GOSUB 363:R(0)=R:J=14:K=24:GOSUB 363:R(1)=R:I=13:J=12:K=23:GOSUB 363:R(2)=R:J=14:K=34:GOSUB 363:R(3)=R:I=14:J=12:K=24:GOSUB 363:R(4)=R
  350. 911  I=14:J=13:K=34:GOSUB 363:R(5)=R:I=23:J=12:K=13:GOSUB 363:R(6)=R:I=23:J=24:K=34:GOSUB 363:R(7)=R:I=24:J=12:K=14:GOSUB 363
  351. 912  R(8)=R:J=23:K=34:GOSUB 363:R(9)=R:I=34:J=13:K=14:GOSUB 363:R(10)=R:J=23:K=24:GOSUB 363:R(11)=R
  352. 913  I=0:J=5:K=9:GOSUB 363:R(35)=R:I=2:J=4:K=11:GOSUB 363:R(36)=R:I=4:J=2:GOSUB 363:R(37)=R:I=6:J=8:K=10:GOSUB 363
  353. 914  R(38)=R:I=8:J=6:GOSUB 363:R(39)=R:I=10:K=8:GOSUB 363:R(40)=R:GOSUB 395
  354. 915  Q9=1:PRINT #2,"DATA:":FOR I=12 TO 14:ZZ=I:GOSUB 360:NEXT I:PRINT #2,:FOR I=23 TO 24:ZZ=I:GOSUB 360:NEXT I:I=34:ZZ=I:GOSUB 360:PRINT #2,P1$
  355. 916  FOR I=0 TO 2:ZZ=X(I):GOSUB 360:NEXT I:PRINT #2,:FOR I=3 TO 5:ZZ=X(I):GOSUB 360:NEXT I:PRINT #2,
  356. 917  FOR I=6 TO 8:ZZ=X(I):GOSUB 360:NEXT I:PRINT #2,:FOR I=9 TO 11:ZZ=X(I):GOSUB 360:NEXT I:PRINT #2,P2$:FOR I=35 TO 37:ZZ=X(I):GOSUB 360:NEXT I:PRINT #2,
  357. 918  FOR I=38 TO 40:ZZ=X(I):GOSUB 360:NEXT I:PRINT #2,
  358. 919  IF PR THEN GOSUB 193 ELSE GOSUB 161:IF PR THEN GOSUB 165:GOTO 915
  359. 920  GOTO 10
  360. 921  END
  361.