home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 3.img / STATLIB1.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-08-01  |  18.0 KB  |  350 lines
  1. 30  CLS:WIDTH 80:KEY OFF:LOCATE 1,30:COLOR 0,7:PRINT" >>> STATLIB 1 <<< ":COLOR 7,0:LOCATE 3,24:PRINT"Volume One -- Descriptive Statistics";:COLOR 0,7:X$=CHR$(186)
  2. 70  LOCATE5,10,0:PRINTCHR$(201)+STRING$(59,205)+CHR$(187):LOCATE19,10:PRINTCHR$(200)+STRING$(59,205)+CHR$(188):FORW=6TO18:LOCATEW,10:PRINTX$:LOCATEW,70:PRINTX$:NEXT:COLOR0,15:COLOR7,0:LOCATE7,29:PRINT"Designed by Dale Benzer
  3. 120  LOCATE9,26:PRINT"Programmed by Peter Schlaifer":LOCATE11,37:PRINT"For":LOCATE13,25:PRINT"THE PC DISK LIBRARY OF SOFTWARE":LOCATE15,32:PRINT"Copyright 1984 ":LOCATE17,26:PRINT"ZIFF-DAVIS PUBLISHING CO., INC.
  4. 170  LOCATE22,26:PRINT"PRESS ANY KEY TO CONTINUE
  5. 180  A$=INKEY$:IFA$=""THEN180
  6. 190  LOCATE22,26,0:PRINTSPACE$(40):LOCATE22,26:CLEAR,,2500:PRINT"initializing STATLIB 1 ...":GOSUB1090:GOSUB1220:ONERRORGOTO4020
  7. 1060  GOSUB1600:GOSUB2140:MD=-1:GOTO3900
  8. 1090  KEYOFF:FORJ=1TO10:KEYJ,"":NEXT:LOCATE,,0:CR$=CHR$(13):ESC$=CHR$(27):NL$=CHR$(13):RS$=CHR$(28):LS$=CHR$(29):US$=CHR$(30):DS$=CHR$(31):DEFFNK$(J)=CHR$(0)+CHR$(J):F1$=FNK$(59):F2$=FNK$(60):F3$=FNK$(61):F4$=FNK$(62):F5$=FNK$(63)
  9. 1140  ECMD$="F1 HELP  F2 QUIT/RETURN  F3 CONTINUE/SAVE  F4 REDO  F5 VIEW":RETURN
  10. 1220  DEFINTA-Z:DEFSNGA,U,V:I=0:J=0:K=0:L=0:P=0:Q=0:ARG=0:ARG1=0:ARG2=0:U=0:V=0:X$="":Y$="":W$="":LIN$="":ARG$="":NVARS=0:NDEFS=0:NSUBS=0:NCASE=0<UNK! {0009}>:BPTR=0:FPTR=0:NPTR=0:MAXPTR=0<UNK! {0009}>:F0=0:F1=0:F2=0:FF=0:VFLAG=0<UNK! {0009}>:FCMD=0:CMD=0:CMD$=""<UNK! {0009}>
  11. 1290  FPROMPT$="":FTYP$="":FTYP=0:ZPTR=0:JJ=0:CCASE=0:MD=0:U1=0:U2=0:V1=0:V2=0:UHIGH=-1E+06:ULOW=1E+06:VLOW=ULOW:VHIGH=UHIGH:MAIN=0:OPIN=1:SELS=2:FREQ=3:HIST=4:SCAT=5:FUNC=6:PRNT=7:EXIT=8:HELP=1:QRET=2:QSAV=3:REDO=4:VYEW=5:ESC=-1:FC=12<UNK! {0009}>:FD=6<UNK! {0009}>
  12. 1360  FJ=4:FL=14:FW=FL*FJ:NC=(FC+FD)*FJ:FP=4:FQ=((78-NC)/2)-1:MAXLIN=FC:MAXSTEPS=FL-4:FC$=SPACE$(FC):FD$=SPACE$(FD-3):FE$=SPACE$(FC+FD):FL$=SPACE$(NC):NW$=NL$+STRING$(FQ+2,RS$):FILSPEC$="":FILDESC$=""
  13. 1370  LCHAR$=CHR$(219):HLCHAR$=CHR$(220)
  14. 1510  NOCHAR$=" ":NOT0CHAR$="_":MAXBUF=127:BVARS=0:BUFSIZ=MAXBUF:GOSUB2720:K=BVARS+MAXLBLS+1:DIMW$(K):FORJ=1TOK-1:W$(J)=FC$:NEXT:DIMS(MAXSUBS+1),V(MAXVARS+MAXDEFS+1):DIMC(MAXSTEPS+2)<UNK! {0009}>:MAXCASE=4000:DIMU(MAXCASE)<UNK! {0009}>:RETURN
  15. 1600  CLS:RETURN
  16. 1610  LOCATEP,Q:RETURN
  17. 1620  LOCATE,,1:X$=INKEY$:IFX$=""THEN1620
  18. 1630  GOSUB1650:IFX$=""THEN1620
  19. 1640  LOCATE,,0:RETURN
  20. 1650  FCMD=0:IFX$>=" "ORX$=CR$ORX$=CHR$(8)THENRETURN
  21. 1660  IFX$=F1$THENGOSUB3210:X$=ESC$
  22. 1670  IFX$=F2$THENFCMD=QRET:RETURN
  23. 1680  IFX$=F3$THENFCMD=QSAV:RETURN
  24. 1690  IFX$=F4$THENFCMD=REDO:RETURN
  25. 1700  IFX$=F5$THENGOSUB3610:X$=ESC$
  26. 1710  IFX$=ESC$THENFCMD=ESC:RETURN
  27. 1720  X$="":RETURN
  28. 1730  PROMPT$="Your choice":GOSUB2260:GOSUB1740:RETURN
  29. 1740  GOSUB1620:CMD=0:IFFCMD<>0THENRETURN
  30. 1750  GOSUB1920:CMD=INSTR(CMD$,X$):IFCMDTHENRETURN
  31. 1760  GOTO1740
  32. 1770  GOSUB2260:PRINT"  Y/N  ";:CMD$="YN":GOSUB1740:RETURN
  33. 1790  GOSUB2260:PRINT"...CR to continue...";:CMD$=CR$:GOSUB1740:RETURN
  34. 1810  GOSUB2260:LIN$="":GOSUB1820:RETURN
  35. 1820  GOSUB1620:IFX$>=" "THENGOSUB1880:GOTO1820
  36. 1840  IFX$=CHR$(8)THENGOSUB1900:GOTO1820
  37. 1850  IFX$=CR$THENRETURN
  38. 1860  IFFCMD<>0THENLIN$="":RETURN
  39. 1870  GOTO1820
  40. 1880  IFLEN(LIN$)<MAXLINTHENLIN$=LIN$+X$:PRINTX$;
  41. 1890  RETURN
  42. 1900  J=LEN(LIN$):IFJ>0THENPRINTLS$" "LS$;:LIN$=LEFT$(LIN$,J-1)
  43. 1910  RETURN
  44. 1920  IFX$=""THENRETURN
  45. 1930  J=ASC(X$):IFJ>96ANDJ<123THENJ=J-32
  46. 1940  X$=CHR$(J):RETURN
  47. 1950  IFX$=""THENRETURN
  48. 1960  J=ASC(X$):IFJ>64ANDJ<91THENJ=J+32
  49. 1970  X$=CHR$(J):RETURN
  50. 1980  P=1:Q=20:GOSUB1610:PRINTSPACE$(40);:X$=">>>  "+X$+"  <<<":Q=40-LEN(X$)\2:GOSUB1610:COLOR0,7:PRINTX$;:COLOR7,0:RETURN
  51. 2030  P=FP-1:Q=40:GOSUB1610:PRINTSPACE$(40-FQ);:Q=80-FQ-LEN(X$):GOSUB1610:PRINTX$;:RETURN
  52. 2050  P=FP-1:Q=FQ+1:GOSUB1610:PRINTSPACE$(40-FQ-1):GOSUB1610:PRINTX$;:RETURN
  53. 2070  X$=FILSPEC$:IFX$=""THENX$="NO FILE OPENED":GOSUB2050:X$="":GOSUB2030:RETURN
  54. 2090  IFFILDESC$<>""THENX$=X$+"/"+FILDESC$
  55. 2100  X$="FILE: "+X$:GOSUB2050:X$="NO":IFNCASE<>0THENX$=STR$(NCASE)
  56. 2120  IFNCASE<>1THENX$=X$+" CASES ENTERED":GOSUB2030:RETURN
  57. 2130  X$="1 CASE ENTERED":GOSUB2030:RETURN
  58. 2140  P=FP:K=FP+1+FL:FORQ=FQ+1TO79-FQ:GOSUB1610:COLOR0,7:PRINTCHR$(205);:NEXT:GOSUB1610:PRINTCHR$(187);:FORP=FP+1TOK:GOSUB1610:PRINTCHR$(186);:NEXT:GOSUB1610:PRINTCHR$(188);:FORQ=79-FQTOFQ+1STEP-1:GOSUB1610:PRINTCHR$(205);:NEXT
  59. 2200  GOSUB1610:PRINTCHR$(200);:FORP=KTOFP+1STEP-1:GOSUB1610:PRINTCHR$(186);:NEXT:GOSUB1610:PRINTCHR$(201);:COLOR7,0:RETURN
  60. 2230  P=21:Q=FQ+2:GOSUB2290:Q=40-LEN(X$)\2:GOSUB1610:PRINTX$;:RETURN
  61. 2260  P=23:Q=FQ+2:GOSUB2290:PRINTPROMPT$"  ";:RETURN
  62. 2270  PROMPT$=PROMPT$+"...CR to continue":GOSUB2260:CMD$=CR$:GOSUB1740:RETURN
  63. 2290  GOSUB1610:PRINTSPACE$(79-Q);:GOSUB1610:RETURN
  64. 2300  GOSUB2320:FORL=1TOFL:GOSUB2330:PRINTFL$;:NEXT:GOSUB2320:RETURN
  65. 2320  P=FP+1:Q=FQ+2:GOSUB1610;:RETURN
  66. 2330  PRINTNL$STRING$(FQ+2,RS$);:RETURN
  67. 2340  IFF2=F0-1THENGOSUB2480:RETURN
  68. 2350  GOSUB2320:F1=FW*(F1\FW):IFF1>(F2-F0+1)ORF1<0THENF1=0
  69. 2360  K=F0+F1:FORL=1TOFL:GOSUB2330:IFK<=F2THENGOSUB2420 ELSEPRINTFL$;
  70. 2400  NEXT:RETURN
  71. 2420  FORJ=KTOK+FJ-1:IFJ<=F2THENGOSUB2470 ELSEPRINTFE$;
  72. 2440  NEXT:K=K+FJ:RETURN
  73. 2470  LSETFD$=MID$(STR$(J-F0+1),2):PRINTF$FD$": "W$(J);:RETURN
  74. 2480  X$=FL$:LSETX$="Nothing entered":GOSUB2320:GOSUB2330:PRINTX$;:FORJ=2TOFL:GOSUB2330:PRINTFL$;:NEXT:RETURN
  75. 2500  GOSUB2320:Y$=FL$:READX$:FORL=1TOFL:GOSUB2330:IFX$<>""THENGOSUB2550 ELSEPRINTFL$;
  76. 2530  NEXT:RETURN
  77. 2550  LSETY$=X$:READX$:PRINTY$;:RETURN
  78. 2570  FCMD=0:ONERRORGOTO2690
  79. 2580  PROMPT$="LOADING "+FILNAM$:GOSUB2260:LIN$=FILSPEC$+".STL":OPEN "I",#1,LIN$:INPUT#1,FILNAM$,FILDESC$,BUFSIZ:GOSUB2720:INPUT#1,NVARS,NDEFS,NSUBS,NCASE:FORJ=1TONVARS:INPUT#1,X$:LSETW$(BVARS+J)=X$:NEXT
  80. 2630  FORJ=1TONDEFS:INPUT#1,X$:LSETW$(BDEFS+J)=X$:NEXT:FORJ=1TONSUBS:INPUT#1,X$:LSETW$(BSUBS+J)=X$:NEXT:CLOSE#1:GOSUB2070:CCASE=0:LIN$=FILSPEC$+".DAT":OPEN "R",#1,LIN$,BUFSIZ:FIELD#1,BUFSIZ AS CB$
  81. 2680  ONERRORGOTO4020:RETURN
  82. 2690  PROMPT$="CAN'T OPEN "+LIN$:GOSUB1790:FILSPEC$="":CLOSE:FCMD=REDO:RESUME2680
  83. 2720  MAXVARS=BUFSIZ:MAXDEFS=BUFSIZ\4:MAXSUBS=BUFSIZ:MAXLBLS=MAXVARS+MAXDEFS+MAXSUBS:BDEFS=BVARS+MAXVARS:BSUBS=BDEFS+MAXDEFS:BVALS=BSUBS+MAXSUBS:RETURN
  84. 2760  SEL=0:IFCCASE<0THENRETURN
  85. 2770  WHILESEL=0ANDCCASE<NCASE:SEL=1:CCASE=CCASE+1:GET#1,CCASE*4:FORJ=1TOS(0):IFMID$(CB$,S(J),1)="0"THENSEL=0:J=S(0)
  86. 2810  NEXT:WEND:IFSEL>0THENNSEL=NSEL+1:GOSUB2900:RETURN
  87. 2840  IFNSEL>2THENX$=STR$(NSEL)+" CASES
  88. 2850  IFNSEL=1THENX$="ONE CASE
  89. 2860  IFNSEL=0THENX$="NO CASES
  90. 2870  X$=X$+" SELECTED":GOSUB2030:CCASE=-1:RETURN
  91. 2900  GET#1,CCASE*4-3:X$=CB$:GET#1:X$=X$+CB$:FORJ=1TONVARS:V(BVARS+J)=CVI(MID$(X$,J+J-1)):NEXT:GET#1:FORJ=1TONDEFS:V(BDEFS+J)=CVS(MID$(CB$,J*4-3)):NEXT:V(0)=CCASE:X$="SELECTED CASE NUMBER"+STR$(CCASE):GOSUB2030:RETURN
  92. 2960  GOSUB3040:IFFCMD=QRETTHENRETURN
  93. 2970  IFFCMD<>0THEN2960
  94. 2980  GOSUB3110:IFFCMD=QRETTHENRETURN
  95. 2990  IFFCMD<>0THEN2960
  96. 3000  CLOSE:FILSPEC$="":X$=FILNAM$:IFFILDRV$<>""THENX$=FILDRV$+":"+X$
  97. 3020  FILSPEC$=X$:RETURN
  98. 3040  PROMPT$="Enter filename":MAXLIN=8:GOSUB1810:IFFCMD=ESCTHEN3040
  99. 3060  IFFCMD<>0THENRETURN
  100. 3070  IFLIN$<=SPACE$(8)THENLIN$=FILNAM$
  101. 3080  FILNAM$=LIN$:IFFILNAM$=""THENFCMD=QRET
  102. 3090  RETURN
  103. 3110  PROMPT$="On drive ":GOSUB2260:GOSUB1620:IFFCMD=ESCTHEN3110
  104. 3130  IFFCMD<>0ORX$=CR$THENRETURN
  105. 3140  GOSUB1920:IFINSTR("ABCD",X$)THENFILDRV$=X$:RETURN
  106. 3160  IFX$=" "THENFILDRV$="":RETURN
  107. 3170  GOTO3110
  108. 3190  PROMPT$="File must be first opened from main menu":GOSUB2270:RETURN
  109. 3210  IFMD=MAINTHENRESTORE3320
  110. 3220  IF MD=OPIN THEN RESTORE 3370
  111. 3230  IFMD=SELSTHENRESTORE3400
  112. 3240  IFMD=FREQTHENRESTORE3430
  113. 3250  IFMD=HISTTHENRESTORE3460
  114. 3260  IFMD=SCATTHENRESTORE3490
  115. 3270  IFMD=FUNCTHENRESTORE3520
  116. 3280  IFMD=PRNTTHENRESTORE3550
  117. 3290  IFMD=EXITTHENRESTORE3580
  118. 3300  GOSUB 2500:PROMPT$="":GOSUB 1790:GOSUB 2300:RETURN
  119. 3320  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
  120. 3354  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"
  121. 3370  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"  
  122. 3387  DATA"After a file is opened, the variable labels are displayed and the":DATA"and the program will return to the Main Menu.":DATA"
  123. 3400  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
  124. 3414  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"  
  125. 3418  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.
  126. 3423  DATA"
  127. 3430  DATA"FREQUENCY HELP SCREEN":DATA"  ":DATA"This routine will plot the frequency of values for a variable which":DATA"you specify.":DATA"  ":DATA"The program will calculate the frequency, the percent, the cumulative
  128. 3446  DATA"count and the cumulative percent.":DATA"  ":DATA"By pressing the <SHIFT> and <PrtSc> keys at the same time, a printout":DATA"may be obtained.":DATA"  ":DATA"Note that only selected cases are counted.":DATA"  
  129. 3453  DATA"A histogram may also be selected without returning to the Main Menu.":DATA"
  130. 3460  DATA"HISTOGRAMS HELP SCREEN":DATA"  ":DATA"This routine will draw a histogram for a specified variable.":DATA"  ":DATA"The program will plot half intervals as specified by the user."
  131. 3465  DATA "  ":DATA "After the histogram has been displayed, a frequency table may be":DATA "obtained without returning to the Menu.":DATA ""
  132. 3490  DATA"SCATTERGRAMS HELP SCREEN":DATA" ":DATA"This routine will plot a scattergram for two specified variables.":DATA"  ":DATA"The values plotted are the standard deviations from the mean. The
  133. 3505  DATA"plot increments are one standard deviation each, and 3.0 are plotted":DATA"on each axis."
  134. 3510  DATA "  ":DATA "Values are plotted to the nearest 1/2 standard deviation.":DATA ""
  135. 3520  DATA"STATISTICAL ROUTINES HELP SCREEN":DATA"  ":DATA"These routines are several of the standard set of descriptive ":DATA"statistics. You may specify as many as 10 variables for evaluation.":DATA "   "
  136. 3535  DATA"The VAR. is the standard deviation squared. The standard deviation":DATA"is computed with the formula <0xE5!> = <UNK! {00FB}>(<0xE4!>x<UNK! {FD2D}>((<0xE4!>x)<UNK! {FD2F}>n)/n).":DATA"  ":DATA"Since computing the median requires a sort, you have the option
  137. 3539  DATA"to skip this value. A large data base may require some time to ":DATA"compute the median.":DATA"
  138. 3550  DATA"PRINT SELECTED CASES HELP SCREEN":DATA"  ":DATA"This option will print all cases for which the subsets specified":DATA"evaluate as true.":DATA"You may use option 2 to de-select certain subsets, and then print":DATA"those cases.":DATA"
  139. 3580  DATA"EXIT HELP SCREEN":DATA"  ":DATA"Exiting the program will return you to BASIC with all functions ":DATA"restored.":DATA"
  140. 3610  PROMPT$="(L)ABELS  (D)EFS  (S)UBS  (U)p  do(W)n":CMD$="LDSUW":GOSUB2260:IFFF<1ORFF>3THENFF=1:F1=0
  141. 3640  X$=INKEY$:IFX$=""THEN3640
  142. 3650  IFX$=ESC$ORX$=CR$THENRETURN
  143. 3660  GOSUB1920:CMD=INSTR(CMD$,X$):ONCMDGOSUB3710,3720,3730,3690,3700:GOTO3640
  144. 3690  F1=F1-FW:GOSUB2340:RETURN
  145. 3700  F1=F1+FW:GOSUB2340:RETURN
  146. 3710  FF=1:F0=BVARS:F2=F0+NVARS:F0=F0+1:F$="x":GOSUB2340:RETURN
  147. 3720  FF=2:F0=BDEFS:F2=F0+NDEFS:F0=F0+1:F$="d":GOSUB2340:RETURN
  148. 3730  FF=3:F0=BSUBS:F2=F0+NSUBS:F0=F0+1:F$="s":GOSUB2340:RETURN
  149. 3760  DATA"STATLIB LIBRARY":DATA"123456789":DATA" ":DATA"  ":DATA"      1   Open Case File                 5  Frequency Plot":DATA" ":DATA"      2   Select Subsets                 6  Histogram":DATA" 
  150. 3840  DATA"      3   Help                           7  Scatterplot":DATA" ":DATA"      4   Print Selected Cases           8  Stats Routines":DATA" ":DATA"  ":DATA"                           9  Exit Program":DATA"
  151. 3900  MD=MAIN:RESTORE3760:READX$:READCMD$:GOSUB1980:GOSUB2070:GOSUB2500:X$=ECMD$:GOSUB2230:GOSUB1730:IFCMD=9THEN3950
  152. 3930  ONCMDGOSUB4060,4150,4040,4630,5180,5270,7030,6310:GOTO3900
  153. 3950  MD=EXIT:PROMPT$="Do you want to test another file":GOSUB1770:IFX$="Y"THEN3900
  154. 3970  CLOSE:FILSPEC$="":FOR J=1 TO 500:NEXT:PROMPT$="goodbye...":GOSUB 2260:FOR J=1 TO 2200:NEXT:GOSUB 1600
  155. 3990  KEY ON:KEY 1,"LIST":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY 6,","+CHR$(34)+"LPT1:":KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9,"KEY":KEY 10,"SCREEN 0,0,0"+CHR$(13):NEW:END
  156. 4020  PROMPT$="Error"+STR$(ERR)+"in line"+STR$(ERL):GOSUB1790:RESUMENEXT
  157. 4040  GOSUB3210:RETURN
  158. 4060  MD=OPIN:X$="OPEN FILE":GOSUB1980:GOSUB2960:IFFCMD=QRETTHENRETURN
  159. 4080  IFFCMD<>0THEN4060
  160. 4090  GOSUB2570:IFFCMD<>0THEN4060
  161. 4100  GOSUB3710:PROMPT$="":GOSUB1790:FORJ=1TONSUBS:S(J)=J:NEXT:S(0)=NSUBS:IFNCASE=0THENPROMPT$="NO CASES ENTERED":GOSUB2270
  162. 4130  RETURN
  163. 4150  IFFILSPEC$=""THENGOSUB3190:RETURN
  164. 4160  MD=SELS:X$="SELECT SUBSET DEFINITIONS":GOSUB1980
  165. 4170  GOSUB4460:PROMPT$="(D)ELETE  (E)NTER  (C)LEAR  (A)LL":CMD$="DECA":GOSUB2260:GOSUB1740:IFFCMD=QRETORFCMD=QSAVTHENRETURN
  166. 4200  IFFCMD<>0THEN4170
  167. 4210  ONCMDGOSUB4240,4290,4330,4340:IFCMD=0THENGOSUB2270
  168. 4230  GOTO4170
  169. 4240  GOSUB4370:IFFCMD=ESCTHEN4240
  170. 4250  IFFCMD<>0THENCMD=0:RETURN
  171. 4260  IFSELJ=0THENPROMPT$="SUBSET NOT SELECTED":GOTO4240
  172. 4270  FORJ=SELJTOS(0)-1:S(J)=S(J+1):NEXT:S(0)=S(0)-1:RETURN
  173. 4290  GOSUB4370:IFFCMD=ESCTHEN4290
  174. 4300  IFFCMD<>0THENCMD=0:RETURN
  175. 4310  IFSELJ<>0THENPROMPT$="DUPLICATE SUBSET":GOTO4290
  176. 4320  J=S(0)+1:S(J)=SEL:S(0)=J:RETURN
  177. 4330  S(0)=0:RETURN
  178. 4340  FORJ=1TONSUBS:S(J)=J:NEXT:S(0)=NSUBS:RETURN
  179. 4370  PROMPT$="ENTER SUBSET NUMBER":MAXLIN=3:GOSUB1810:IFFCMD=ESCTHEN4370
  180. 4390  IFFCMD<>0THENRETURN
  181. 4400  SEL=VAL(LIN$):IFSEL>=1ANDSEL<=NSUBSTHEN4420
  182. 4410  PROMPT$="BAD SUBSET NUMBER":GOSUB2270:GOTO4370
  183. 4420  SELJ=0:FORJ=1TOS(0):IFSEL=S(J)THENSELJ=J:J=S(0)
  184. 4440  NEXT:RETURN
  185. 4460  GOSUB2320:J=1:K=S(0):IFK=0THENGOSUB4580:RETURN
  186. 4480  FORL=1TOFL:GOSUB2330:IFJ<=KTHENGOSUB4530 ELSEPRINTFL$;
  187. 4510  NEXT:RETURN
  188. 4530  FORI=1TOFJ:IFJ<=KTHENGOSUB4570 ELSEPRINTFE$;
  189. 4550  NEXT:RETURN
  190. 4570  JJ=S(J):LSETFD$=MID$(STR$(JJ),2):PRINT"s"FD$": "W$(BSUBS+JJ);:J=J+1:RETURN
  191. 4580  X$=FL$:LSETX$="All cases will be selected.":GOSUB2330:PRINTX$;:FORL=2TOFL:GOSUB2330:PRINTFL$;:NEXT:RETURN
  192. 4630  IFFILSPEC$=""THENGOSUB3190:RETURN
  193. 4640  MD=PRNT:X$="PRINT SELECTED CASES":GOSUB1980:GOSUB4830:CCASE=0:NSEL=0:SEL=1:WHILESEL<>0:GOSUB2760:IFSEL<>0THENGOSUB4730
  194. 4690  WEND:GOSUB4950:PROMPT$="FUNCTION COMPLETED":GOSUB2270:RETURN
  195. 4730  X$=SPACE$(7):LSETX$=STR$(V(0)):LPRINT:LPRINTX$;:K=1:Y$=FC$:L=BVARS:FORJ=1TONVARS:GOSUB4800:NEXT:L=BDEFS:FORJ=1TONDEFS:GOSUB4800:NEXT:IFKMOD6<>1THENLPRINT
  196. 4790  RETURN
  197. 4800  LSETY$=STR$(V(L+J)):LPRINTY$;:K=K+1:IFKMOD6=1THENLPRINT:LPRINTSPACE$(7);
  198. 4820  RETURN
  199. 4830  LPRINT:LPRINTFILNAM$;:IFFILDESC$<>""THENLPRINT":"FILDESC$"  ";
  200. 4850  IFS(0)=0THENLPRINT"  NO SUBSETS SELECTED":GOTO4880
  201. 4860  LPRINT"  SUBSETS SELECTED: ";:FORJ=1TOS(0):LPRINTW$(BSUBS+S(J));:NEXT:LPRINT
  202. 4880  LPRINT:X$=SPACE$(7):LSETX$="CASE#":LPRINTX$;:K=1:L=BVARS:FORJ=1TONVARS:GOSUB4930:NEXT:L=BDEFS:FORJ=1TONDEFS:GOSUB4930:NEXT:IFKMOD6<>1THENLPRINT
  203. 4920  RETURN
  204. 4930  LPRINTW$(L+J);:K=K+1:IFKMOD6=1THENLPRINT:LPRINTSPACE$(7);
  205. 4940  RETURN
  206. 4950  LPRINT:IFNSEL=0THENLPRINT"NO CASES SELECTED OF"STR$(NCASE)" IN FILE":RETURN
  207. 4960  LPRINT"SELECTED"STR$(NSEL)" CASE";:IFNSEL>1THENLPRINT"S";
  208. 4970  LPRINT" OF"STR$(NCASE)" IN FILE":RETURN
  209. 4980  MAXLIN=4:W$=PROMPT$
  210. 4990  PROMPT$=W$:GOSUB1810:IFFCMD<>0THENRETURN
  211. 5000  IFLIN$=""ANDARG$<>""THENRETURN
  212. 5010  G1=1:G2=LEN(LIN$):GOSUB5030:IFCMD>0THENRETURN
  213. 5020  GOSUB2270:GOTO4990
  214. 5030  ARG=0:ARG$="":FORARGPTR=G1TOG2:X$=MID$(LIN$,ARGPTR,1):GOSUB1950:K=INSTR("xd",X$):IFK>0THENGOSUB5110:ARGPTR=G2
  215. 5080  NEXT:IFK=0THENCMD=0:PROMPT$="Bad argument
  216. 5100  RETURN
  217. 5110  IFARGPTR=G2THENK=0:RETURN
  218. 5120  ARGPTR=ARGPTR+1:U=VAL(MID$(LIN$,ARGPTR)):L=NVARS:IFK=2THENL=NDEFS
  219. 5140  IFU<1ORU>LTHENK=0:RETURN
  220. 5150  ARG$=X$+MID$(STR$(U),2):FPTR=BVARS+U+(K-1)*MAXVARS:RETURN
  221. 5180  IFFILSPEC$=""THENGOSUB3190:RETURN
  222. 5190  MD=FREQ:X$="FREQUENCY TABLE":GOSUB1980:GOSUB5430:IFFCMD=QRETTHENRETURN
  223. 5210  GOSUB5780:GOSUB5860:PROMPT$="PRINT HISTOGRAM":GOSUB1770:IFFCMD=QRETTHENRETURN
  224. 5250  IFX$="Y"THENGOSUB6010
  225. 5255  PROMPT$="FUNCTION COMPLETED":GOSUB1790:GOTO5180
  226. 5270  IFFILSPEC$=""THENGOSUB3190:RETURN
  227. 5280  MD=HIST:X$="HISTOGRAM":GOSUB1980:GOSUB5430:IFFCMD=QRETTHENRETURN
  228. 5300  GOSUB5780:GOSUB6010:PROMPT$="PRINT FREQUENCY TABLE":GOSUB1770:IFFCMD=QRETTHENRETURN
  229. 5340  IFX$="Y"THENGOSUB5860
  230. 5345  PROMPT$="FUNCTION COMPLETED":GOSUB1790:GOTO5270
  231. 5360  J=LEN(STR$(MIN)):K=LEN(STR$(MAX)):MAXLIN=J:IFK>JTHENMAXLIN=K
  232. 5370  W$=PROMPT$+" ["+STR$(MIN)+" ,"+STR$(MAX)+" ] 
  233. 5380  PROMPT$=W$:GOSUB1810:IFFCMD<>0THENRETURN
  234. 5390  IFLIN$=""THENNUM=MIN:RETURN
  235. 5400  J=VAL(LIN$):IFJ>=MINANDJ<=MAXTHENNUM=J:RETURN
  236. 5410  PROMPT$="OUT OF RANGE":GOSUB2270:GOTO5380
  237. 5430  GOSUB2300:PROMPT$="VARIABLE TO PLOT":GOSUB4980:IFFCMD=QRETTHENRETURN
  238. 5460  IFFCMD<>0THEN5430
  239. 5470  P=1:GOSUB7010:PRINTPROMPT$" "ARG$" "W$(FPTR);
  240. 5490  PROMPT$="LOW RANGE START":MIN=-9999:MAX=9999:GOSUB5360:IFFCMD=ESCORFCMD=REDOTHEN5430
  241. 5520  IFFCMD=QRETTHENRETURN
  242. 5530  IFLIN$<>""THENLOW=NUM
  243. 5540  P=2:GOSUB7010:PRINTPROMPT$" "STR$(LOW)"    ";
  244. 5560  PROMPT$="HIGH RANGE END":MIN=LOW:MAX=9999:GOSUB5360:IFFCMD=ESCTHEN5490
  245. 5590  IFFCMD=REDOTHEN5430
  246. 5600  IFFCMD=QRETTHENRETURN
  247. 5610  IFLIN$<>""THENHIGH=NUM
  248. 5620  P=3:GOSUB7010:PRINTPROMPT$" "STR$(HIGH)"      ";
  249. 5640  PROMPT$="INCREMENT":MAX=HIGH-LOW:U=MAX/MAXSTEPS:IFU>FIX(U)THENU=U+1
  250. 5660  MIN=INT(U):GOSUB5360:IFFCMD=ESCTHEN5560
  251. 5680  IFFCMD=REDOTHEN5430
  252. 5690  IFFCMD=QRETTHENRETURN
  253. 5700  IFLIN$<>""THENINCR=NUM
  254. 5710  NSTEPS=1:IFINCR>0THENNSTEPS=INT(MAX\INCR)+1
  255. 5720  P=4:GOSUB7010:PRINTPROMPT$" "STR$(INCR)"  ";:GOSUB2330:PRINT"NUMBER OF STEPS "STR$(NSTEPS)"    ";:PROMPT$="":GOSUB1790:IFFCMD=ESCTHEN5640
  256. 5760  IFFCMD=REDOTHEN5430
  257. 5770  RETURN
  258. 5780  FORJ=0TONSTEPS:C(J)=0:NEXT:CCASE=0:NSEL=0:SEL=1:WHILESEL<>0:GOSUB2760:IFSEL<>0THENGOSUB5820
  259. 5810  WEND:RETURN
  260. 5820  U=V(FPTR):IFU<=LOWTHENJ=0:GOTO5850
  261. 5830  IFU>HIGHTHENJ=NSTEPS:GOTO5850
  262. 5840  U=(U-LOW)/INCR:J=FIX(U):IFJ<UTHENJ=J+1
  263. 5850  C(J)=C(J)+1:RETURN
  264. 5860  GOSUB5910:JJ=0:X$=SPACE$(5):GOSUB2330:PRINTFL$;:FORJ=0TONSTEPS:GOSUB5960:NEXT:FORJ=NSTEPS+4TOFL:GOSUB2330:PRINTFL$;:NEXT:RETURN
  265. 5910  GOSUB2320:X$="\               \   COUNT     PERCENT     CUM. COUNT     CUM. PERCENT":Y$="  \           \     #####      ###.#        #####           ###.#    ":GOSUB2330:W$=SPACE$(4):RSETW$=ARG$:PRINTUSINGX$;W$+": "+W$(FPTR);:RETURN
  266. 5960  GOSUB2330:K=C(J):JJ=JJ+K:IFJ=0THENRSETX$=STR$(LOW):W$="    -   "+X$:GOTO6000
  267. 5980  IFJ=NSTEPSTHENRSETX$=STR$(LOW+(J-1)*INCR):LSETW$=X$+"+      -":GOTO6000
  268. 5990  RSETX$=STR$(LOW+(J-1)*INCR):W$=X$:RSETW$=STR$(LOW+J*INCR):W$=X$+"+  "+W$
  269. 6000  PRINTUSINGY$;W$,K,K*100/NSEL,JJ,JJ*100/NSEL;:RETURN
  270. 6010  GOSUB6220:GOSUB2320:GOSUB2330:PRINTFL$;:LSETFL$="":GOSUB2330:PRINTFL$;:U=NSEL/MAXSTEPS:X$=SPACE$((NC-6)\(NSTEPS+1)):FORL=MAXSTEPSTO1STEP-1:GOSUB2330:GOSUB6140:PRINTUSING" ### ";L*100/MAXSTEPS;:PRINTLEFT$(FL$,NC-5);:NEXT
  271. 6110  GOSUB6230:GOSUB2330:PRINTFL$;:LSETFL$="":GOSUB2330:PRINTFL$;:RETURN
  272. 6140  V=U*L:Y$="":FORK=0TONSTEPS:GOSUB6160:Y$=Y$+X$:NEXT:LSETFL$=Y$:RETURN
  273. 6160  I=C(K):IFI>(V-U/2)THENRSETX$=LCHAR$:RETURN
  274. 6170  IFI>(V-U)THENRSETX$=HLCHAR$:RETURN
  275. 6180  IFI<=(V-U)ORL>1THENRSETX$=NOCHAR$:RETURN
  276. 6190  IFI>0ANDI<=U/2ANDL=1THENRSETX$=NOT0CHAR$:RETURN
  277. 6200  PROMPT$="hist_prt error":GOSUB2270:RETURN
  278. 6220  W$=SPACE$(4):RSETW$=ARG$:LSETFL$="   % "+W$+": "+W$(FPTR):RETURN
  279. 6230  Y$=SPACE$(5):RSETY$=ARG$+" ":FORK=0TONSTEPS:IFK<NSTEPSTHENRSETX$=STR$(LOW+K*INCR)
  280. 6260  IFK=NSTEPSTHENRSETX$=STR$(LOW+(K-1)*INCR):X$=X$+"+
  281. 6270  Y$=Y$+X$:NEXT:LSETFL$=Y$:RETURN
  282. 6310  IFFILSPEC$=""THENGOSUB3190:RETURN
  283. 6320  MD=FUNC:X$="STATISTICAL ROUTINES":GOSUB1980:GOSUB6800:IFFCMD=QRETTHENRETURN
  284. 6350  IFFCMD<>0THEN6310
  285. 6360  GOSUB6660:FORZPTR=1TOC(0):FPTR=C(ZPTR):GOSUB6410:GOSUB6710:NEXT:FORJ=C(0)+3TOFL:GOSUB2330:PRINTFL$;:NEXT:PROMPT$="FUNCTION COMPLETED":GOSUB1790:IFFCMD=QRETTHENRETURN
  286. 6400  GOTO6310
  287. 6410  V1=0:V2=0:VLOW=1E+06:VHIGH=-1E+06:CCASE=0:NSEL=0:SEL=1:WHILESEL>0:GOSUB2760:IFSEL>0THENGOSUB6480
  288. 6450  WEND:IFMFLAG<>0THENGOSUB6550
  289. 6470  RETURN
  290. 6480  V=V(FPTR):V1=V1+V:V2=V2+V*V:IFV>VHIGHTHENVHIGH=V
  291. 6500  IFV<VLOWTHENVLOW=V
  292. 6510  IFMFLAG=0THENRETURN
  293. 6520  IFNSEL<MAXCASETHENU(NSEL-1)=V:RETURN
  294. 6530  PROMPT$="CAN'T CALCULATE MEAN:TOO MANY CASES":GOSUB2260:MFLAG=0:RETURN
  295. 6550  GAP=NSEL\2:WHILEGAP>0:FORI=GAPTONSEL-1:FORJ=I-GAPTO0STEP-GAP:IFU(J)>U(J+GAP)THENSWAPU(J),U(J+GAP) ELSEJ=0
  296. 6600  NEXT:NEXT:GAP=GAP\2:WEND:J=NSEL\2:IFJ<1THENRETURN
  297. 6640  IFNSELMOD2=0THENARG=(U(J)+U(J-1))/2:RETURN
  298. 6650  ARG=U(J):RETURN
  299. 6660  GOSUB2320:GOSUB2330:X$="VARIABLE             VAR.      MEAN   STD.DEV.    SM.     LG. ":Y$="\                \  #.#^^^^  #####.#   #####.#  #####.# #####.#":PRINTX$;:IFMFLAG<>0THENPRINT"  MEDIAN";
  300. 6700  RETURN
  301. 6710  IFFPTR>BDEFSTHENF$="d":J=FPTR-BDEFS
  302. 6720  IFFPTR<BDEFSTHENF$="x":J=FPTR-BVARS
  303. 6730  W$=SPACE$(18):RSETW$=F$+MID$(STR$(J),2)+": "+W$(FPTR):P=ZPTR:GOSUB7010:IFNSEL<1THENPRINTW$"  NO CASES SELECTED";:RETURN
  304. 6760  V=(V2-(V1*V1)/NSEL)/NSEL:PRINTUSINGY$;W$,V,V1/NSEL,SQR(V),VLOW,VHIGH;:IFMFLAG<>0THENPRINTUSING"  ####.#";ARG;
  305. 6790  RETURN
  306. 6800  GOSUB2300:FORJ=0TOMAXSTEPS:C(J)=0:NEXT:GOSUB6930:IFFCMD=QRETTHENRETURN
  307. 6820  IFFCMD=ESCORFCMD=REDOTHEN6800
  308. 6830  PROMPT$="CALCULATE MEDIAN":GOSUB1770:IFFCMD=QRETTHENRETURN
  309. 6850  IFFCMD=REDOTHEN6800
  310. 6860  MFLAG=0:IFX$="Y"THENMFLAG=1
  311. 6870  P=C(0)+2:GOSUB7010:IFMFLAG=1THENPRINTPROMPT$;
  312. 6890  IFMFLAG=0THENPRINT"DO NOT CALCULATE MEDIAN
  313. 6900  PROMPT$="":GOSUB1790:IFFCMD=REDOTHEN6800
  314. 6920  RETURN
  315. 6930  PROMPT$="ENTER VARIABLE":GOSUB4980:IFFCMD=ESCTHEN6930
  316. 6950  IFFCMD<>0THENRETURN
  317. 6960  J=C(0)+1:C(J)=FPTR:C(0)=J:W$=SPACE$(6):RSETW$=ARG$+": ":P=J:GOSUB7010:PRINTW$W$(FPTR);:IFC(0)=MAXSTEPSTHENRETURN
  318. 7000  GOTO6930
  319. 7010  P=FP+P+3:Q=FQ+3:GOSUB1610:RETURN
  320. 7030  IFFILSPEC$=""THENGOSUB3190:RETURN
  321. 7040  MD=SCAT:X$="SCATTERPLOT":GOSUB1980
  322. 7050  GOSUB7210:IFFCMD=QRETTHENRETURN
  323. 7060  IFFCMD=ESCTHEN7030
  324. 7070  U1=0:U2=0:V1=0:V2=0:UHIGH=-1E+06:ULOW=1E+06:VLOW=ULOW:VHIGH=UHIGH:CCASE=0:NSEL=0:SEL=1:WHILESEL>0:GOSUB2760:IFSEL>0THENGOSUB7340
  325. 7110  WEND:IFNSEL=0THENPROMPT$="NO CASES SELECTED":GOSUB1790:GOTO7050
  326. 7120  U=SQR((U2-(U1*U1)/NSEL)/NSEL):V=SQR((V2-(V1*V1)/NSEL)/NSEL):U1=U1/NSEL:V1=V1/NSEL:GOSUB7410:CCASE=0:NSEL=0:SEL=1:WHILESEL>0:GOSUB2760:IFSEL>0THENGOSUB7480
  327. 7170  WEND:GOSUB7510:PROMPT$="FUNCTION COMPLETED":GOSUB1790:IFFCMD=QRETTHENRETURN
  328. 7200  GOTO7030
  329. 7210  GOSUB2300:PROMPT$="VARIABLE TO PLOT ON X-AXIS":GOSUB4980:IFFCMD<>0THENRETURN
  330. 7240  C(1)=FPTR:W$=SPACE$(6):RSETW$=ARG$+": ":P=1:GOSUB7010:PRINTPROMPT$"  "W$W$(FPTR);:PROMPT$="VARIABLE TO PLOT ON Y-AXIS":GOSUB4980:IFFCMD=ESCTHEN7210
  331. 7280  IFFCMD=QRETTHENRETURN
  332. 7290  C(2)=FPTR:W$=SPACE$(6):RSETW$=ARG$+": ":P=2:GOSUB7010:PRINTPROMPT$"  "W$W$(FPTR);:PROMPT$="":GOSUB1790:IFFCMD=ESCORFCMD=REDOTHEN7210
  333. 7330  RETURN
  334. 7340  U=V(C(1)):V=V(C(2)):U1=U1+U:U2=U2+U*U:V1=V1+V:V2=V2+V*V:IFU<ULOWTHENULOW=U
  335. 7370  IFV<VLOWTHENVLOW=V
  336. 7380  IFU>UHIGHTHENUHIGH=U
  337. 7390  IFV>VHIGHTHENVHIGH=V
  338. 7400  RETURN
  339. 7410  GOSUB2300:FPTR=C(1):GOSUB7520:P=6:Q=26:GOSUB1610:PRINTW$;:Q=37:P=7:GOSUB1610:PRINT"+3";:X$="||":Q=40:FORP=7TO19:GOSUB1610:PRINTX$;:NEXT:Q=43:P=19:GOSUB1610:PRINT"-3";:FPTR=C(2):GOSUB7520:P=13:Q=FQ+2:GOSUB1610:PRINTW$;
  340. 7445  Q=28:P=14:GOSUB1610:PRINT"-3";:X$="| ":P=13:FORQ=28TO38STEP2:GOSUB1610:PRINTX$;:NEXT:X$=" |":P=13:FORQ=42TO52STEP2:GOSUB1610:PRINTX$;:NEXT:Q=52:P=12:GOSUB1610:PRINT"+3";:RETURN
  341. 7480  IFV=0THENP=0:GOTO7490
  342. 7485  ARG=(V(C(2))-V1)/V:P=FIX((0.25*SGN(ARG)+ARG)*2):IFABS(P)>5THENP=SGN(P)*5
  343. 7490  IFU=0THENQ=0:GOTO7500
  344. 7495  ARG=(V(C(1))-U1)/U:Q=FIX((0.25*SGN(ARG)+ARG)*2):IFABS(Q)>5THENQ=SGN(Q)*5
  345. 7500  P=-P+13:Q=40+2*Q:GOSUB1610:PRINT"<>";:RETURN
  346. 7510  P=12:GOSUB7010:PRINTFL$;:RETURN
  347. 7520  IFFPTR>BDEFSTHENF$="d":J=FPTR-BDEFS
  348. 7530  IFFPTR<BDEFSTHENF$="x":J=FPTR-BVARS
  349. 7540  W$=SPACE$(18):RSETW$=F$+MID$(STR$(J),2)+": "+W$(FPTR):RETURN
  350.