5 ' DSTAT by Dan Dugan -- public domain 10 PRINT"This program must be entered from DEDIT.":STOP 1000 DEFINT A-T 1010 DEFSNG U-Z 1015 FF$=CHR$(12) 'depends on your printer 1020 COMMON I,J,K,X%,Y%,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1040 ON ERROR GOTO 2330 1050 IF N=0 THEN PRINT"File is empty.": GOTO 2210 1060 NX=0 1070 PRINT 1080 GOSUB 2400 ' cs 1090 ' 1100 PRINT"DSTAT - March 20, 1982":PRINT 1110 LINE INPUT"Enter date: ",DATE$ 1115 PRINT:PRINT"Here are the numeric fields in ";F$ 1120 GOSUB 2510 'show fields 1130 INPUT"Number of field to work on (or 0 to quit)";STATFX 1135 IF STATFX=0 THEN 2210 1140 IF STATFX>NC THEN PRINT"FILE HAS"NC"FIELDS": GOTO 1130 1150 IF RIGHT$(N$(STATFX),1)="n" THEN 1180 1160 PRINT"Only numeric fields can be used; enter again." 1170 GOTO 1130 1180 IF STATFX=0 THEN GOTO 2210 ' abort 1190 PRINT:INPUT"Enter cue for missing data, if other than blank: ",MISS$ 1191 IF P9=0 THEN 1200 1192 ' PRINT HEADING 1194 FOR X=1 TO 5:LPRINT:NEXT 1195 LPRINT"DESCRIPTIVE STATISTICS FOR FILE "F$", FIELD "LEFT$(N$(STATFX),4)" "DATE$ 1196 LPRINT 1200 ' RECORD WORK LOOP 1210 ' zero variables here if go-around allowed 1220 ' 1230 FOR I=T1 TO T2 ' <==== FOR 1240 GOSUB 2430 ' get rec 1250 IF ASC(T$)=0 THEN PRINT"0 ";CHR$(13);:GOTO 1760 ELSE PRINT I;CHR$(13); 1260 T1$=T$ ' save it 1270 IF SKIPPARSE=1 THEN 1290 1280 GOSUB 2240 ' parse record string 1290 IF SEARCH=0 THEN 1580 1300 ' SEARCH 1310 IF SEARCH<>2 THEN 1370 1320 ' FIND 1330 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1760 1340 GOSUB 2240 ' parse 1350 GOTO 1580 1360 ' LOOK FOR SKIPS 1370 J=0 1380 IF SKIPWORD$(J)="" THEN 1460 ' try search then 1390 IF LOOKFIELD(J) THEN 1430 ' look in field 1400 IF INSTR(T1$,SKIPWORD$(J)) THEN 1760 ' whole rec search - skip it 1410 J=J+1 1420 GOTO 1380 1430 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J)) THEN 1760 ' field compare - skip 1440 J=J+1 1450 GOTO 1380 1460 IF SEARCHWORD$(0)="" THEN 1560 ' don't care so print it 1470 J=0: GOTO 1490 ' now search 1480 IF SEARCHWORD$(J)="" THEN 1760 ' hesitate no longer 1490 IF SEARCHFIELD(J) THEN 1530 ' field 1500 IF INSTR(T1$,SEARCHWORD$(J)) THEN 1560 ' found it 1510 J=J+1 1520 GOTO 1480 1530 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1560 1540 J=J+1 1550 GOTO 1480 1560 IF SKIPPARSE=1 THEN GOSUB 2240 ' parse 1570 ' MISSING DATA 1580 IF B$(STATFX)=MISS$ THEN 1760 ' skip 1590 ' WORK ON RECORD 1595 GOSUB 2370 ' exit 1600 X=VAL(B$(STATFX)) 1610 IF P9 THEN LPRINT"(";I;")"; 1620 PRINT"("I")"; 1630 IF P9 THEN LPRINT,X 1640 PRINT,X 1650 IF NX=0 THEN XMAX=X:XMIN=X:GOTO 1680 1660 IF X>XMAX THEN XMAX=X 1670 IF X2 THEN 1960 1950 PRINT"Records containing '"SEARCHWORD$(0)"'" 1955 IF P9 THEN LPRINT"Records containing '"SEARCHWORD$(0)"'" 1957 GOTO 2100 1960 PRINT"Subset selection: 1965 IF P9 THEN LPRINT:LPRINT"Subset selection: 1970 IF SEARCHWORD$(0)="" GOTO 2050 1980 PRINT" Selection instructions: 1985 IF P9 THEN LPRINT" Selection instructions: 1990 J=0 2000 PRINT TAB(8);"FIELD NAME";TAB(20)"EXPRESSION 2005 IF P9 THEN LPRINT TAB(8);"FIELD NAME";TAB(20)"EXPRESSION 2010 PRINT TAB(11);LEFT$(N$(SEARCHFIELD(J)),4);TAB(20);SEARCHWORD$(J) 2015 IF P9 THEN LPRINT TAB(11);LEFT$(N$(SEARCHFIELD(J)),4);TAB(20);SEARCHWORD$(J) 2020 J=J+1 2030 IF SEARCHWORD$(J)="" GOTO 2050 2040 GOTO 2010 2050 IF SKIPWORD$(0)="" GOTO 2100 2060 PRINT" Rejection instructions: 2065 IF P9 THEN LPRINT" Rejection instructions: 2070 PRINT TAB(8);"FIELD NAME";TAB(20);"EXPRESSION 2075 IF P9 THEN LPRINT TAB(8)"FIELD NAME"TAB(20)"EXPRESSION 2080 J=0 2090 PRINT TAB(11);LEFT$(N$(LOOKFIELD(J)),4);TAB(20);SKIPWORD$(J) 2095 IF P9 THEN LPRINT TAB(11);LEFT$(N$(LOOKFIELD(J)),4);TAB(20);SKIPWORD$(J) 2097 J=J+1 2098 IF SKIPWORD$(J)<>"" THEN 2090 2100 ' 2110 PRINT"Statistics calculated for field '";LEFT$(N$(STATFX),4);"'" 2115 IF P9 THEN LPRINT:LPRINT"Statistics calculated for field ";LEFT$(N$(STATFX),4) 2120 PRINT:PRINT,"Number",NX 2125 IF P9 THEN LPRINT:LPRINT,"Number",NX 2130 PRINT,"Minimum",XMIN 2135 IF P9 THEN LPRINT,"Minimum",XMIN 2140 PRINT,"Maximum",XMAX 2145 IF P9 THEN LPRINT,"Maximum",XMAX 2150 PRINT,"Range",XMAX-XMIN 2155 IF P9 THEN LPRINT,"Range",XMAX-XMIN 2160 PRINT,"Sum",UX 2165 IF P9 THEN LPRINT,"Sum",UX 2170 PRINT,"Mean",WX 2175 IF P9 THEN LPRINT,"Mean",WX 2180 PRINT,"Standard Dev.",ZSD 2185 IF P9 THEN LPRINT,"Standard Dev.",ZSD 2190 PRINT,"Standard Err.",ZSE 2195 IF P9 THEN LPRINT,"Standard Err.",ZSE 2197 IF P9 THEN LPRINT FF$; 2200 PRINT:INPUT"Hit return to return to editor. ",A$ 2210 ' FINISH 2220 PRINT:PRINT"Re-loading DEDIT program. 2230 CHAIN DD$(1)+"DEDIT",1000 2240 ' (SUB) PARSE STRING 2250 K=0 2260 M=INSTR(T$,CHR$(126)) ' delimiter 2270 IF M=0 THEN RETURN 2280 K=K+1 2290 B$(K)="" 2300 B$(K)=MID$(T$,1,M-1) 2310 T$=MID$(T$,M+1) 2320 GOTO 2260 2330 ' GENERAL ERROR ROUTINES 2340 IF ERR=11 THEN RESUME 2350 ELSE 2360 2350 PRINT:PRINT"Division by zero error in line"ERL:GOTO 2210 2360 ON ERROR GOTO 0 2370 ' (SUB) EXIT TEST (TERM DEP) 2380 X$=INKEY$:IF X$=CHR$(27) THEN 2210 2390 RETURN 2400 ' (SUB) CLEAR SCREEN (TERM DEP) 2410 PRINT CHR$(12); 2420 RETURN 2430 ' (SUB) GET RECORD "I" IN T$ 2440 T$="" ' necessary! 2450 ON FT GOTO 2480,2460 2460 GET#1,FT*I+2 ' latter half 2470 T$=LEFT$(R$,127) 2480 GET#1,FT*I+1 ' whole or first half 2490 T$=R$+T$ 2500 RETURN 2510 ' (SUB) SHOW FIELDS 2515 PRINT 2520 FOR J=1 TO NC 2525 X$=RIGHT$(N$(J),1):IF X$<>"n" THEN 2550 2530 PRINT TAB(29); 2540 PRINT USING"##";J;:PRINT". "LEFT$(N$(J),4)" "RIGHT$(N$(J),1) 2550 NEXT:PRINT 2560 RETURN  2550 2530 PRINT TAB(29); 2540 PRINT USING"##";J;:PRINT". "LEFT$(N$(J),4)" "RIGHT$(N$(J),1) 2550 NE