home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / dstat.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-03-06  |  17.4 KB  |  293 lines
  1. 1  '     DESCRIPTIVE STATISTICS  ---  DSTAT.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 403,177,435,30:STOP  '=start,printout,cmd-prompt,quit.<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 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 #87
  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.":RETURN
  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  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. 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.
  37. 70  PRINT"Enter data from keyboard, ";:IF M=1 THEN PRINT "pressing <Enter> after each number.":GOTO 72
  38. 71  PRINT"in Free Format, pressing <Enter> at end of each row.":IF UT THEN 73
  39. 72  PRINT"Null entry duplicates previous row.  Signal `end-of-data' by entering a `/'"
  40. 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
  41. 74  IF RIGHT$(X$,1)="/" THEN X$=LEFT$(X$,LEN(X$)-1):N=I+(X$=""):IF X$="" THEN 76
  42. 75  GOSUB 50:IF N=0 THEN IF I<MXR THEN I=I+1:GOTO 73 ELSE N=MXR
  43. 76  RETURN
  44. 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.
  45. 80  QD=1:IO$="I":GOSUB 110:CLS:PRINT "Loading data from disk.":INPUT #1,FL$,VR$
  46. 81  IF LEFT$(VR$,4)<>"(RL," THEN BEEP:PRINT "Unreadable file --- not made by our Data Filer/Editor program.":GOTO 86
  47. 82  INPUT #1,DT$,ID$,N,M,UT,VN$:PRINT "Filename: "FL$,"Made: "DT$,"Version: "VR$:PRINT"ID: "ID$:PRINT
  48. 83  IF UT>0 AND ZZ$<>"UTOK" THEN PRINT "This file is an upper triangular matrix, which this program can't use!":GOTO 86
  49. 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
  50. 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
  51. 86  CLOSE:BEEP:GOSUB 5:ERROR 210
  52. 87  '   Select variables
  53. 88  PRINT:IF VN$="N" THEN PRINT "The"M"variables are not named.":GOTO 90
  54. 89  PRINT "Variables in file are:":FOR J=1 TO M:INPUT #1,VN$(J):PRINT J;VN$(J),:NEXT J:PRINT
  55. 90  IF M=MNC OR UT>0 THEN 100 ELSE PRINT
  56. 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
  57. 92  IF NEEDVARS=1 THEN PRINT"This test analyses only 1 column variable at a time.":ND=M-1
  58. 93  IF NEEDVARS=2 THEN PRINT"This test analyses only 2 column variables.":ND=M-2
  59. 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
  60. 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
  61. 96  Q(0)=1:MM=M:M=ND:GOSUB 50:Q(0)=0:M=MM
  62. 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
  63. 98  NEXT J
  64. 99  '   Now read numerical data from disk
  65. 100  PRINT:COLOR 23,0:PRINT"Loading numbers";:COLOR 7,0:FOR I=1 TO N:KK=1:LL=1:L=M
  66. 101  FOR J=1 TO L:INPUT #1,Z
  67. 102  IF J=Q(KK) THEN KK=KK+1 ELSE X(I,LL)=Z:LL=LL+1
  68. 103  NEXT J:NEXT I:CLOSE:LOCATE,1:PRINT SPACE$(15):M=M-ND:RETURN
  69. 109  '<UNK! {000A}>--- Get Filespec ---
  70. 110  IF IO$="O" THEN STOP
  71. 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)
  72. 112  ER=0:FOR I=1 TO LEN(FL$):Z$=MID$(FL$,I,1):IF INSTR(" .,/\|?*:;[]+="+CHR$(34),Z$) THEN ER=1
  73. 113  NEXT I
  74. 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
  75. 115  INPUT "Which drive (A,B,C,D)";DR$:IF DR$="" THEN 115
  76. 116  DR$=CHR$(ASC(DR$) AND 95):IF INSTR("ABCD",DR$)=0 THEN 115
  77. 117  INPUT "Which directory (e.g. WORK, MYDATA, or Null Entry if root) ";DR2$:IF DR2$="" THEN DR$=DR$+":" ELSE DR$=DR$+":\"+DR2$+"\"
  78. 129  '<UNK! {000A}>*** Open File, IO$= "I" ***
  79. 130  IF IO$="O" THEN STOP
  80. 131  '
  81. 132  '
  82. 133  '
  83. 134  ON ERROR GOTO 136:OPEN DR$+FL$ FOR INPUT AS #1  'for input
  84. 135  ON ERROR GOTO 30:RETURN   'input #1,A$,B$:close
  85. 136  PRINT FL$" not found on Drive "DR$:RESUME 137
  86. 137  GOSUB 5:ON ERROR GOTO 30:CLS:ERASE X:SHELL "DIR "+DR$+"/W":GOSUB 5:DIM X(MXR,MXC):GOTO 110 ' or replace MXC ....
  87. 159  '<UNK! {000A}>--- Show/Print Answers ---
  88. 160  QB=3:PR=0:CLOSE:OPEN "SCRN:" FOR OUTPUT AS #2:RETURN
  89. 161  DO$="print these results":GOSUB 20:IF Z$="N" THEN PR=0:RETURN
  90. 162  PR=1:IF ID$="" THEN LINE INPUT "Problem ID? ";ID$:GOTO 164
  91. 163  LINE INPUT"Problem ID (null = unchanged)? ";Z$:IF Z$>"" THEN ID$=Z$
  92. 164  RETURN
  93. 165  QB=2:CLS:LOCATE 8,1
  94. 166  PRINT TAB(12)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  95. 167  PRINT TAB(12)"OPEN                                                       OPEN"
  96. 168  PRINT TAB(12)"OPEN                TURN  PRINTER  ON.                     OPEN"
  97. 169  PRINT TAB(12)"OPEN                                                       OPEN"
  98. 170  PRINT TAB(12)"OPEN    Then PRESS <ENTER> to start printing ..... or ..   OPEN"
  99. 171  PRINT TAB(12)"OPEN                                                       OPEN"
  100. 172  PRINT TAB(12)"OPEN    To send Printer Codes in Basic before printing,    OPEN"
  101. 173  PRINT TAB(12)"OPEN    press <Ctrl-Break>, & start printing by GOTO 9.    OPEN"
  102. 174  PRINT TAB(12)"OPEN                                                       OPEN"
  103. 175  PRINT TAB(12)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":IN$=INKEY$
  104. 176  IN$=INKEY$:IF IN$<>CHR$(13) THEN 176
  105. 177  CLS:PRINT"Printing .....":LOCATE 4,1:CLOSE:OPEN "LPT1:" FOR OUTPUT AS #2
  106. 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$=""
  107. 179  PRINT #2,CHR$(10)"Problem: "ID$;CHR$(10)
  108. 180  RETURN
  109. 189  '<UNK! {000A}>*** Print Data ***<UNK! {000A}>   Needs X( , ) & QS=1 if Scattergram.
  110. 190  DO$="print all the data used":GOSUB 20:IF Z$="N" THEN 193
  111. 191  PRINT #2,"DATA USED: "VN$(J);:IF QS=0 THEN PRINT #2,:FOR I=1 TO N:PRINT #2,X(I,J);:NEXT I:PRINT #2,:GOTO 193
  112. 192  PRINT #2,", & "VN$(K):FOR I=1 TO N:PRINT #2,X(I,J);X(I,K),:NEXT I
  113. 193  PR=0:PRINT #2,:CLOSE:RETURN
  114. 199  '<UNK! {000A}>--- Show a Row of Data ---
  115. 200  PRINT"Row"STR$(I)": ";:FOR J=1 TO M:PRINT X(I,J);:NEXT J:PRINT:RETURN
  116. 209  '<UNK! {000A}>--- Varnames ---
  117. 210  IF VN$="Y" THEN RETURN ELSE FOR J=1 TO M:IF J<10 THEN VN$(J)="Var #"+STR$(J) ELSE VN$(J)="Var #"+MID$(STR$(J),2)
  118. 211  NEXT J:RETURN
  119. 229  '<UNK! {000A}>--- Stats of X(I,J), I=II to NN  (for Sample Q if NS>1) ---
  120. 230  S1=0:S2=0:S3=0:S4=0:SM=X(II,J):GR=SM:FOR I=II TO NN:X=X(I,J)-X(II,J):S1=S1+X:S2=S2+X*X:S3=S3+X*X*X:S4=S4+X*X*X*X:IF X(I,J)<SM THEN SM=X(I,J) ELSE IF X(I,J)>GR THEN GR=X(I,J)
  121. 231  NEXT I:IF GR-SM<9.999E-06 THEN 237
  122. 232  NN=NN-II+1:AV=S1/NN:SS=S2-S1*AV:VA=SS/(NN-1):SD=SQR(VA):SE=SQR(VA/NN):VAN=SS/NN:SDN=SQR(VAN)
  123. 233  SKEW=(S3-3*S2*AV+2*AV^3*NN)/SQR(SS^3/NN):ZSKEW=SKEW/SQR(6*(NN-2)/((NN+1)*(NN+3))):CURT=(S4-4*S3*AV+6*S2*AV^2-3*AV^4*NN)/(SS^2/NN):ZCURT=(CURT-3)/SQR(24/NN)
  124. 234  AV=AV+X(II,J):TG1=(AV-SM)/SD:TG2=(GR-AV)/SD
  125. 236  RETURN
  126. 237  LOCATE,1:PRINT"Fatal Error.  Var #"J"has no variation.":GOSUB 5:END
  127. 249  '<UNK! {000A}>--- Transform Sub ---
  128. 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";
  129. 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)"
  130. 252  PRINT"<UNK! {000A}>"TAB(10)"Negative codes reverse transforms (e.g. -3 = Antilog)<UNK! {000A}>":LOCATE,,1
  131. 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
  132. 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
  133. 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
  134. 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
  135. 257  GOSUB 43:A=57.2958:B=0.434294:Z=0:U=1:H=100:P5=0.5:P9=0.99999:E$(0)=""
  136. 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
  137. 259  X(I,K)=X(I,K)/H
  138. 260  IF X(I,K)>P9 THEN X(I,K)=P9 ELSE IF X(I,K)<Z THEN 272
  139. 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
  140. 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
  141. 263  X(I,K)=X(I,K)+U
  142. 264  IF X(I,K)>Z THEN X(I,K)=B*LOG(X(I,K)):GOTO 271 ELSE 272
  143. 265  X(I,K)=EXP(X(I,K)/B):IF T%=-3 THEN 271 ELSE X(I,K)=X(I,K)-U:GOTO 271
  144. 266  X(I,K)=X(I,K)+U
  145. 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
  146. 268  X(I,K)=X(I,K)+P5
  147. 269  IF X(I,K)>=Z THEN X(I,K)=SQR(X(I,K)):GOTO 271 ELSE T%=7:GOTO 272
  148. 270  X(I,K)=X(I,K)*X(I,K):IF T%=-8 THEN X(I,K)=X(I,K)-P5
  149. 271  NEXT I:NEXT J:IF E$(0)=""THEN GOSUB 44:GOTO 273
  150. 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
  151. 273  RETURN
  152. 289  '<UNK! {000A}>--- Scattergram Sub ---
  153. 290  QS=1:C$="*23456789ABCDEFGHIJKLMNOPQRSTUVWXYZ#":S$=SPACE$(6):S12$=SPACE$(12):P5=0.5:IF QDIM=0 THEN DIM XP(5),O$(41)
  154. 291  QDIM=1:INPUT "Horizontal Var # ";J:IF J<1 OR J>M THEN 291 ELSE L=J
  155. 292  IF M>2 THEN INPUT "Vertical   Var # ";K:IF K<1 OR K>M OR K=J THEN 292 ELSE 293 ELSE IF J=1 THEN K=2 ELSE K=1
  156. 293  GOSUB 43
  157. 294  SM=X(1,L):GR=SM:FOR I=2 TO N:Z=X(I,L):IF Z<SM THEN SM=Z ELSE IF Z>GR THEN GR=Z
  158. 295  NEXT I
  159. 296  IF GR-SM<9.999E-06 THEN BEEP:J=L:LOCATE ,1:PRINT"Can't proceed. Var"J"has no variation.":GOSUB 5:GOTO 331 ELSE IF L=J THEN H=4 ELSE H=1.5'<UNK! {000A}>  Select Scales
  160. 297  Q=1:KT=0
  161. 298  R=GR-SM:C=SM
  162. 299  IF R<=1 THEN KT=KT+1:R=R*10:GOTO 299
  163. 300  IF R>10 THEN KT=KT-1:R=R/10:GOTO 300
  164. 301  IF Q>2 THEN 303 ELSE C=C*10^KT:IF C<0 AND C<>INT(C) THEN C=C-1
  165. 302  C=INT(C)/10^KT:R=(GR-C)/H:KT=0:Q=Q+2:GOTO 299
  166. 303  F=INT(R):IF F<>R THEN F=F+1
  167. 304  IF R<P5 THEN F=F-P5
  168. 305  F=F/10^KT:IF Q<>4 THEN IF(GR-SM)/(H*F)<=0.8 THEN KT=1:Q=2:GOTO 298
  169. 306  SM=C:D=F*INT(C/F):IF D<0 AND D<>C THEN D=D-F
  170. 307  IF D+H*F>=GR THEN SM=D
  171. 308  IF L=J THEN X=SM:U=F:L=K:GOTO 294 ELSE Y=SM:V=F'<UNK! {000A}>  Rpt with Y, then--<UNK! {000A}>  Calc r
  172. 309  IF PR=1 THEN 312 ELSE A=0:B=0:C=0:D=0:E=0
  173. 310  FOR I=1 TO N:A=A+X(I,J):B=B+X(I,J)*X(I,J):C=C+X(I,K):D=D+X(I,K)*X(I,K):E=E+X(I,J)*X(I,K):NEXT I
  174. 311  E=E-A*C/N:B=B-A*A/N:D=D-C*C/N:PEAR=E/SQR(B*D)
  175. 312  NX=41:LX=5:NY=16:A=10/U:B=10/V:IF PR=0 THEN GOSUB 160:CLS ELSE GOSUB 165
  176. 313  PRINT #2,"SCATTERGRAM"S$"n ="STR$(N)S$"PEARSON'S r =";USING"+##.###     (*=1, A=10, !=36 or more)";PEAR;"#":PRINT #2,'<UNK! {000A}>  Scan data points to be plotted
  177. 314  O=0:FOR KN=1 TO LX:XP(KN)=X+O*U:O=O+1:NEXT KN
  178. 315  FOR I=1 TO NY:Q=I-1:IL=NY-Q:FOR II=1 TO NX:O$(II)=" ":NEXT II
  179. 316  FOR L=1 TO N:IX=((X(L,J)-X)*A)+1:IF IX<1 OR IX>NX THEN 320 ELSE IY=((X(L,K)-Y)*B)+1:IF IY<>IL THEN 320 ELSE IF O$(IX)=" " THEN O$(IX)="*":GOTO 320
  180. 317  IF O$(IX)="#" THEN 320
  181. 318  FOR KK=1 TO 35:IF O$(IX)=MID$(C$,KK,1) THEN O$(IX)=MID$(C$,KK+1,1):KK=35
  182. 319  NEXT KK
  183. 320  NEXT L'<UNK! {000A}>  Print a line
  184. 321  FOR L=41 TO 1 STEP -1:IF O$(L)=" " THEN NEXT L:LN=1 ELSE LN=L
  185. 322  IF Q MOD 5 <>0 THEN 325
  186. 323  O=H-Q/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 327
  187. 324  IY=INT(D+P5):PRINT #2,USING"############";IY;:PRINT #2,"+ ";:FOR L=1 TO LN:PRINT #2,O$(L);:NEXT L:GOTO 327
  188. 325  IF I<>3 THEN PRINT #2,S12$; ELSE PRINT #2,USING"\        \  ";VN$(K);
  189. 326  PRINT #2,"| ";:FOR L=1 TO LN:PRINT #2,O$(L);:NEXT L
  190. 327  PRINT #2,:NEXT I'<UNK! {000A}>  Print X-axis
  191. 328  PRINT #2,S12$"  +";:FOR I=1 TO 4:PRINT #2,"---------+";:NEXT I:PRINT #2,:PRINT #2,S$;
  192. 329  FOR I=1 TO LX:PRINT #2,USING"########.#";XP(I);:NEXT I:PRINT #2,:PRINT #2,S12$S12$S$;VN$(J)
  193. 330  IF PR THEN PRINT #2,:GOSUB 190 ELSE GOSUB 161:IF PR THEN L=J:GOTO 294
  194. 331  QS=0:CLOSE:RETURN
  195. 339  '<UNK! {000A}>--- Date ---
  196. 340  DAT$=MID$(DATE$,4,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",-2+3*VAL(LEFT$(DATE$,2)),3)+" "+RIGHT$(DATE$,4):RETURN
  197. 399  '<UNK! {000A}>--- Start ---
  198. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  199. 401  DEFINT I-N,Q:MXR=400:MXC=20:Q$=CHR$(34)
  200. 402  DIM I,J,K,L,M,N,X$,Y$,Z$,C$,KN,I2,KK,X(MXR,MXC),VN$(MXC),N(14),PE(14),E$(3)
  201. 403  QB=4:HD$=" D E S C R I P T I V E    S T A T I S T I C S ":VER$="(RL,10)"
  202. 404  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
  203. 405  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  204. 406  PRINT TAB(K)"OPEN                                                       OPEN"
  205. 407  PRINT TAB(K)"OPEN     Computes Univariate &/or Bivariate statistics.    OPEN"
  206. 408  PRINT TAB(K)"OPEN        Data can be from keyboard or disk file.        OPEN"
  207. 409  PRINT TAB(K)"OPEN     Features vetted Free Format entry for numbers.    OPEN"
  208. 410  PRINT TAB(K)"OPEN           Max rows = 400.   Max cols = 20.            OPEN"
  209. 411  PRINT TAB(K)"OPEN       Printouts available after viewing answers.      OPEN"
  210. 412  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  211. 413  PRINT TAB(K)"OPEN                                                       OPEN"
  212. 414  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE ,,1
  213. 415  P5=0.5:S$=SPACE$(6):H$=" = Histogram & Statistics":SC$="Scattergram"
  214. 416  FA$="### ###   <+#.#:":FB$="### ###   >+#.#:":F3$="##.#":F4$="=####":F6$="=###.##":F7$="=####.##":F8$="=########":F1$="=########.##"
  215. 417  FOR J=1 TO 7:READ PE(J):PE(15-J)=PE(J):NEXT:DATA .00135,.00486,.01654,.044057,.091848,.149883,.191462
  216. 418  '<UNK! {000A}>--- Get Data ---
  217. 419  DO$="enter data from disk":GOSUB 20:QB=1:PRINT:IF Z$="N" THEN 423
  218. 420  '<UNK! {000A}>--- Disk Entry ---
  219. 421  MNR=3:MNC=1:GOSUB 80:GOSUB 210:GOTO 430
  220. 422  '<UNK! {000A}>--- K/b Entry ---
  221. 423  PRINT"No. of variables (cols, 1-"MID$(STR$(MXC),2)")";:INPUT M:IF M<1 OR M>MXC THEN 423
  222. 424  PRINT"Variable Names (1-10 letters each) 1 per line, or Null Entry if no names:":FOR J=1 TO M
  223. 425  PRINT"Var"J"? ";:LINE INPUT VN$(J):IF VN$(1)="" THEN VN$="N":J=M:GOTO 427 ELSE VN$="Y"
  224. 426  IF INSTR(VN$(J),Q$) THEN GOSUB 41:GOTO 425 ELSE VN$(J)=LEFT$(VN$(J),10)
  225. 427  NEXT J
  226. 428  I=1:Q=1:GOSUB 70:GOSUB 210
  227. 429  '<UNK! {000A}>--- Menu ---
  228. 430  CLS:PRINT TAB(26)"COMMAND MENU":LOCATE 4,1,0:PRINT"Indicate your requirements thus---":K=12
  229. 431  PRINT"<UNK! {000A}>"TAB(K)"SA = Show all data<UNK! {000A}>"TAB(K)"C# = Change row #<UNK! {000A}>"TAB(K)"D# = Delete row #";
  230. 432  PRINT"<UNK! {000A}>"TAB(K)"I# = Insert row # (in Free Format)<UNK! {000A}>"TAB(K)"XR = Extra rows to be added (from keyboard)<UNK! {000A}>"TAB(K)"T  = Transform variables";
  231. 433  PRINT"<UNK! {000A}>"TAB(K)"H";:IF M=1 THEN PRINT" "H$;ELSE PRINT"#"H$" of Variable #<UNK! {000A}>"TAB(K)"S  = "SC$;:IF M>2 THEN PRINT"s of Selected Variables";
  232. 434  PRINT"<UNK! {000A}>"TAB(K)"Q  = Quit or Re-run"
  233. 435  QB=3:CLOSE:PRINT:PRINT"====> COMMAND (SA, C#, D#, I#, XR, T, H";:IF M>1 THEN PRINT"#, S";
  234. 436  PRINT", Q, Null=Menu) ";:LOCATE ,,1
  235. 437  INPUT OP$:IF OP$="" THEN 430 ELSE PRINT:IF OP$="SA" OR OP$="sa" THEN 442
  236. 438  IF OP$="XR" OR OP$="xr" THEN 457 ELSE IF OP$="T" OR OP$="t" THEN GOSUB 250:GOTO 430 ELSE IF (OP$="H" OR OP$="h") AND M=1 THEN J=1:GOTO 459 ELSE IF OP$="S" OR OP$="s" THEN 492 ELSE IF OP$="Q" OR OP$="q" THEN 10
  237. 439  L$=CHR$(ASC(OP$) AND 95):I=VAL(MID$(OP$,2)):IF I>0 AND I<=N THEN IF L$="C" THEN 448 ELSE IF L$="D" OR L$="I" THEN 453 ELSE IF L$="H" THEN J=I:IF J<=M THEN 459
  238. 440  GOSUB 42:GOTO 435
  239. 441  '<UNK! {000A}>--- Show Data ---
  240. 442  I=1:PRINT:IF QR=0 THEN PRINT"Data read was---"ELSE PRINT"Revised data is---"
  241. 443  GOSUB 200:IF I MOD 20=0 THEN GOSUB 6:IF IN$="/" THEN 445
  242. 444  I=I+1:IF I<=N THEN 443 ELSE PRINT
  243. 445  IF VN$<>"Y" THEN PRINT"Variables not named"; ELSE FOR J=1 TO M:PRINT TAB(1+30*((J+2) MOD 3)) USING"Var##=";J;:PRINT VN$(J);:NEXT J:PRINT
  244. 446  GOSUB 5:GOTO 430
  245. 447  '<UNK! {000A}>--- Change Datum ---
  246. 448  QR=1:IF M=1 THEN J=1:GOTO 450 ELSE GOSUB 200
  247. 449  PRINT "Change which variable # (1-"MID$(STR$(M),2)")";:INPUT Z$:J=VAL(Z$):IF J<1 OR J>M THEN BEEP:GOTO 449
  248. 450  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 450
  249. 451  PRINT "Revised Row"STR$(I)": ";:FOR J=1 TO M:PRINT X(I,J);:NEXT J:PRINT:IF M=1 THEN 435 ELSE DO$="change that row again":GOSUB 20:IF Z$="Y" THEN 449 ELSE 435
  250. 452  '<UNK! {000A}>--- Delete, Insert, or Add Extra Rows ---
  251. 453  IF INSTR(OP$,"-") THEN GOSUB 40:GOTO 435 ELSE GOSUB 43:IF L$="I"THEN 455
  252. 454  N=N-1:FOR K=I TO N:FOR J=1 TO M:X(K,J)=X(K+1,J):NEXT:NEXT:GOSUB 44:GOTO 430
  253. 455  IF N=MXR THEN 440 ELSE N=N+1:QR=1:FOR K=N TO I+1 STEP -1:FOR J=1 TO M:X(K,J)=X(K-1,J):NEXT:NEXT:LOCATE,1
  254. 456  PRINT"Row"STR$(I);:INPUT X$:GOSUB 50:GOSUB 44:GOTO 430
  255. 457  IF N=MXR THEN 440 ELSE PRINT"You can append up to"MXR-N"extra rows (each with"M"variables)":N1=N+1:I=N1:N=0:Q=1:QR=1:GOSUB 70:GOTO 430
  256. 458  '<UNK! {000A}>--- Compute ---
  257. 459  GOSUB 43:II=1:NN=N:GOSUB 230
  258. 460  FOR L=1 TO 14:N(L)=0:NEXT L
  259. 461  FOR I=1 TO N:Z=(X(I,J)-AV)/SDN:L=INT(2*(Z+3.5)+1):IF L<1 THEN L=1 ELSE IF L>14 THEN L=14
  260. 462  N(L)=N(L)+1:IF I=1 THEN 464
  261. 463  SQ=SQ+(X(I,J)-X(I-1,J))^2:IF I>2 THEN IF X(I-1,J)>X(I,J)AND X(I-1,J)>X(I-2,J)OR X(I-1,J)<X(I,J)AND X(I-1,J)<X(I-2,J)THEN TU=TU+1
  262. 464  NEXT I
  263. 465  T1=(AV-SM)/SD:T2=(GR-AV)/SD:RS=(GR-SM)/SD:VNR=(SQ/(N-1))/VAN:R1=1-VNR/2:ET=(2*N-4)/3:ZT=(ABS(TU-ET)-P5)/SQR((16*N-29)/90)
  264. 466  '<UNK! {000A}>--- Histogram ---
  265. 467  GOSUB 160:CLS
  266. 468  PRINT #2,"HISTOGRAM of Z SCORES of "VN$(J);:F0$=FA$
  267. 469  PRINT #2,SPACE$(6)"(Exp=Expected if Population Normal)":PRINT #2,:PRINT #2,"Exp Obs     Z  ";:FOR K=0 TO 5:PRINT #2,RIGHT$(STR$(K),1)"----+----";:NEXT K:PRINT #2,USING"#";6:F0$=FA$:ZL=-3
  268. 470  FOR L=1 TO 14:NE=INT(PE(L)*N+P5):PRINT #2,USING F0$;NE;N(L);ZL;
  269. 471  IF N(L) THEN IF N(L)<60 THEN PRINT #2,STRING$(N(L),42);ELSE PRINT #2,STRING$(55,42)"===>";
  270. 472  IF L<14 THEN PRINT #2,:IF L<13 THEN ZL=ZL+P5 ELSE ZL=3:F0$=FB$
  271. 473  NEXT L:PRINT #2,:GOSUB 5:GOTO 475
  272. 474  '<UNK! {000A}>--- Statistics ---
  273. 475  IF PR=0 THEN CLS ELSE PRINT #2,:PRINT #2,
  274. 476  PRINT #2,"STATISTICS of "VN$(J):PRINT #2,
  275. 477  PRINT #2,"First 6 data values:";:FOR I=1 TO 6:PRINT #2,X(I,J);:NEXT I
  276. 478  PRINT #2,:PRINT #2,:PRINT #2,"n  ";USING F8$;N
  277. 479  PRINT #2,"Ave";USING F1$+S$+"SD"+F7$;AV;SD
  278. 480  PRINT #2,"Var";USING F1$+S$+"SE"+F7$;VA;SE
  279. 481  PRINT #2,"Min";USING F1$+S$+"T "+F7$+" (Thompson-Grubbs, Technometrics 1969, p.4)";SM;T1
  280. 482  PRINT #2,"Max";USING F1$+S$+"T "+F7$+" (Ditto)";GR;T2
  281. 483  PRINT #2,"Sqrt(B1)";USING F6$+S$+"Z "+F7$+" (BTS 34B)";SKEW;ZSKEW
  282. 484  PRINT #2,"B2";S$;USING F6$+S$+"Z "+F7$+" (BTS 34C)";CURT;ZCURT
  283. 485  PRINT #2,"Range/SD";USING F6$+SPACE$(17)+"(BTS 29C)";RS
  284. 486  PRINT #2,"Serial Correlation, R1 ";USING F7$+" (Yamane, Stats, 3rd, p.1094)";R1
  285. 487  PRINT #2,"Von Neumann Ratio =";USING"#######.#### (Ditto, 1095)";VNR
  286. 488  PRINT #2,"Turns";USING F4$+S$+"Exp="+"####.#"+S$+"Z"+F6$;TU;ET;ZT
  287. 489  PRINT #2,:PRINT #2,"Note: `BTS xxx' = Biometrika Tables for Statisticians, ed 3, vol 1, Table `xxx'.":PRINT #2,:PRINT #2,
  288. 490  IF PR THEN GOSUB 190:GOTO 430
  289. 491  PRINT TAB(39)"====> See Histogram Again";:GOSUB 21:IF Z$="Y" THEN CLS:GOTO 468 ELSE LOCATE CSRLIN-1,39:PRINT SPACE$(34);:GOSUB 161:IF PR THEN GOSUB 165:GOTO 468 ELSE 430
  290. 492  '<UNK! {000A}>--- Scattergram ---
  291. 493  GOSUB 290:GOTO 430
  292. 494  END
  293.