home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 2.img / STATLIB2.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-11-10  |  34.9 KB  |  910 lines
  1. 5  REM        STATLIB 2 LIBRARY v1.0
  2. 6  REM        10/16/84
  3. 10  CLS
  4. 20   WIDTH 80
  5. 30    KEY OFF
  6. 40     LOCATE 1,30
  7. 50      COLOR 0,7
  8. 60       PRINT " >>> STATLIB 2 <<< "
  9. 70        COLOR 7,0
  10. 80         LOCATE 3,24
  11. 90          PRINT "Volume Two -- Hypothesis Testing";
  12. 100           COLOR 0,7
  13. 110            X$ = CHR$(186)
  14. 120  LOCATE 5,10,0
  15. 130   PRINT CHR$(201) + STRING$(59,205) + CHR$(187)
  16. 140    LOCATE 19,10
  17. 150     PRINT CHR$(200) + STRING$(59,205) + CHR$(188)
  18. 160      FOR W = 6 TO 18
  19. 170       LOCATE W,10
  20. 180        PRINT X$
  21. 190         LOCATE W,70
  22. 200          PRINT X$
  23. 210           NEXT
  24. 220            COLOR 0,15
  25. 230             COLOR 7,0
  26. 240              LOCATE 7,29
  27. 250               PRINT "Designed by Dale Benzer"
  28. 260  LOCATE 9,26
  29. 270   PRINT "Programmed by Peter Schlaifer"
  30. 280    LOCATE 11,37
  31. 290     PRINT "For"
  32. 300      LOCATE 13,25
  33. 310       PRINT "THE PC DISK LIBRARY OF SOFTWARE"
  34. 320        LOCATE 15,32
  35. 330         PRINT "Copyright 1984 "
  36. 340          LOCATE 17,26
  37. 350           PRINT "ZIFF-DAVIS PUBLISHING CO., INC."
  38. 360  LOCATE 22,26
  39. 370   PRINT "PRESS ANY KEY TO CONTINUE"
  40. 380  A$ = INKEY$
  41. 390   IF A$ = "" THEN 380
  42. 400  LOCATE 22,26,0
  43. 410   PRINT SPACE$(40)
  44. 420    LOCATE 22,26
  45. 430     CLEAR ,,2500
  46. 440      PRINT "initializing STATLIB 2 ..."
  47. 1020  CLEAR ,,2500                                          'BEGIN
  48. 1030  REM:PRINT "initializing STATLIB 2..."
  49. 1040  GOSUB 1300                                            'init
  50. 1050  ON ERROR GOTO 1110                                    'error
  51. 1060  CLS
  52. 1070  GOSUB 2810                                            'wdraw
  53. 1080  MD=-1
  54. 1090  GOTO 4900                                             'main
  55. 1100  REM
  56. 1110  GOSUB 2990                                            'ERROR;putprompt
  57. 1120  PRINT "ERROR"STR$(ERR)" IN LINE"STR$(ERL);
  58. 1130  END
  59. 1140  PRINT "";
  60. 1150  REM
  61. 1160  QT$=CHR$(34)
  62. 1170  KEY ON
  63. 1180  KEY 1,"LIST "
  64. 1190  KEY 2,"RUN"+CHR$(13)
  65. 1200  KEY 3,"LOAD"+CHR$(34)
  66. 1210  KEY 4,"SAVE"+CHR$(34)
  67. 1220  KEY 5,"CONT"+CHR$(13)
  68. 1230  KEY 6,","+CHR$(34)+"LPT:"
  69. 1240  KEY 7,"TRON"+CR$
  70. 1250  KEY 8,"TROFF"+CR$
  71. 1260  KEY 9,"KEY "
  72. 1270  KEY 10,"SCREEN 0,0,0"+CR$
  73. 1280  CLS:KEY ON
  74. 1290  ON ERROR GOTO 0:END
  75. 1300  KEY OFF                                               'INIT
  76. 1310  FOR J = 1 TO 10:KEY J,"":NEXT
  77. 1320  LOCATE ,,0
  78. 1330  WIDTH 80
  79. 1340  DEFINT I,J,K,L,N
  80. 1350  I=0:J=0:K=0:L=0:P=0:Q=0:ARG=0:ARG1=0:ARG2=0:U=0:V=0
  81. 1360  X$="":Y$="":W$="":LIN$="":ARG$=""
  82. 1370  ESC$=CHR$(27):CR$=CHR$(13)
  83. 1380  RS$=CHR$(28):LS$=CHR$(29):US$=CHR$(30):DS$=CHR$(31)
  84. 1390  DEF FNK$(J)=CHR$(0)+CHR$(J)
  85. 1400  F1$=FNK$(59):F2$=FNK$(60):F3$=FNK$(61):F4$=FNK$(62):F5$=FNK$(63)
  86. 1410  ECMD$="F1 HELP  F2 QUIT/RETURN  F3 CONTINUE/SAVE  F4 REDO  F5 VIEW"
  87. 1420  NVARS=0:NDEFS=0:NSUBS=0:NCASE=0<UNK! {0009}>
  88. 1430  BPTR=0:FPTR=0:NPTR=0:MAXPTR=0<UNK! {0009}>
  89. 1440  F0=0:F1=0:F2=0:FF=0:VFLAG=0<UNK! {0009}>
  90. 1450  FCMD=0:CMD=0:CMD$=""<UNK! {0009}>
  91. 1460  FPROMPT$="":FTYP$="":FTYP=0
  92. 1470  ZPTR=0:JJ=0:CCASE=0:MD=0
  93. 1480  U1=0:U2=0:V1=0:V2=0:UHIGH=-1E+06:ULOW=1E+06:VLOW=ULOW:VHIGH=UHIGH
  94. 1490  MAIN=0:OPIN=1:SELS=2:TEST=3:MEAN1=4:MEAN2=5:VAR1=6:VAR2=7:EXIT=8
  95. 1500  HELP=1:QRET=2:QSAV=3:REDO=4:VYEW=5:ESC=-1
  96. 1510  FC=12<UNK! {0009}>
  97. 1520  FD=6<UNK! {0009}>
  98. 1530  FJ=4<UNK! {0009}>
  99. 1540  FL=12<UNK! {0009}>
  100. 1550  FW=FL*FJ<UNK! {0009}>
  101. 1560  NC=(FC+FD)*FJ<UNK! {0009}>
  102. 1570  FP=5<UNK! {0009}>
  103. 1580  FQ=2<UNK! {0009}>
  104. 1590  MAXLIN=FC<UNK! {0009}>
  105. 1600  MAXSTEPS=FL-4<UNK! {0009}>
  106. 1610  WUR=FP
  107. 1620  WUC=FQ
  108. 1630  WLR=WUR+1+FL+1+1
  109. 1640  WLC=80-FQ
  110. 1650  GOSUB 2660                                            'wclx
  111. 1660  FC$=SPACE$(FC)<UNK! {0009}>
  112. 1670  FD$=SPACE$(FD-3)<UNK! {0009}>
  113. 1680  FE$=SPACE$(FC+FD)<UNK! {0009}>
  114. 1690  FL$=SPACE$(NC) 
  115. 1700  NFL$=STRING$(FQ+2,RS$)<UNK! {0009}>
  116. 1710  NW$=NL$+STRING$(FQ+2,RS$)<UNK! {0009}>
  117. 1720  FILSPEC$="":FILDESC$=""<UNK! {0009}>
  118. 1730  WBUF$=SPACE$(24)<UNK! {0009}>
  119. 1740  MAXBUF=127:BVARS=0:BUFSIZ=MAXBUF:GOSUB 3420           'setmax
  120. 1750  K=BVARS+MAXLBLS+1:DIM W$(K):FOR J = 1 TO K-1:W$(J)=FC$:NEXT
  121. 1760  DIM S(2,MAXSUBS+1)<UNK! {0009}>
  122. 1770  DIM T(15)<UNK! {0009}>
  123. 1780  DIM U(2,20)<UNK! {0009}>
  124. 1790  DIM V(MAXVARS+MAXDEFS+1)<UNK! {0009}>
  125. 1800  REM                                                   'THDR
  126. 1810  DATA "TESTS OF ONE MEAN"
  127. 1820  DATA "TESTS OF TWO MEANS"
  128. 1830  DATA "TESTS OF ONE VARIANCE"
  129. 1840  DATA "TESTS OF TWO VARIANCES"
  130. 1850  RESTORE 1800                                          'thdr
  131. 1860  FOR J = 1 TO 4:READ THDR$(J):NEXT
  132. 1870  RETURN
  133. 1880  REM<UNK! {0009}>CONIO
  134. 1890  CLS:RETURN                                            'CLS
  135. 1900  LOCATE P,Q:RETURN                                     'PUTCURSOR
  136. 1910  X$=INKEY$:IF X$="" THEN 1910                          'IN_FKEY;in_fkey
  137. 1920  IF X$>=" " OR X$=CR$ OR X$=CHR$(8) THEN RETURN
  138. 1930  IF X$=F1$ THEN GOSUB 4110:FCMD=HELP:RETURN            'fhelp
  139. 1940  IF X$=F2$ THEN FCMD=QRET:RETURN
  140. 1950  IF X$=F3$ THEN FCMD=QSAV:RETURN
  141. 1960  IF X$=F4$ THEN FCMD=REDO:RETURN
  142. 1970  IF X$=F5$ THEN GOSUB 4530:FCMD=VYEW:RETURN            'fview
  143. 1980  IF X$=ESC$ THEN FCMD=ESC:RETURN
  144. 1990  GOTO 1910                                             'in_fkey
  145. 2000  CMD=0                                                 'GET_CMD
  146. 2010  FCMD=0
  147. 2020  PRINT " ";
  148. 2030  LOCATE,,1
  149. 2040  GOSUB 1910                                            'in_fkey
  150. 2050  LOCATE,,0
  151. 2060  IF FCMD THEN RETURN
  152. 2070  GOSUB 2430                                            'toupperx
  153. 2080  CMD=INSTR(CMD$,X$)
  154. 2090  IF CMD OR CMD$="" THEN RETURN
  155. 2100  PRINT LS$;
  156. 2110  GOTO 2000                                             'get_cmd
  157. 2120  GOSUB 2990:PRINT "ENTER YOUR CHOICE:";                'GETCHOICE;putprompt
  158. 2130  GOSUB 2000:RETURN                                     'get_cmd
  159. 2140  PRINT " (Y/N)";:CMD$="YN"                             'GETYESNO
  160. 2150  GOSUB 2000:RETURN                                     'get_cmd
  161. 2160  PRINT " <CR> TO CONTINUE";                            'GET_CR
  162. 2170  CMD$=CR$:GOSUB 2000                                   'get_cmd
  163. 2180  CMD=0:RETURN
  164. 2190  LIN$=SPACE$(MAXLIN)                                   'GETLIN
  165. 2200  J=0
  166. 2210  FCMD=0
  167. 2220  LOCATE,,1 
  168. 2230  PRINT " ";
  169. 2240  GOSUB 2290                                            'getlin_
  170. 2250  LOCATE,,0
  171. 2260  IF FCMD THEN J=0
  172. 2270  IF J THEN LIN$=LEFT$(LIN$,J) ELSE LIN$=""
  173. 2280  RETURN
  174. 2290  GOSUB 1910                                            'GETLIN_;in_fkey
  175. 2300  IF FCMD THEN RETURN
  176. 2310  IF X$>=" " THEN PRINT X$;:GOSUB 2350:GOTO 2290        'addchar;getlin_
  177. 2320  IF X$=CHR$(8) THEN PRINT LS$;" ";LS$;:GOSUB 2390:GOTO 2290'delchar;getlin_
  178. 2330  IF X$=CHR$(13) THEN RETURN
  179. 2340  GOTO 2290                                             'getlin_
  180. 2350  IF J>MAXLIN-1 THEN RETURN                             'ADDCHAR
  181. 2360  J=J+1
  182. 2370  MID$(LIN$,J)=X$
  183. 2380  RETURN
  184. 2390  IF J<1 THEN RETURN                                    'DELCHAR
  185. 2400  MID$(LIN$,J)=" "
  186. 2410  J=J-1
  187. 2420  RETURN
  188. 2430  IF X$="" THEN RETURN                                  'TOUPPERX
  189. 2440  J=ASC(X$):IF J>96 AND J<123 THEN J=J-32
  190. 2450  X$=CHR$(J):RETURN
  191. 2460  IF X$="" THEN RETURN                                  'TOLOWERX
  192. 2470  J=ASC(X$):IF J>64 AND J<91 THEN J=J+32
  193. 2480  X$=CHR$(J):RETURN
  194. 2490  P=1:Q=1:GOSUB 3010                                    'PUTCHDR;el
  195. 2500  Q=40-LEN(X$)\2-5:GOSUB 1900                           'putcursor
  196. 2510  COLOR 0,7
  197. 2520  PRINT ">>>  ";X$;"  <<<";
  198. 2530  COLOR 7,0
  199. 2540  RETURN
  200. 2550  P=FP-1:Q=40:GOSUB 1900:PRINT SPACE$(40-FQ);           'PUTRHDR;putcursor
  201. 2560  Q=80-FQ-LEN(X$):GOSUB 1900:PRINT X$;:RETURN           'putcursor
  202. 2570  P=FP-1:Q=FQ+1:GOSUB 1900:PRINT SPACE$(40-FQ-1)        'PUTLHDR;putcursor
  203. 2580  GOSUB 1900:PRINT X$;:RETURN                           'putcursor
  204. 2590  X$=FILSPEC$                                           'PUTFILSPEC
  205. 2600  IF X$="" THEN X$="NO FILE OPENED":GOSUB 2570:X$="":GOSUB 2550:RETURN'putlhdr;putrhdr
  206. 2610  IF FILDESC$<>"" THEN X$=X$+"/"+FILDESC$
  207. 2620  X$="FILE: "+X$:GOSUB 2570                             'putlhdr
  208. 2630  X$="NO":IF NCASE<>0 THEN X$=STR$(NCASE)
  209. 2640  IF NCASE<>1 THEN X$=X$+" CASES ENTERED":GOSUB 2550:RETURN'putrhdr
  210. 2650  X$="1 CASE ENTERED":GOSUB 2550:RETURN                 'putrhdr
  211. 2660  REM                                                   'WCLX
  212. 2670  DATA 85,184,0,6,183,7,185,0,0,186,0,0,205,16,93,203
  213. 2680  WCLX$=SPACE$(16)
  214. 2690  J=VARPTR(WCLX$)
  215. 2700  WCLX!=PEEK(J+1)+256*PEEK(J+2)
  216. 2710  RESTORE 2660                                          'wclx
  217. 2720  FOR J = 1 TO 16
  218. 2730  READ K
  219. 2740  MID$(WCLX$,J)=CHR$(K)
  220. 2750  NEXT
  221. 2760  MID$(WCLX$,8)=CHR$(WUC)
  222. 2770  MID$(WCLX$,9)=CHR$(WUR)
  223. 2780  MID$(WCLX$,11)=CHR$(WLC-2)
  224. 2790  MID$(WCLX$,12)=CHR$(WLR-2)
  225. 2800  RETURN
  226. 2810  COLOR 0,7                                             'WDRAW
  227. 2820  LOCATE WUR,WUC
  228. 2830  PRINT CHR$(201);
  229. 2840  PRINT STRING$(WLC-WUC-1,205);
  230. 2850  PRINT CHR$(187);
  231. 2860  FOR J = WUR+1 TO WLR-1
  232. 2870  LOCATE J,WUC:PRINT CHR$(186);
  233. 2880  LOCATE J,WLC:PRINT CHR$(186);
  234. 2890  NEXT
  235. 2900  LOCATE WLR,WUC
  236. 2910  PRINT CHR$(200);
  237. 2920  PRINT STRING$(WLC-WUC-1,205);
  238. 2930  PRINT CHR$(188)
  239. 2940  COLOR 7,0
  240. 2950  RETURN
  241. 2960  P=21:Q=FQ+2:GOSUB 3010                                'PUTFTR;el
  242. 2970  Q=40-LEN(X$)\2:GOSUB 1900                             'putcursor
  243. 2980  PRINT X$;:RETURN
  244. 2990  P=23:Q=FQ+2:GOSUB 3010:RETURN                         'PUTPROMPT;el
  245. 3000  GOSUB 2160:RETURN                                     'PUTMSG;get_cr
  246. 3010  GOSUB 1900:PRINT SPACE$(79-Q);:GOSUB 1900:RETURN      'EL;putcursor;putcursor
  247. 3020  CALL WCLX!                                            'CLF
  248. 3030  P=FP+2:Q=FQ+3                                         'HOMEFL
  249. 3040  GOSUB 1900;                                           'putcursor
  250. 3050  RETURN
  251. 3060  GOSUB 3020                                            'PUTFL;clf
  252. 3070  IF F2=F0-1 THEN PRINT "NOTHING ENTERED":RETURN
  253. 3080  F1=FW*(F1\FW):IF F1>(F2-F0+1) OR F1<0 THEN F1=0
  254. 3090  K=0
  255. 3100  FOR J=F0+F1 TO F2
  256. 3110  LSET FD$=MID$(STR$(J-F0+1),2)
  257. 3120  PRINT F$FD$": "W$(J);
  258. 3130  K=K+1
  259. 3140  IF K MOD FJ = 0 THEN PRINT:PRINT NFL$;
  260. 3150  NEXT
  261. 3160  RETURN
  262. 3170  GOSUB 3020                                            'PUTDATA;clf
  263. 3180  READ X$                                               'PUTDATA_
  264. 3190  IF X$="" THEN RETURN
  265. 3200  PRINT X$:PRINT NFL$;
  266. 3210  GOTO 3180                                             'putdata_
  267. 3220  REM<UNK! {0009}>FILE routines
  268. 3230  FCMD=0:ON ERROR GOTO 3360                             'LOAD_STL;open_error
  269. 3240  GOSUB 2990: PRINT "LOADING "+FILNAM$;                 'putprompt
  270. 3250  FILTYP=1:OPEN "I",#1,FILSPEC$+".STL"
  271. 3260  INPUT #1,FILNAM$,FILDESC$,BUFSIZ:GOSUB 3420           'setmax
  272. 3270  INPUT #1,NVARS,NDEFS,NSUBS,NCASE
  273. 3280  FOR J = 1 TO NVARS:INPUT #1,X$:LSET W$(BVARS+J)=X$:NEXT
  274. 3290  FOR J = 1 TO NDEFS:INPUT #1,X$:LSET W$(BDEFS+J)=X$:NEXT
  275. 3300  FOR J = 1 TO NSUBS:INPUT #1,X$:LSET W$(BSUBS+J)=X$:NEXT
  276. 3310  CLOSE #1:GOSUB 2590:CCASE=0                           'putfilspec
  277. 3320  FILTYP=2:OPEN "R",#1,FILSPEC$+".DAT",BUFSIZ
  278. 3330  FIELD#1,BUFSIZ AS CB$
  279. 3340  ON ERROR GOTO 1110                                    'OPEN_RESUME;error
  280. 3350  RETURN
  281. 3360  GOSUB 2990                                            'OPEN_ERROR;putprompt
  282. 3370  PRINT "CAN'T OPEN ";FILSPEC$;
  283. 3380  IF FILTYP=1 THEN PRINT ".STL"; ELSE PRINT ".DAT";
  284. 3390  GOSUB 2160                                            'get_cr
  285. 3400  FILSPEC$="":CLOSE:FCMD=REDO
  286. 3410  RESUME 3340                                           'open_resume
  287. 3420  MAXVARS=BUFSIZ:MAXDEFS=BUFSIZ\4:MAXSUBS=BUFSIZ        'SETMAX
  288. 3430  MAXLBLS=MAXVARS+MAXDEFS+MAXSUBS
  289. 3440  BDEFS=BVARS+MAXVARS:BSUBS=BDEFS+MAXDEFS:BVALS=BSUBS+MAXSUBS
  290. 3450  RETURN
  291. 3460  CCASE=0                                               'READ_CASEFILE
  292. 3470  UFLAG=U(1,0)<UNK! {0009}>
  293. 3480  U(0,3)=0:U(1,3)=0<UNK! {0009}>
  294. 3490  U(0,4)=0:U(1,4)=0<UNK! {0009}>
  295. 3500  U(0,5)=0:U(1,5)=0<UNK! {0009}>
  296. 3510  SJ=0
  297. 3520  GOSUB 2990                                            'putprompt
  298. 3530  NX=CSRLIN
  299. 3540  PRINT "SELECTED CASE      ON SELECT ";
  300. 3550  NY=POS(0)
  301. 3560  WHILE CCASE<NCASE
  302. 3570  CCASE=CCASE+1
  303. 3580  GOSUB 3710                                            'sel_case
  304. 3590  IF UFLAG THEN SJ=1:GOSUB 3710:SJ=0                    'sel_case
  305. 3600  WEND
  306. 3610  GOSUB 3640                                            'sample_stat
  307. 3620  IF UFLAG THEN SJ=1:GOSUB 3640:SJ=0                    'sample_stat
  308. 3630  RETURN
  309. 3640  J=U(SJ,3):IF J=0 THEN RETURN
  310. 3650  U=(U(SJ,5)-((U(SJ,4)*U(SJ,4))/J))/(J-1)
  311. 3660  U(SJ,4)=U(SJ,4)/J
  312. 3670  U(SJ,5)=U<UNK! {0009}>
  313. 3680  U(SJ,6)=SQR(U)<UNK! {0009}>
  314. 3690  U(SJ,7)=SQR(U/J)<UNK! {0009}>
  315. 3700  RETURN
  316. 3710  SEL=1:GET#1,CCASE*4                                   'SEL_CASE
  317. 3720  FOR J = 1 TO S(SJ,0)
  318. 3730  IF MID$(CB$,S(SJ,J),1)="0" THEN SEL=0:J=S(SJ,0)
  319. 3740  NEXT
  320. 3750  IF SEL=0 THEN RETURN
  321. 3760  LOCATE NX,NY-15:PRINT USING "####";CCASE
  322. 3770  LOCATE NX,NY:PRINT USING "#";SJ+1;
  323. 3780  GOSUB 3840                                            'load_case
  324. 3790  U(SJ,3)=U(SJ,3)+1<UNK! {0009}>
  325. 3800  V=V(U(SJ,0))<UNK! {0009}>
  326. 3810  U(SJ,4)=U(SJ,4)+V<UNK! {0009}>
  327. 3820  U(SJ,5)=U(SJ,5)+V*V<UNK! {0009}>
  328. 3830  RETURN
  329. 3840  IF V(0)=CCASE THEN RETURN                             'LOAD_CASE
  330. 3850  GET#1,CCASE*4-3:X$=CB$:GET#1:X$=X$+CB$
  331. 3860  FOR J = 1 TO NVARS:V(BVARS+J)=CVI(MID$(X$,J+J-1)):NEXT
  332. 3870  GET#1:FOR J = 1 TO NDEFS:V(BDEFS+J)=CVS(MID$(CB$,J*4-3)):NEXT
  333. 3880  V(0)=CCASE
  334. 3890  RETURN
  335. 3900  REM<UNK! {0009}>INPUT ROUTINES
  336. 3910  GOSUB 3970:IF FCMD THEN RETURN                        'GETFILSPEC;getfilnam
  337. 3920  GOSUB 4030:IF FCMD=QRET THEN RETURN                   'getfildrv
  338. 3930  IF FCMD THEN 3910                                     'getfilspec
  339. 3940  CLOSE
  340. 3950  IF FILDRV$<>"" THEN FILSPEC$=FILDRV$+":"+FILNAM$ ELSE FILSPEC$=FILNAM$
  341. 3960  RETURN
  342. 3970  GOSUB 2990:PRINT "ENTER FILENAME";                    'GETFILNAM;putprompt
  343. 3980  MAXLIN=8:GOSUB 2190                                   'getlin
  344. 3990  IF FCMD=HELP OR FCMD=VYEW THEN 3970                   'getfilnam
  345. 4000  IF FCMD THEN RETURN
  346. 4010  IF LIN$<>"" THEN FILNAM$=LIN$
  347. 4020  RETURN
  348. 4030  GOSUB 2990:PRINT "ON DRIVE";                          'GETFILDRV;putprompt
  349. 4040  CMD$="ABCD "+CR$:GOSUB 2000                           'get_cmd
  350. 4050  IF FCMD=HELP OR FCMD=VYEW THEN 4030                   'getfildrv
  351. 4060  IF FCMD THEN RETURN
  352. 4070  IF CMD<5 THEN FILDRV$=MID$(CMD$,CMD,1) ELSE IF CMD=5 THEN FILDRV$=""
  353. 4080  RETURN
  354. 4090  GOSUB 2990:PRINT "FILE MUST BE FIRST OPENED FROM MAIN MENU";'OPENFILEMSG;putprompt
  355. 4100  GOSUB 2160:RETURN                                     'get_cr
  356. 4110  IF MD=MAIN THEN RESTORE 4240                          'FHELP;main_help
  357. 4120  IF MD=OPIN THEN RESTORE 4290                          'open_help
  358. 4130  IF MD=SELS THEN RESTORE 4320                          'sels_help
  359. 4140  IF MD=TEST THEN RESTORE 4350                          'test_help
  360. 4150  IF MD=MEAN1 THEN RESTORE 4380                         'mean1_help
  361. 4160  IF MD=MEAN2 THEN RESTORE 4380                         'mean2_help
  362. 4170  IF MD=VAR1 THEN RESTORE 4440                          'var1_help
  363. 4180  IF MD=VAR2 THEN RESTORE 4440                          'var2_help
  364. 4190  IF MD=EXIT THEN RESTORE 4500                          'exit_help
  365. 4200  GOSUB 3170                                            'putdata
  366. 4210  GOSUB 2990                                            'putprompt
  367. 4220  GOSUB 2160                                            'get_cr
  368. 4225  GOSUB 3020
  369. 4226  FCMD=HELP
  370. 4230  RETURN
  371. 4240  REM                                                   'MAIN_HELP
  372. 4250  DATA"MAIN HELP SCREEN":DATA" ":DATA"OPEN a file to begin.":DATA"  ":DATA"All subsets specified are selected upon entry. Thus, choosing option":DATA"4 (Print Selected Cases) will print only those cases which satisfy
  373. 4251  DATA"all the subsets. You may de-select subsets with option 2 (Select":DATA"Subsets).":DATA"   ":DATA"Each of the Menu options has its own HELP screen. Use F1 at any time":DATA"to call a screen.":DATA"
  374. 4260  DATA " "
  375. 4270  DATA "Called from main menu and/or with F1"
  376. 4280  DATA ""
  377. 4290  REM                                                   'OPEN_HELP
  378. 4300  DATA"OPEN HELP SCREEN":DATA"  ":DATA"Opening a file will allow you to run the descriptive statistics":DATA"routines included in this volume. ":DATA"  ":DATA"No filename extension should be included at the filename prompt.":DATA"  
  379. 4301  DATA"After a file is opened, the variable labels are displayed and the":DATA"and the program will return to the Main Menu.":DATA"
  380. 4310  DATA ""
  381. 4320  REM                                                   'SELS_HELP
  382. 4330  DATA"SELECT HELP SCREEN":DATA"  ":DATA"This option allows you to choose which of the subsets you wish to":DATA"use. (D)eleting or (C)learing subsets does NOT erase them from the
  383. 4331  DATA"disk file, but merely de-selects them. Try (C)learing, and then":DATA"(E)ntering s1. After a (C)lear you may (E)nter as many of the subsets":DATA"as you wish, or use (A)ll to re-select all subsets.":DATA"
  384. 4332  DATA"Remember, REJIF0 will reject a case if ANY of the values of that case":DATA"are zero. Use a specific subset i.e., x1>0 to reject zero values for":DATA"a specific variable.":DATA"  ":DATA"Use F2 or F3 to return to the menu after Selecting.
  385. 4333  DATA "  "
  386. 4340  DATA ""
  387. 4350  REM                                                   'TEST_HELP
  388. 4360  DATA "MAIN TEST HELP SCREEN" :DATA " "
  389. 4361  DATA "Make certain your subsets are  selected correctly.":DATA "  "
  390. 4362  DATA "Make a test choice from the Menu.":DATA "  "
  391. 4363  DATA "If the population standard deviation is known"
  392. 4364  DATA "the test will make use of that number, else"
  393. 4365  DATA "the sample std. dev. will be calculated and used.":DATA "  "
  394. 4366  DATA "See the HELP screens for the individual tests"
  395. 4367  DATA "for more information."
  396. 4370  DATA ""
  397. 4380  REM                                                   'MEAN1_HELP
  398. 4390  DATA "MEANS TEST HELP SCREEN":DATA "  "
  399. 4391  DATA "If the population std.dev is input, the test"
  400. 4392  DATA "will be based on the normal test statistic."
  401. 4393  DATA "Otherwise, a student's t will be used.":DATA "  "
  402. 4394  DATA "The program will display a significance level"
  403. 4395  DATA "which should be interpreted as the level at"
  404. 4396  DATA "which your null hypothesis should be rejected."
  405. 4400  DATA ""
  406. 4410  REM                                                   'MEAN2_HELP
  407. 4420  DATA "F1 2 MEANS HELP SCREEN"
  408. 4430  DATA ""
  409. 4440  REM                                                   'VAR1_HELP
  410. 4450  DATA "VARIANCE TEST HELP SCREEN":DATA "  "
  411. 4451  DATA "The single variance test uses the standard"
  412. 4452  DATA "chi-square statistic."
  413. 4453  DATA "The two variance test is designed to be used"
  414. 4454  DATA "to test a variance ratio. It uses the formula"
  415. 4455  DATA "F=(first sample variance/second sample variance)"
  416. 4456  DATA "multiplied by 1/your test ratio (usually 1)"
  417. 4460  DATA ""
  418. 4470  REM                                                   'VAR2_HELP
  419. 4480  DATA "F1 2 VARIANCES HELP SCREEN"
  420. 4490  DATA ""
  421. 4500  REM                                                   'EXIT_HELP
  422. 4510  DATA"EXIT HELP SCREEN":DATA"  ":DATA"Exiting the program will return you to BASIC with all functions ":DATA"restored.":DATA"
  423. 4520  DATA ""
  424. 4530  CMD$="LDS12UWR"                                       'FVIEW
  425. 4540  IF FF<1 OR FF>3 THEN FF=1:F1=0:VFLAG=0
  426. 4550  GOSUB 2990                                            'FVIEW_;putprompt
  427. 4560  PRINT "(L)ABELS  (D)EFS  (S)UBS  SEL(1)  SEL(2)  (U)P  DO(W)N  (R)ETURN";
  428. 4570  GOSUB 2000                                            'get_cmd
  429. 4580  IF CMD=8 OR FCMD THEN FCMD=VYEW:RETURN
  430. 4590  ON CMD GOSUB 4670,4680,4690,4610,4620,4630,4650       'lbl_key;def_key;sub_key;sel1_key;sel2_key;up_key;down_key
  431. 4600  GOTO 4550                                             'fview_
  432. 4610  SJ=0:FF=4:GOSUB 5650:RETURN                           'SEL1_KEY;sel_key
  433. 4620  SJ=1:FF=5:GOSUB 5650:RETURN                           'SEL2_KEY;sel_key
  434. 4630  F1=F1-FW:IF FF<4 THEN GOSUB 3060:RETURN               'UP_KEY;putfl
  435. 4640  GOSUB 5650:RETURN                                     'sel_key
  436. 4650  F1=F1+FW:IF FF<4 THEN GOSUB 3060:RETURN               'DOWN_KEY;putfl
  437. 4660  GOSUB 5650:RETURN                                     'sel_key
  438. 4670  FF=1:F0=BVARS:F2=F0+NVARS:F0=F0+1:F$="x":GOSUB 3060:RETURN'LBL_KEY;putfl
  439. 4680  FF=2:F0=BDEFS:F2=F0+NDEFS:F0=F0+1:F$="d":GOSUB 3060:RETURN'DEF_KEY;putfl
  440. 4690  FF=3:F0=BSUBS:F2=F0+NSUBS:F0=F0+1:F$="s":GOSUB 3060:RETURN'SUB_KEY;putfl
  441. 4700  F0=BVARS+MAXLBLS:F2=F0+NVARS:F0=F0+1:F$="x":GOSUB 3060:RETURN'LBL_VAL;putfl
  442. 4710  F0=BDEFS+MAXLBLS:F2=F0+NDEFS:F0=F0+1:F$="d":GOSUB 3060:RETURN'DEF_VAL;putfl
  443. 4720  F0=BSUBS+MAXLBLS:F2=F0+NSUBS:F0=F0+1:F$="s":GOSUB 3060:RETURN'SUB_VAL;putfl
  444. 4730  F0=BPTR+1:F1=FPTR-BPTR:F2=NPTR:F$=FTYP$:GOSUB 3060:RETURN'CUR_KEY;putfl
  445. 4740  REM<UNK! {0009}>MAIN
  446. 4750  REM                                                   'MAIN_DATA
  447. 4760  DATA "STATLIB 2 LIBRARY"
  448. 4770  DATA "12345"
  449. 4780  DATA " "
  450. 4790  DATA " "
  451. 4800  DATA "    1    OPEN DATA FILE"
  452. 4810  DATA " "
  453. 4820  DATA "    2    SELECT SUBSETS"
  454. 4830  DATA " "
  455. 4840  DATA "    3    HYPOTHESIS TESTING"
  456. 4850  DATA " "
  457. 4860  DATA "    4    HELP"
  458. 4870  DATA " "
  459. 4880  DATA "    5    EXIT PROGRAM"
  460. 4890  DATA ""
  461. 4900  RESTORE 4750:READ X$:READ CMD$                        'MAIN;main_data
  462. 4910  GOSUB 2490:GOSUB 2590:GOSUB 3170                      'putchdr;putfilspec;putdata
  463. 4920  IF MD=-1 THEN X$=ECMD$:GOSUB 2960                     'putftr
  464. 4930  MD=MAIN:GOSUB 2120:IF CMD=5 THEN 4960                 'getchoice;exit
  465. 4940  ON CMD GOSUB 5060,5260,6230,5040                      'open;sels;test;help
  466. 4950  GOTO 4900                                             'main
  467. 4960  MD=EXIT:GOSUB 2990                                    'EXIT;putprompt
  468. 4970  PRINT "DO YOU WANT TO TEST ANOTHER FILE";
  469. 4980  GOSUB 2140:IF X$="Y" THEN 4900                        'getyesno;main
  470. 4990  CLOSE:FILSPEC$=""
  471. 5000  FOR J = 1 TO 500:NEXT
  472. 5010  GOSUB 2990:PRINT "GOODBYE..."                         'putprompt
  473. 5020  FOR J = 1 TO 2200:NEXT
  474. 5030  GOTO 1140                                             '_exit
  475. 5040  GOSUB 4110:RETURN                                     'HELP;fhelp
  476. 5050  REM<UNK! {0009}>OPEN module
  477. 5060  MD=OPIN:X$="OPEN FILE":GOSUB 2490                     'OPEN;putchdr
  478. 5070  GOSUB 3910:IF FCMD=QRET OR FCMD=ESC THEN RETURN       'getfilspec
  479. 5080  IF FCMD THEN 5060                                     'open
  480. 5090  GOSUB 3230:IF FCMD THEN 5060                          'load_stl;open
  481. 5100  GOSUB 4670:GOSUB 2990:GOSUB 2160                      'lbl_key;putprompt;get_cr
  482. 5110  FOR J = 1 TO NSUBS:S(0,J)=0:S(1,J)=0:NEXT:S(0,0)=0:S(1,0)=0:SVEC=0
  483. 5120  IF NCASE=0 THEN GOSUB 2990:PRINT "N0 CASES ENTERED";:GOSUB 2160'putprompt;get_cr
  484. 5130  RETURN
  485. 5140  REM<UNK! {0009}>SELECT module
  486. 5150  REM                                                   'SELS_DATA
  487. 5160  DATA "SELECT SUBSET DEFINITIONS"
  488. 5170  DATA "123"
  489. 5180  DATA " "
  490. 5190  DATA " "
  491. 5200  DATA "    1    SELECT SUBSETS FOR 1ST VARIABLE"
  492. 5210  DATA " "
  493. 5220  DATA "    2    SELECT SUBSETS FOR 2ND VARIABLE"
  494. 5230  DATA " "
  495. 5240  DATA "    3    RETURN TO MAIN MENU"
  496. 5250  DATA ""
  497. 5260  IF FILSPEC$="" THEN GOSUB 4090:RETURN                 'SELS;openfilemsg
  498. 5270  MD=SELS:RESTORE 5150:READ X$,CMD$                     'sels_data
  499. 5280  GOSUB 2490:IF NSUBS=0 THEN GOTO 5340                  'putchdr;sels0
  500. 5290  GOSUB 3170:GOSUB 2120                                 'putdata;getchoice
  501. 5300  IF FCMD=VYEW OR FCMD=HELP THEN GOTO 5260              'sels
  502. 5310  IF FCMD OR CMD=3 THEN RETURN
  503. 5320  SVEC=CMD-1:GOSUB 5370                                 'sels_loop
  504. 5330  GOTO 5260                                             'sels
  505. 5340  GOSUB 3020:PRINT "NO SUBSETS HAVE BEEN DEFINED"       'SELS0;clf
  506. 5350  GOSUB 2990:GOSUB 2160                                 'putprompt;get_cr
  507. 5360  RETURN
  508. 5370  SJ=SVEC:GOSUB 5650:GOSUB 2990                         'SELS_LOOP;sel_key;putprompt
  509. 5380  PRINT "(D)ELETE  (E)NTER  (C)LEAR  (A)LL";
  510. 5390  CMD$="DECA":GOSUB 2000                                'get_cmd
  511. 5400  IF FCMD=QRET OR FCMD=QSAV OR FCMD=ESC THEN RETURN
  512. 5410  IF FCMD THEN 5370                                     'sels_loop
  513. 5420  ON CMD GOSUB 5440,5480,5510,5520                      'sel_del;sel_add;sel_clr;sel_all
  514. 5430  GOTO 5370                                             'sels_loop
  515. 5440  GOSUB 5540:IF FCMD<>0 THEN RETURN                     'SEL_DEL;get_sel
  516. 5450  IF SELJ=0 THEN GOSUB 2990:PRINT "SUBSET NOT SELECTED";:GOSUB 2160:GOTO 5440'putprompt;get_cr;sel_del
  517. 5460  FOR J = SELJ TO S(SVEC,0)-1:S(SVEC,J)=S(SVEC,J+1):NEXT
  518. 5470  S(SVEC,0)=S(SVEC,0)-1:RETURN
  519. 5480  GOSUB 5540:IF FCMD THEN RETURN                        'SEL_ADD;get_sel
  520. 5490  IF SELJ<>0 THEN GOSUB 2990:PRINT "DUPLICATE SUBSET";:GOSUB 2160:GOTO 5480'putprompt;get_cr;sel_add
  521. 5500  J=S(SVEC,0)+1:S(SVEC,J)=SEL:S(SVEC,0)=J:RETURN
  522. 5510  S(SVEC,0)=0:RETURN                                    'SEL_CLR
  523. 5520  FOR J = 1 TO NSUBS:S(SVEC,J)=J:NEXT                   'SEL_ALL
  524. 5530  S(SVEC,0)=NSUBS:RETURN
  525. 5540  GOSUB 2990                                            'GET_SEL;putprompt
  526. 5550  IF NSUBS=0 THEN PRINT "NO SUBSETS DEFINED":GOSUB 2160:FCMD=QRET:RETURN'get_cr
  527. 5560  PRINT "ENTER SUBSET NUMBER";
  528. 5570  MAXLIN=3:GOSUB 2190:IF FCMD THEN RETURN               'getlin
  529. 5580  SEL=VAL(LIN$):IF SEL>=1 AND SEL<=NSUBS THEN 5610      'get_sel_
  530. 5590  GOSUB 2990:PRINT "BAD SUBSET NUMBER";                 'putprompt
  531. 5600  GOSUB 2160:GOTO 5540                                  'get_cr;get_sel
  532. 5610  SELJ=0:FOR J = 1 TO S(SVEC,0)                         'GET_SEL_
  533. 5620  IF SEL=S(SVEC,J) THEN SELJ=J:J=S(SVEC,0)
  534. 5630  NEXT:RETURN
  535. 5640  REM DISPLAY SELECT VECTOR
  536. 5650  GOSUB 3020                                            'SEL_KEY;clf
  537. 5660  PRINT "SELECT VECTOR";SJ+1
  538. 5670  PRINT:PRINT NFL$;
  539. 5680  K=S(SJ,0):IF K=0 THEN PRINT "ALL CASES WILL BE SELECTED":RETURN
  540. 5690  L=0
  541. 5700  IF F1<1 OR F1>K THEN F1=1
  542. 5710  F2=F1+FW:IF F2>K THEN F2=K
  543. 5720  FOR J = F1 TO F2
  544. 5730  JJ=S(SJ,J)
  545. 5740  LSET FD$=MID$(STR$(JJ),2)
  546. 5750  PRINT "s"FD$": "W$(BSUBS+JJ);
  547. 5760  L=L+1
  548. 5770  IF L MOD FJ = 0 THEN PRINT:PRINT NFL$;
  549. 5780  NEXT
  550. 5790  RETURN
  551. 5800  REM<UNK! {0009}>GET_ARG
  552. 5810  GOSUB 2990:PRINT PROMPT$;
  553. 5815  MAXLIN=4:GOSUB 2190                                   'GET_ARG;getlin
  554. 5820  IF FCMD THEN RETURN
  555. 5830  IF LIN$="" THEN GOTO 5810                  'get_arg
  556. 5840  G1=1:G2=LEN(LIN$):GOSUB 5860                          'scanarg
  557. 5850  RETURN
  558. 5860  FOR ARGPTR = G1 TO G2                                 'SCANARG
  559. 5870  X$=MID$(LIN$,ARGPTR,1):GOSUB 2460                     'tolowerx
  560. 5880  K=INSTR("xd",X$)
  561. 5890  IF K>0 THEN GOSUB 5940:ARGPTR=G2                      'scanarg_
  562. 5900  NEXT
  563. 5910  IF K THEN RETURN
  564. 5920  LIN$="":GOSUB 2990:PRINT "BAD ARGUMENT";:GOSUB 2160 'putprompt;get_cr
  565. 5930  RETURN
  566. 5940  IF ARGPTR=G2 THEN K=0:RETURN                          'SCANARG_
  567. 5950  ARGPTR=ARGPTR+1:U=VAL(MID$(LIN$,ARGPTR))
  568. 5960  L=NVARS:IF K=2 THEN L=NDEFS
  569. 5970  IF U<1 OR U>L THEN K=0:RETURN
  570. 5980  ARG$=X$+MID$(STR$(U),2)
  571. 5990  FPTR=BVARS+U+(K-1)*MAXVARS
  572. 6000  RETURN
  573. 6010  LOCATE FP+1+P,FQ+2+Q                                  'PUT_WCUR
  574. 6020  RETURN
  575. 6030  IF FPTR>BDEFS THEN F$="d":J=FPTR-BDEFS                'PUT_ARG
  576. 6040  IF FPTR<BDEFS THEN F$="x":J=FPTR-BVARS
  577. 6050  PRINT F$;MID$(STR$(J)+"   ",2,3);
  578. 6060  RETURN
  579. 6070  REM<UNK! {0009}>HYPOTHESIS TESTING
  580. 6080  REM                                                   'TEST_DATA
  581. 6090  DATA "HYPOTHESIS TESTING"
  582. 6100  DATA "12345"
  583. 6110  DATA " "
  584. 6120  DATA " "
  585. 6130  DATA "    1    SINGLE MEAN"
  586. 6140  DATA " "
  587. 6150  DATA "    2    TWO MEANS"
  588. 6160  DATA " "
  589. 6170  DATA "    3    SINGLE VARIANCE"
  590. 6180  DATA " "
  591. 6190  DATA "    4    TWO VARIANCES"
  592. 6200  DATA " "
  593. 6210  DATA "    5    RETURN TO MAIN MENU"
  594. 6220  DATA ""
  595. 6230  IF FILSPEC$="" THEN GOSUB 4090:RETURN                 'TEST;openfilemsg
  596. 6240  MD=TEST:RESTORE 6080:READ X$:READ CMD$                'test_data
  597. 6250  GOSUB 2490:GOSUB 3170:GOSUB 2120                      'putchdr;putdata;getchoice
  598. 6260  IF CMD=5 OR FCMD=QRET OR FCMD=ESC THEN RETURN
  599. 6265  IF FCMD THEN GOTO 6240
  600. 6270  TCMD=CMD:MD=CMD+3:X$=THDR$(CMD):GOSUB 2490                     'putchdr
  601. 6280  GOSUB 7700:IF FCMD=QRET THEN RETURN                   'get_params
  602. 6290  IF FCMD THEN GOTO 6230                                'test
  603. 6300  IF TCMD=1 OR TCMD=3 THEN U(1,0)=0
  604. 6310  GOSUB 3460                                            'read_casefile
  605. 6320  GOSUB 2990                                            'putprompt
  606. 6330  PRINT "COMPUTING TEST VALUES...";
  607. 6340  GOSUB 7980                                            'do_test
  608. 6350  GOSUB 3020                                            'clf
  609. 6360  GOSUB 6450                                            'put_ndx
  610. 6370  GOSUB 6540                                            'put_sstats
  611. 6380  GOSUB 6880                                            'put_tst
  612. 6390  GOSUB 6990                                            'put_cfd
  613. 6400  GOSUB 7080                                            'put_hyp
  614. 6410  GOSUB 2990                                            'END_TEST;putprompt
  615. 6420  PRINT "FUNCTION COMPLETED";
  616. 6430  GOSUB 2160                                            'get_cr
  617. 6440  GOTO 6230                                             'test
  618. 6450  SJ=0:GOSUB 6490                                       'PUT_NDX;put_ndx_
  619. 6460  IF TCMD=1 OR TCMD=3 THEN RETURN
  620. 6470  SJ=1:GOSUB 6490                                       'put_ndx_
  621. 6480  RETURN
  622. 6490  FPTR=U(SJ,0):IF FPTR=0 THEN RETURN                    'PUT_NDX_
  623. 6500  P=1:Q=1:IF SJ THEN Q=42
  624. 6510  GOSUB 6010:PRINT "VARIABLE   ";                       'put_wcur
  625. 6520  GOSUB 6030:PRINT ": "W$(FPTR);                        'put_arg
  626. 6530  RETURN
  627. 6540  P=3:SJ=0                                              'PUT_SSTATS
  628. 6550  IF TCMD=1 OR TCMD=3 THEN GOTO 6560 ELSE GOTO 6700     'put_1ss;put_2ss
  629. 6560  Q=1                                                   'PUT_1SS
  630. 6570  LSET WBUF$="SAMPLE MEAN:    "+STR$(U(SJ,4))
  631. 6580  GOSUB 6010:PRINT WBUF$                                'put_wcur
  632. 6590  Q=42
  633. 6600  LSET WBUF$="SAMPLE STD.DEV.:"+STR$(U(SJ,6))
  634. 6610  GOSUB 6010:PRINT WBUF$                                'put_wcur
  635. 6620  P=P+1
  636. 6630  Q=1
  637. 6640  LSET WBUF$="SAMPLE VARIANCE:"+STR$(U(SJ,5))
  638. 6650  GOSUB 6010:PRINT WBUF$                                'put_wcur
  639. 6660  Q=42
  640. 6670  LSET WBUF$="SAMPLE STD.ERR.:"+STR$(U(SJ,7))
  641. 6680  GOSUB 6010:PRINT WBUF$                                'put_wcur
  642. 6690  RETURN
  643. 6700  Q=1:SJ=0:GOSUB 6820                                   'PUT_2SS;put_sm
  644. 6710  Q=42:SJ=1:GOSUB 6820                                  'put_sm
  645. 6720  P=P+1
  646. 6730  Q=1:SJ=0:GOSUB 6850                                   'put_sd
  647. 6740  Q=42:SJ=1:GOSUB 6850                                  'put_sd
  648. 6750  P=P+1:Q=1:GOSUB 6010                                  'put_wcur
  649. 6760  IF TCMD=2 THEN LSET WBUF$= "DIFFERENCE:     "+STR$(T(11)) ELSE LSET WBUF$="RATIO:          "+STR$(T(11))
  650. 6770  PRINT WBUF$;
  651. 6780  Q=42:GOSUB 6010                                       'put_wcur
  652. 6790  LSET WBUF$="STANDARD ERROR: "+STR$(T(10))
  653. 6800  PRINT WBUF$;
  654. 6810  RETURN
  655. 6820  LSET WBUF$="SAMPLE MEAN:    "+STR$(U(SJ,4))           'PUT_SM
  656. 6830  GOSUB 6010:PRINT WBUF$                                'put_wcur
  657. 6840  RETURN
  658. 6850  LSET WBUF$="SAMPLE STD.DEV.:"+STR$(U(SJ,6))           'PUT_SD
  659. 6860  GOSUB 6010:PRINT WBUF$                                'put_wcur
  660. 6870  RETURN
  661. 6880  P=6:Q=1:GOSUB 6010:                                   'PUT_TST;put_wcur
  662. 6890  IF TCMD=3 THEN PRINT "CHI SQ. TEST USED: CHI SQ=";:GOTO 6930'put_tst_
  663. 6900  IF TCMD=4 THEN PRINT "F-TEST USED: F =";:GOTO 6930    'put_tst_
  664. 6910  IF T(7)=1 THEN PRINT "T-TEST USED: T =";:GOTO 6930    'put_tst_
  665. 6920  PRINT "NORMAL TEST USED: Z =";
  666. 6930  PRINT T(8);                                           'PUT_TST_
  667. 6940  IF TCMD<3 AND T(7)=0 THEN RETURN<UNK! {0009}>
  668. 6950  Q=42:GOSUB 6010                                       'put_wcur
  669. 6960  LSET WBUF$="DEGREES OF FREEDOM:"+STR$(T(9))
  670. 6970  PRINT WBUF$;
  671. 6980  RETURN
  672. 6990  IF T(1)=-1 THEN RETURN                                'PUT_CFD
  673. 7000  P=7:Q=1:GOSUB 6010                                    'put_wcur
  674. 7010  PRINT MID$(STR$(T(1)),2);"% CONFIDENCE LEVEL ON ";
  675. 7020  IF TCMD=2 THEN PRINT "DIFFERENCE OF ";
  676. 7030  IF TCMD=4 THEN PRINT "RATIO OF ";
  677. 7040  IF TCMD<3 THEN PRINT "MEAN"; ELSE PRINT "VARIANCE";
  678. 7050  IF TCMD=2 OR TCMD=4 THEN PRINT "S";
  679. 7060  PRINT ":";T(5)" TO";T(6)
  680. 7070  RETURN
  681. 7080  COLOR 1,0                                             'PUT_HYP
  682. 7090  P=9
  683. 7100  Q=1:GOSUB 6010:PRINT "NULL HYPOTHESIS"                'put_wcur
  684. 7110  Q=30:GOSUB 6010:PRINT "ALTERNATIVE"                   'put_wcur
  685. 7120  Q=55:GOSUB 6010:PRINT "SIGNIFICANCE LEVEL"            'put_wcur
  686. 7130  COLOR 7,0
  687. 7140  IF TCMD=1 THEN X$="MEAN" ELSE IF TCMD=2 THEN X$="DIFFERENCE" ELSE IF TCMD=3 THEN X$="VARIANCE" ELSE X$="RATIO"
  688. 7150  Q=1
  689. 7160  P=P+1:Y$=">=":GOSUB 7330                              'put_hyp_
  690. 7170  P=P+1:Y$="<=":GOSUB 7330                              'put_hyp_
  691. 7180  P=P+1:Y$=" =":GOSUB 7330                              'put_hyp_
  692. 7190  P=P-3
  693. 7200  Q=31
  694. 7210  IF TCMD=2 THEN Q=Q-3 ELSE IF TCMD=3 THEN Q=Q-2
  695. 7220  P=P+1:Y$=" <":GOSUB 7330                              'put_hyp_
  696. 7230  P=P+1:Y$=" >":GOSUB 7330                              'put_hyp_
  697. 7240  P=P+1:Y$="<>":GOSUB 7330                              'put_hyp_
  698. 7250  P=P-3
  699. 7260  Q=61
  700. 7270  P=P+1:J=2:GOSUB 7310                                  'put_sigl
  701. 7280  P=P+1:J=3:GOSUB 7310                                  'put_sigl
  702. 7290  P=P+1:J=4:GOSUB 7310                                  'put_sigl
  703. 7300  RETURN
  704. 7310  GOSUB 6010:PRINT USING "#.###";T(J);                  'PUT_SIGL;put_wcur
  705. 7320  RETURN
  706. 7330  GOSUB 6010:PRINT X$;" ";Y$;T(0);                      'PUT_HYP_;put_wcur
  707. 7340  RETURN
  708. 7350  PROMPT$="ENTER INDEX OF"+PROMPT$+" VARIABLE TO TEST"
  709. 7360  GOSUB 5810
  710. 7370  IF FCMD THEN RETURN                   'get_arg
  711. 7380  REM
  712. 7390  U(SVEC,0)=FPTR:SJ=SVEC:GOSUB 6450                     'put_ndx
  713. 7400  RETURN
  714. 7410  GOSUB 2990:PRINT "ENTER STANDARD DEVIATION OF ";ARG$;" (ENTER ALONE=NONE)";'GET_SD;putprompt
  715. 7420  MAXLIN=8:GOSUB 2190:IF FCMD THEN RETURN               'getlin
  716. 7430  IF LIN$="" THEN U(SVEC,1)=-1:RETURN
  717. 7440  U(SVEC,1)=VAL(LIN$)
  718. 7450  IF U(SVEC,1)<=0 THEN GOSUB 7580:GOTO 7410             'param_err;get_sd
  719. 7460  LSET WBUF$="STANDARD DEV.:  "+STR$(U(SVEC,1))
  720. 7470  P=3:Q=1:IF SVEC THEN Q=42
  721. 7480  GOSUB 6010:PRINT WBUF$;                               'put_wcur
  722. 7490  RETURN
  723. 7500  GOSUB 2990:PRINT "ENTER HYPOTHESIZED ";PROMPT$;       'GET_HYP;putprompt
  724. 7510  MAXLIN=8:GOSUB 2190:IF FCMD THEN RETURN               'getlin
  725. 7520  T(0)=VAL(LIN$)
  726. 7530  IF TCMD>2 AND T(0)<0 THEN GOSUB 7580:GOTO 7500        'param_err;get_hyp
  727. 7540  IF TCMD=4 AND T(0)=0 THEN GOSUB 7580:GOTO 7500        'param_err;get_hyp
  728. 7550  P=4:Q=1:GOSUB 6010                                    'put_wcur
  729. 7560  PRINT "HYPOTHESIZED ";PROMPT$;T(0);SPACE$(10)
  730. 7570  RETURN
  731. 7580  GOSUB 2990                                            'PARAM_ERR;putprompt
  732. 7590  PRINT "BAD PARAMETER VALUE";
  733. 7600  PRINT " <CR> TO CONTINUE ";                           'get_cr
  734. 7605  X$=INPUT$(1)
  735. 7606  IF X$<>CHR$(13) AND X$<>CHR$(27) THEN GOTO 7605
  736. 7610  RETURN
  737. 7620  GOSUB 2990:PRINT "ENTER CONFIDENCE LEVEL(75%-99%) (ENTER ALONE=NONE)";'GET_CFD;putprompt
  738. 7630  MAXLIN=4:GOSUB 2190:IF FCMD THEN RETURN               'getlin
  739. 7640  IF LIN$="" THEN T(1)=-1:RETURN
  740. 7650  T(1)=VAL(LIN$)
  741. 7660  IF T(1)<75 OR T(1)>99 THEN GOSUB 7580:GOTO 7620       'param_err;get_cfd
  742. 7670  P=5:Q=1:GOSUB 6010                                    'put_wcur
  743. 7680  PRINT MID$(STR$(T(1)),2);"% CONFIDENCE LEVEL    ";
  744. 7690  RETURN
  745. 7700  GOSUB 3020                                            'GET_PARAMS;clf
  746. 7710  SVEC=0
  747. 7720  U(0,0)=0:U(1,0)=0<UNK! {0009}>
  748. 7730  U(0,1)=-1:U(1,1)=-1<UNK! {0009}>
  749. 7740  T(0)=0<UNK! {0009}>
  750. 7750  T(1)=-1<UNK! {0009}>
  751. 7760  T(7)=0<UNK! {0009}>
  752. 7770  IF TCMD=2 OR TCMD=4 THEN PROMPT$=" FIRST" ELSE PROMPT$=""
  753. 7780  GOSUB 7950:IF FCMD=QRET OR FCMD=ESC THEN RETURN       'get_params1
  754. 7790  IF FCMD THEN 7700                                'get_params
  755. 7800  IF TCMD=1 OR TCMD=3 THEN GOTO 7840                    'get_params2
  756. 7810  SVEC=1:PROMPT$=" SECOND"
  757. 7820  GOSUB 7950:IF FCMD=QRET THEN RETURN                   'get_params1
  758. 7830  IF FCMD THEN GOTO 7700                                'get_params
  759. 7840  IF TCMD=1 THEN PROMPT$="MEAN"                         'GET_PARAMS2
  760. 7850  IF TCMD=2 THEN PROMPT$="DIFFERENCE"
  761. 7860  IF TCMD=3 THEN PROMPT$="VARIANCE"
  762. 7870  IF TCMD=4 THEN PROMPT$="VALUE OF VARIANCE RATIO"
  763. 7880  GOSUB 7500:IF FCMD=QRET THEN RETURN                   'get_hyp
  764. 7890  IF FCMD THEN GOTO 7700                                'get_params
  765. 7900  GOSUB 7620:IF FCMD=QRET THEN RETURN                   'get_cfd
  766. 7910  IF FCMD THEN GOTO 9340                                'get_param2
  767. 7920  GOSUB 2990:PRINT "OK TO PROCEED WITH TEST";           'putprompt
  768. 7930  GOSUB 2140:IF X$="Y" OR FCMD=QRET THEN RETURN         'getyesno
  769. 7940  GOTO 7700                                             'get_params
  770. 7950  GOSUB 7350:IF FCMD THEN RETURN                        'GET_PARAMS1;get_ndx
  771. 7960  IF TCMD<3 THEN GOSUB 7410                             'get_sd
  772. 7970  RETURN
  773. 7980  SX=U(0,1)                                             'DO_TEST
  774. 7990  N1=U(0,3)
  775. 8000  M1=U(0,4)
  776. 8010  S1=U(0,6)
  777. 8020  IF N1=0 THEN GOTO 8140                                'abort_test
  778. 8030  IF SX+S1=-1 THEN GOTO 8180                            '0variance
  779. 8040  IF TCMD=1 OR TCMD=3 THEN GOTO 8110                    'do_test_
  780. 8050  SY=U(1,1)
  781. 8060  N2=U(1,3)
  782. 8070  M2=U(1,4)
  783. 8080  S2=U(1,6)
  784. 8090  IF N2=0 THEN 8140                                     'abort_test
  785. 8100  IF SY+S2=-1 THEN GOTO 8180                            '0variance
  786. 8110  HV=T(0):PP=T(1)                                       'DO_TEST_
  787. 8120  ON TCMD GOSUB 8220,8420,8580,8800                     '1mean;2mean;1var;2var
  788. 8130  RETURN
  789. 8140  GOSUB 2990                                            'ABORT_TEST;putprompt
  790. 8150  PRINT "NO CASE SELECTED: CANNOT PERFORM TEST.";
  791. 8160  GOSUB 2160                                            'get_cr
  792. 8170  GOTO 6410                                             'end_test
  793. 8180  GOSUB 2990                                            '0VARIANCE;putprompt
  794. 8190  PRINT "VARIANCE = 0: CANNOT PERFORM TEST.";
  795. 8200  GOSUB 2160                                            'get_cr
  796. 8210  RETURN
  797. 8220  D1=1                                                  '1MEAN
  798. 8230  IF SX<=0 THEN D2=N1-1 ELSE D2=1E+20
  799. 8240  IF PP<=0 THEN GOTO 8280                               '1mean_
  800. 8250  P=(100+PP)/2
  801. 8260  GOSUB 9010                                            '20000
  802. 8270  T=SQR(F)
  803. 8280  IF SX<=0 THEN SS=S1/SQR(N1) ELSE SS=SX/SQR(N1)        '1MEAN_
  804. 8290  Z=M1-HV
  805. 8300  Z=Z/SS
  806. 8310  F=Z*Z
  807. 8320  GOSUB 9180                                            '30000
  808. 8330  IF SX<=0 THEN T(7)=1 ELSE T(7)=0<UNK! {0009}>                     'MEAN
  809. 8340  T(8)=Z<UNK! {0009}>
  810. 8350  T(9)=D2<UNK! {0009}>
  811. 8360  T(10)=SS<UNK! {0009}>
  812. 8370  IF M1>HV THEN T(2)=1-A/2 ELSE T(2)=A/2<UNK! {0009}>
  813. 8380  IF M1<HV THEN T(3)=1-A/2 ELSE T(3)=A/2
  814. 8390  T(4)=A
  815. 8400  IF PP>0 THEN T(5)=M1-SS*T:T(6)=M1+SS*T<UNK! {0009}>
  816. 8410  RETURN
  817. 8420  D1=1                                                  '2MEAN
  818. 8430  IF SX<=0 THEN D2=N1+N2-2 ELSE D2=1E+20
  819. 8440  IF PP<=0 THEN GOTO 8480                               '2mean_
  820. 8450  P=(100+PP)/2
  821. 8460  GOSUB 9010                                            '20000
  822. 8470  T=SQR(F)
  823. 8480  IF SX<=0 THEN SS=SQR((((N1-1)*S1^2+(N2-1)*S2^2)/D2)*(N1+N2)/(N1*N2))'2MEAN
  824. 8490  IF SX>0 THEN SS=SQR(S1^2/N1+S2^2/N2)
  825. 8500  Z=M1-M2-HV
  826. 8510  Z=Z/SS
  827. 8520  F=Z*Z
  828. 8530  GOSUB 9180                                            '30000
  829. 8540  M1=M1-M2
  830. 8550  GOSUB 8330                                            'mean
  831. 8560  T(11)=M1
  832. 8570  RETURN
  833. 8580  D1=N1-1                                               '1VAR
  834. 8590  D2=1E+20
  835. 8600  IF PP<=0 THEN GOTO 8670                               '1var_
  836. 8610  P=(100+PP)/2
  837. 8620  GOSUB 9010                                            '20000
  838. 8630  T=F
  839. 8640  P=(100-PP/2)<UNK! {0009}>
  840. 8650  GOSUB 9010                                            '20000
  841. 8660  T1=F
  842. 8670  SS=S1/SQR(N1)                                         '1VAR_
  843. 8680  F=S1^2/HV
  844. 8690  Z=F*D1
  845. 8700  GOSUB 9180                                            '30000
  846. 8710  T(8)=Z
  847. 8720  T(9)=D1<UNK! {0009}>
  848. 8730  T(10)=SS
  849. 8740  T(11)=S1^2<UNK! {0009}>
  850. 8750  T(2)=1-A<UNK! {0009}>
  851. 8760  T(3)=A<UNK! {0009}>
  852. 8770  IF A<0.5 THEN T(4)=2*A ELSE T(4)=2*(1-A)
  853. 8780  IF PP>0 THEN T(5)=S1^2/T:T(6)=S1^2/T1
  854. 8790  RETURN
  855. 8800  D1=N1-1                                               '2VAR
  856. 8810  D2=N2-1<UNK! {0009}>
  857. 8820  IF PP<=0 THEN GOTO 8890                               '2var_
  858. 8830  P=(100+PP)/2
  859. 8840  GOSUB 9010                                            '20000
  860. 8850  T=F
  861. 8860  P=(100-PP)/2
  862. 8870  GOSUB 9010                                            '20000
  863. 8880  T1=F
  864. 8890  SS=SQR(S1^2/N1+S2^2/N2)<UNK! {0009}>                              '2VAR_
  865. 8900  F=(1/HV)*S1^2/S2^2
  866. 8910  GOSUB 9180                                            '30000
  867. 8920  T(8)=F
  868. 8930  T(9)=D2<UNK! {0009}>
  869. 8940  T(10)=SS
  870. 8950  T(11)=(S1/S2)^2<UNK! {0009}>
  871. 8960  IF F>HV THEN T(2)=1-A ELSE T(2)=A
  872. 8970  IF F<HV THEN T(3)=1-A ELSE T(3)=A
  873. 8980  IF A<0.5 THEN T(4)=2*A ELSE T(4)=2*(1-A)
  874. 8990  IF PP>0 THEN T(5)=F*T1:T(6)=F*T<UNK! {0009}>
  875. 9000  RETURN
  876. 9010  P=(100-P)/100                                         '20000
  877. 9020  B1=10
  878. 9030  FOR LL = 1 TO 10
  879. 9040  F=B1
  880. 9050  GOSUB 9180                                            '30000
  881. 9060  IF A<P THEN LL=10
  882. 9070  B1=B1*10
  883. 9080  NEXT
  884. 9090  L1=0.05
  885. 9100  B1=1024
  886. 9110  FOR LL = 1 TO 100
  887. 9120  F=(L1+B1)/2
  888. 9130  GOSUB 9180                                            '30000
  889. 9140  IF ABS(A-P)<0.000999999 THEN RETURN
  890. 9150  IF A>P THEN L1=F ELSE B1=F
  891. 9160  NEXT
  892. 9170  RETURN
  893. 9180  IF D1*D2*F<=0 THEN A=1:RETURN                         '30000
  894. 9190  IF F<1 THEN GOTO 9240                                 '34000
  895. 9200  V1=D1
  896. 9210  V2=D2
  897. 9220  F1=F
  898. 9230  GOTO 9270                                             '35000
  899. 9240  V1=D2                                                 '34000
  900. 9250  V2=D1
  901. 9260  F1=1/F
  902. 9270  V3=2/(9*V1)                                           '35000
  903. 9280  V4=2/(9*V2)
  904. 9290  ZZ=ABS(((1-V4)*F1^(1/3)-1+V3)/SQR(V4*F1^(2/3)+V3))
  905. 9300  IF V2<4 THEN ZZ=ZZ*(1+0.08*ZZ^4/V2^3)
  906. 9310  A=0.5/(1+ZZ*(0.196854+ZZ*(0.115194+ZZ*(0.000343999+ZZ*0.019527))))^4
  907. 9320  IF F<1 THEN A=1-A
  908. 9330  RETURN
  909. 9340  STOP                                                  'NULL LABEL
  910.