home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / DIMS103.ARK / DSTAT.ASC < prev    next >
Text File  |  1986-12-07  |  7KB  |  283 lines
  1. 5 ' DSTAT by Dan Dugan -- public domain
  2. 10 PRINT"This program must be entered from DEDIT.":STOP
  3. 1000 DEFINT A-T
  4. 1010 DEFSNG U-Z
  5. 1015 FF$=CHR$(12)        'depends on your printer
  6. 1020 COMMON I,J,K,X%,Y%,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  7.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  8.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  9. 1040 ON ERROR GOTO 2330
  10. 1050 IF N=0 THEN PRINT"File is empty.": GOTO 2210
  11. 1060 NX=0
  12. 1070 PRINT
  13. 1080 GOSUB 2400 ' cs
  14. 1090 '
  15.  
  16.  
  17. 1100 PRINT"DSTAT 1.02 - October 17, 1982
  18. 1110 LINE INPUT"Enter date:  ",DATE$
  19. 1115 PRINT:PRINT"Here are the numeric fields in ";F$
  20. 1120 GOSUB 2510 'show fields
  21. 1130 INPUT"Number of field to work on (or 0 to quit)";STATFX
  22. 1135    IF STATFX=0 THEN 2210
  23. 1140    IF STATFX>NC THEN PRINT"FILE HAS"NC"FIELDS": GOTO 1130
  24. 1150    IF RIGHT$(N$(STATFX),1)="n" THEN 1180
  25. 1160 PRINT"Only numeric fields can be used; enter again."
  26. 1170 GOTO 1130
  27. 1180 IF STATFX=0 THEN GOTO 2210 ' abort
  28. 1190 PRINT:INPUT"Enter cue for missing data, if other than blank:  ",MISS$
  29. 1191 IF P9=0 THEN 1200
  30. 1192 '
  31.  
  32.  
  33.                 PRINT HEADING
  34.  
  35. 1194 FOR X=1 TO 5:LPRINT:NEXT
  36. 1195 LPRINT"DESCRIPTIVE STATISTICS FOR FILE "F$", FIELD "LEFT$(N$(STATFX),4)"    "DATE$
  37. 1196 LPRINT
  38. 1200 '
  39.  
  40.  
  41.  
  42.                 RECORD WORK LOOP
  43.  
  44. 1210 ' zero variables here if go-around allowed
  45. 1220 '
  46. 1230 FOR I=T1 TO T2 '        <==== FOR
  47. 1240 GOSUB 2430 ' get rec
  48. 1250 IF ASC(T$)=0 THEN PRINT"0    ";CHR$(13);:GOTO 1760
  49.     ELSE PRINT I;CHR$(13);
  50. 1260 T1$=T$ ' save it
  51. 1270 IF SKIPPARSE=1 THEN 1290
  52. 1280 GOSUB 2240 ' parse record string
  53. 1290 IF SEARCH=0 THEN 1580
  54. 1300 '
  55.  
  56.  
  57.                 SEARCH
  58.  
  59. 1310 IF SEARCH<>2 THEN 1370
  60. 1320 '
  61.  
  62.         FIND
  63.  
  64. 1330 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1760
  65. 1340 GOSUB 2240 ' parse
  66. 1350 GOTO 1580
  67. 1360 '
  68.  
  69.         LOOK FOR SKIPS
  70.  
  71. 1370 J=0
  72. 1380 IF SKIPWORD$(J)="" THEN 1460 ' try search then
  73. 1390 IF LOOKFIELD(J) THEN 1430 ' look in field
  74. 1400 IF INSTR(T1$,SKIPWORD$(J)) THEN 1760 ' whole rec search - skip it
  75. 1410 J=J+1
  76. 1420 GOTO 1380
  77. 1430 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J)) THEN 1760 ' field compare - skip
  78. 1435 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 1760    'blank field
  79. 1440 J=J+1
  80. 1450 GOTO 1380
  81. 1460 IF SEARCHWORD$(0)="" THEN 1560 ' don't care so print it
  82. 1470 J=0: GOTO 1490 '        now search
  83. 1480 IF SEARCHWORD$(J)="" THEN 1760 ' hesitate no longer
  84. 1490 IF SEARCHFIELD(J) THEN 1530 ' field
  85. 1500 IF INSTR(T1$,SEARCHWORD$(J)) THEN 1560 ' found it
  86. 1510 J=J+1
  87. 1520 GOTO 1480
  88. 1530 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1560
  89. 1535 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 1560
  90. 1540 J=J+1
  91. 1550 GOTO 1480
  92. 1560 IF SKIPPARSE=1 THEN GOSUB 2240 ' parse
  93. 1570 '
  94.  
  95.         MISSING DATA
  96.  
  97. 1580 IF B$(STATFX)=MISS$ THEN 1760 ' skip
  98. 1590 '
  99.  
  100.                 WORK ON RECORD
  101.  
  102. 1595 GOSUB 2370            ' exit
  103. 1600 X=VAL(B$(STATFX))
  104. 1610 IF P9 THEN LPRINT"(";I;")";
  105. 1620 PRINT"("I")";
  106. 1630 IF P9 THEN LPRINT,X
  107. 1640 PRINT,X
  108. 1650 IF NX=0 THEN XMAX=X:XMIN=X:GOTO 1680
  109. 1660 IF X>XMAX THEN XMAX=X
  110. 1670 IF X<XMIN THEN XMIN=X
  111. 1680 NX=NX+1
  112. 1690 UX=UX+X
  113. 1700 X2=X*X
  114. 1710 '    X3=X2*X
  115. 1720 '    X4=X3*X
  116. 1730 UX2=UX2+X2
  117. 1740 '    UX3=UX3+X3
  118. 1750 '    UX4=UX4+X4
  119. 1760 '
  120.  
  121.  
  122.                 END OF RECORD WORK LOOP
  123.  
  124. 1770 GOSUB 2370
  125. 1780 NEXT I
  126. 1790 '
  127.  
  128.  
  129.                 INTERMEDIATE VARIABLES
  130.  
  131. 1800 U2X=UX*UX
  132. 1805 IF NX=0 THEN WX=UX:GOTO 1820
  133. 1810 WX=UX/NX ' mean
  134. 1820 '    W2X=WX*WX ' mean^2
  135. 1830 '    W3X=W2X*WX ' mean^3
  136. 1840 '    W4X=W3X*WX ' mean^4
  137. 1850 '
  138.  
  139.  
  140.                 CALCULATE OUTPUTS
  141.  
  142. 1854 PRINT "nx=";NX
  143. 1855 IF NX<2 OR UX2-U2X/NX<0 THEN ZSD=0:ZSE=0:GOTO 1880
  144. 1860 ZSD=SQR((UX2-U2X/NX)/(NX-1)) ' standard deviation
  145. 1870 ZSE=ZSD/SQR(NX) ' standard error
  146. 1880 '
  147.  
  148.  
  149.                 PRINT REPORT
  150.  
  151. 1890 PRINT:PRINT"DESCRIPTIVE STATISTICS IN FILE '"F$"'"
  152. 1900 PRINT:PRINT"Date:  "DATE$
  153. 1910 IF MISS$="" THEN PRINT"Records with blank field have been skipped."
  154.     ELSE PRINT"Missing data cue '"MISS$"'"
  155. 1913 IF P9 THEN LPRINT
  156. 1915 IF P9 THEN IF MISS$="" THEN LPRINT
  157.             "Records with blank field have been skipped."
  158.             ELSE LPRINT"Missing data cue:  "MISS$
  159. 1920 PRINT"Records from"T1"to"T2
  160. 1925 IF P9 THEN LPRINT"Records from"T1"to"T2
  161. 1930 '
  162.  
  163.                 SHOW SEARCH SET-UP
  164.  
  165. 1940 IF SEARCH=0 GOTO 2100
  166. 1945 IF SEARCH<>2 THEN 1960
  167. 1950 PRINT"Records containing '"SEARCHWORD$(0)"'"
  168. 1955 IF P9 THEN LPRINT"Records containing '"SEARCHWORD$(0)"'"
  169. 1957 GOTO 2100
  170. 1960 PRINT"Subset selection:
  171. 1965 IF P9 THEN LPRINT:LPRINT"Subset selection:
  172. 1970 IF SEARCHWORD$(0)="" GOTO 2050
  173. 1980 PRINT"    Selection instructions:
  174. 1985 IF P9 THEN LPRINT"     Selection instructions:
  175. 1990 J=0
  176. 2000 PRINT TAB(8);"FIELD NAME";TAB(20)"EXPRESSION
  177. 2005 IF P9 THEN LPRINT TAB(8);"FIELD NAME";TAB(20)"EXPRESSION
  178. 2010 PRINT TAB(11);LEFT$(N$(SEARCHFIELD(J)),4);TAB(20);SEARCHWORD$(J)
  179. 2015 IF P9 THEN LPRINT TAB(11);LEFT$(N$(SEARCHFIELD(J)),4);TAB(20);SEARCHWORD$(J)
  180. 2020 J=J+1
  181. 2030 IF SEARCHWORD$(J)="" GOTO 2050
  182. 2040 GOTO 2010
  183. 2050 IF SKIPWORD$(0)="" GOTO 2100
  184. 2060 PRINT"    Rejection instructions:
  185. 2065 IF P9 THEN LPRINT"     Rejection instructions:
  186. 2070 PRINT TAB(8);"FIELD NAME";TAB(20);"EXPRESSION
  187. 2075 IF P9 THEN LPRINT TAB(8)"FIELD NAME"TAB(20)"EXPRESSION
  188. 2080 J=0
  189. 2090 PRINT TAB(11);LEFT$(N$(LOOKFIELD(J)),4);TAB(20);SKIPWORD$(J)
  190. 2095 IF P9 THEN LPRINT TAB(11);LEFT$(N$(LOOKFIELD(J)),4);TAB(20);SKIPWORD$(J)
  191. 2097 J=J+1
  192. 2098 IF SKIPWORD$(J)<>"" THEN 2090
  193. 2100 '
  194.  
  195.  
  196. 2110 PRINT"Statistics calculated for field '";LEFT$(N$(STATFX),4);"'"
  197. 2115 IF P9 THEN LPRINT:LPRINT"Statistics calculated for field ";LEFT$(N$(STATFX),4)
  198. 2120 PRINT:PRINT,"Number",NX
  199. 2125 IF P9 THEN LPRINT:LPRINT,"Number",NX
  200. 2130 PRINT,"Minimum",XMIN
  201. 2135 IF P9 THEN LPRINT,"Minimum",XMIN
  202. 2140 PRINT,"Maximum",XMAX
  203. 2145 IF P9 THEN LPRINT,"Maximum",XMAX
  204. 2150 PRINT,"Range",XMAX-XMIN
  205. 2155 IF P9 THEN LPRINT,"Range",XMAX-XMIN
  206. 2160 PRINT,"Sum",UX
  207. 2165 IF P9 THEN LPRINT,"Sum",UX
  208. 2170 PRINT,"Mean",WX
  209. 2175 IF P9 THEN LPRINT,"Mean",WX
  210. 2180 PRINT,"Standard Dev.",ZSD
  211. 2185 IF P9 THEN LPRINT,"Standard Dev.",ZSD
  212. 2190 PRINT,"Standard Err.",ZSE
  213. 2195 IF P9 THEN LPRINT,"Standard Err.",ZSE
  214. 2197 IF P9 THEN LPRINT FF$;
  215. 2200 PRINT:INPUT"Hit return to return to editor.  ",A$
  216. 2210 '
  217.  
  218.                 FINISH
  219.  
  220. 2220 PRINT:PRINT"Re-loading DEDIT program.
  221. 2230 CHAIN DD$(1)+"DEDIT",1000
  222. 2240 '
  223.  
  224.  
  225.  
  226.                 (SUB) PARSE STRING
  227.  
  228. 2250 K=0
  229. 2260 M=INSTR(T$,CHR$(126)) ' delimiter
  230. 2270 IF M=0 THEN RETURN
  231. 2280 K=K+1
  232. 2290 B$(K)=""
  233. 2300 B$(K)=MID$(T$,1,M-1)
  234. 2310 T$=MID$(T$,M+1)
  235. 2320 GOTO 2260
  236. 2330 '
  237.  
  238.  
  239.                 GENERAL ERROR ROUTINES
  240.  
  241. 2340 IF ERR=11 THEN RESUME 2350 ELSE 2360
  242. 2350    PRINT:PRINT"Division by zero error in line"ERL:GOTO 2210
  243. 2360 ON ERROR GOTO 0
  244. 2370 '
  245.  
  246.  
  247.                 (SUB) EXIT TEST (TERM DEP)
  248.  
  249. 2380 X$=INKEY$:IF X$=CHR$(27) THEN 2210
  250. 2390 RETURN
  251. 2400 '
  252.  
  253.  
  254.                 (SUB) CLEAR SCREEN (TERM DEP)
  255.  
  256. 2410 PRINT CHR$(12);
  257. 2420 RETURN
  258. 2430 '
  259.  
  260.  
  261.                 (SUB) GET RECORD "I" IN T$
  262.  
  263. 2440 T$="" ' necessary!
  264. 2450 ON FT GOTO 2480,2460
  265. 2460    GET#1,FT*I+2 ' latter half
  266. 2470    T$=LEFT$(R$,127)
  267. 2480    GET#1,FT*I+1 ' whole or first half
  268. 2490    T$=R$+T$
  269. 2500 RETURN
  270. 2510 '
  271.  
  272.                 (SUB) SHOW FIELDS
  273.  
  274. 2515 PRINT
  275. 2520 FOR J=1 TO NC
  276. 2525    X$=RIGHT$(N$(J),1):IF X$<>"n" THEN 2550
  277. 2530    PRINT TAB(29);
  278. 2540    PRINT USING"##";J;:PRINT".  "LEFT$(N$(J),4)"  "RIGHT$(N$(J),1)
  279. 2550 NEXT:PRINT
  280. 2560 RETURN
  281.  2550
  282. 2530    PRINT TAB(29);
  283. 2540    PRINT USING"##";J;:PRINT".  "LEFT$(N$(J),4)"  "RIGHT$(N$(J),1)