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