Play and Learn 2/19941.ZIP/19941/EDUCMATH/STATS/DATA-ONE.BAS

GW-BASIC | 1994-02-04 | 8.4 KB | 182 lines

1  '                 STATISTICAL DATA ENTRY PROGRAM
2  '               Copyright Tracy L. Gustafson, M.D.
3  '              Round Rock, Texas. Version 3.2, 1985
4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15  DIM D(1,1),CS(1,1),T(1),N$(1),X(1),X2(1),MD(1),SD(1)
22  DATA "STATISTICAL DATA ENTRY PROGRAM",23,32
30  AFI=0:LOCATE 6,27:PRINT "1.) INITIAL DATA ENTRY"
35  PRINT:PRINT TAB(27);"2.) APPEND DATA"
40  PRINT:PRINT TAB(27);"3.) EDIT DATA"
45  PRINT:PRINT TAB(27);"4.) PRINT DATA"
50  PRINT:PRINT TAB(27);"5.) SAVE DATA TO DISK"
55  PRINT:PRINT TAB(27);"6.) LOAD DATA FROM DISK"
60  PRINT:PRINT TAB(27);"7.) EXIT":PRINT
65  LOCATE 21,27:PRINT "Enter choice:";:AR=21:AC=42:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-4)>3 THEN BEEP:GOTO 65
70  ON ASUB GOTO 155,355,375,505,735,750,775
75  COLOR CLR2,CLR1:LOCATE 25,55:PRINT " F10 = STOP ";:COLOR CLR1,CLR2:LOCATE AR,1:RETURN
80  GOSUB 75:TB=1:PRINT "Sample Name = ";:AC=6:T=1:A1=0:IF APND=1 THEN PRINT N$(1) ELSE INPUT "",N$(1)
85  C=C+1
87  AR=8+INT((C-1)/6):IF AR>24 THEN AR=24
88  AC=6+((C-1) MOD 6)*13:LOCATE AR,AC-5:PRINT USING "###:";C;
90  GOSUB 800:DI=IP$:IF DI="" THEN 120
95  VC=VAL(DI):T(1)=T(1)+1:X(1)=X(1)+VC:X2(1)=X2(1)+VC*VC
100  FOR Z=1 TO T(1)-1:VX=VAL(D(1,CS(1,Z))):IF VX<=VC THEN 110
105  FOR TZ=T(1) TO Z+1 STEP -1:CS(1,TZ)=CS(1,TZ-1):NEXT:GOTO 115
110  NEXT Z
115  CS(1,Z)=C
120  D(1,C)=DI:IF NOT JF THEN 130 ELSE IF DI="" THEN C=C-1
125  GOTO 150
130  IF AC>=71 THEN PRINT
135  GOTO 85
140  AR=CSRLIN:LOCATE 25,30:PRINT TAB(79):IF AR>22 THEN PRINT:PRINT:LOCATE 24,1 ELSE LOCATE AR+1,1
145  RETURN
150  GOSUB 140:GOSUB 305:OPEN "SCRN:" FOR OUTPUT AS #1:GOTO 595
155  AFI=-1:LOCATE 23,3:PRINT "How many samples or variables would you like to enter? (1 to 28)";:AR=23:AC=70:GOSUB 4800:A=VAL(IP$):IF A<1 OR A>28 THEN BEEP:GOTO 155
160  GOSUB 350:APND=0:ERASE D,CS,N$,X,X2,T,MD,SD
165  DIM D(A,2000/A),CS(A,2000/A),N$(A),X(A),X2(A),T(A),MD(A),SD(A)
170  C=0:FILE$="":PRINT "First NAME your samples or variables, then ENTER ";
175  PRINT "data:"
180  PRINT TAB(16);"1.) Press `RETURN' key to enter a value."
185  PRINT TAB(16);"3.) Press `TAB' key to back-up";:IF A>1 THEN PRINT " on same row." ELSE PRINT "."
190  PRINT TAB(16);"2.) Press `F10' key after last data entry."
195  PRINT:AR=CSRLIN:IF A=1 THEN 80
200  FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
205  A1=AS*7+1:SCREEN ,,AS,0
210  FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);"Sample";T;:NEXT:GOSUB 75:NEXT AS
215  PRINT:AR=CSRLIN
220  FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
225  A1=AS*7+1:SCREEN ,,AS,(APND=0)*(-AS):LOCATE AR,1:PRINT "NAME=";
230  FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);:IF APND=1 THEN PRINT N$(T); ELSE INPUT;"",N$(T)
235  NEXT:NEXT AS:PRINT:PRINT
240  AR=CSRLIN:C=C+1
245  FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
250  A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:PRINT USING "###:";C;
255  FOR T=A1 TO A2
260  AC=(T-A1+1)*10-3:GOSUB 800:DI=IP$:VC=VAL(DI):IF DI="" THEN 287
265  VC=VAL(DI):T(T)=T(T)+1:X(T)=X(T)+VC:X2(T)=X2(T)+VC*VC
270  FOR Z=1 TO T(T)-1:VX=VAL(D(T,CS(T,Z))):IF VX<=VC THEN 280
275  FOR TZ=T(T) TO Z+1 STEP -1:CS(T,TZ)=CS(T,TZ-1):NEXT:GOTO 285
280  NEXT Z
285  CS(T,Z)=C
287  D(T,C)=DI:IF NOT JF THEN 300 ELSE IF DI="" THEN C=C-1
290  GOTO 320
300  NEXT T:PRINT:NEXT AS:GOTO 240
305  SCREEN ,,0:FOR T=1 TO A:N=T(T):VC=0:IF N>1 THEN MN=X(T)/N ELSE MN=X(T):SD(T)=0:GOTO 310
307  FOR ZZ=1 TO N:VC=VC+(VAL(D(T,CS(T,ZZ)))-MN)^2:NEXT ZZ:SD(T)=SQR(VC/(N-1))
310  IF N>0 THEN IF N MOD 2=0 THEN MD(T)=(VAL(D(T,CS(T,N/2)))+VAL(D(T,CS(T,N/2+1))))*0.5 ELSE MD(T)=VAL(D(T,CS(T,N/2+0.5)))
315  NEXT:RETURN
320  GOSUB 305:PO$="SCRN:":OPEN PO$ FOR OUTPUT AS #1
325  FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
330  A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:GOSUB 140
335  GOSUB 665:NEXT AS:CLOSE #1:GOTO 20
340  IF MB>9999 THEN P$="#######.#" ELSE IF MB>99 THEN P$="#####.###" ELSE IF MB>=10 THEN P$="###.#####" ELSE P$="##.######"
345  RETURN
350  FOR AS=0 TO INT((A-1)/7):SCREEN ,,AS,0:CLS:NEXT:SCREEN ,,0:RETURN
355  GOSUB 350:PRINT TAB(33);"APPEND DATA": PRINT TAB(33);STRING$(11,205):APND=1:AFI=-1
360  IF A<>0 THEN 370
365  BEEP:PRINT "     You must enter a datafile from keyboard or disk before using APPEND.":GOTO 765
370  PRINT "APPEND your ";:GOTO 175
375  CLS:PRINT TAB(34);"EDIT DATA":PRINT TAB(34);STRING$(9,205):PRINT
380  PRINT TAB(14);"There are ";A; "sample groups in this datafile.":PRINT
385  PRINT TAB(7);"1.)  Enter positive record number to REPLACE a record."
390  PRINT TAB(7);"2.)  Enter negative record number to DELETE a record."
395  PRINT TAB(7);"3.)  Press F2 to change a sample NAME."
400  PRINT TAB(7);"4.)  Press F10 to exit from EDIT session."
405  KEY 2,"98"+CHR$(13):KEY 10,"99"+CHR$(13):AR=CSRLIN:LOCATE 25,32:COLOR CLR2,CLR1:PRINT " F2 = CHANGE NAME ";:LOCATE ,55:PRINT " F10 = EXIT ";:COLOR CLR1,CLR2:LOCATE AR+1,1
410  PRINT "Sample #";TAB(20);"Record #";TAB(40);"Old value";TAB(60);"New value"
415  F=0:AR=CSRLIN:AC=3:GOSUB 4800:B=VAL(IP$):IF B=99 THEN 500 ELSE IF B=98 THEN 490 ELSE IF B<1 OR B>A THEN BEEP:GOTO 415
420  AC=23:GOSUB 4800:BR=VAL(IP$):IF ABS(BR)>C OR BR=0 THEN BEEP:GOTO 420
425  IF BR>0 THEN 430 ELSE F=1:BR=-BR:IF D(B,BR)<>"" THEN 440
427  FOR Z=1 TO T(B):IF CS(B,Z)<>BR THEN NEXT:PRINT:GOTO 415 ELSE 440
430  PRINT TAB(40);D(B,BR);:LOCATE AR,60:INPUT "",DI:VN=VAL(DI)
435  IF D(B,BR)="" THEN T(B)=T(B)+1:GOTO 465
440  VC=VAL(D(B,BR)):X(B)=X(B)-VC:X2(B)=X2(B)-VC*VC
445  FOR Z=1 TO T(B)-1:IF CS(B,Z)<>BR THEN 455
450  FOR TZ=Z TO T(B)-1:CS(B,TZ)=CS(B,TZ+1):NEXT:GOTO 460
455  NEXT Z
460  IF F=1 THEN D(B,BR)="":T(B)=T(B)-1:PRINT:GOTO 415
465  D(B,BR)=DI:X(B)=X(B)+VN:X2(B)=X2(B)+VN*VN
470  FOR Z=1 TO T(B)-1:VX=VAL(D(B,CS(B,Z))):IF VX<=VN THEN 480
475  FOR TZ=T(B) TO Z+1 STEP -1:CS(B,TZ)=CS(B,TZ-1):NEXT:GOTO 485
480  NEXT Z
485  CS(B,Z)=BR:GOTO 415
490  LOCATE AR,1:PRINT "Sample #";TAB(20);"Old name";TAB(40);"New name"
495  LOCATE ,3:INPUT;"",B:IF B>A OR B=0 THEN BEEP:GOTO 495 ELSE PRINT TAB(20);:PRINT N$(B);TAB(40);:INPUT "",N$(B):GOTO 410
500  LOCATE 25,60:PRINT TAB(79);:KEY 10,"":KEY 2,"":GOSUB 305:GOTO 20
505  CLS:PRINT TAB(25);"PRINT DATAFILE ";FILE$:PRINT TAB(25);STRING$(LEN(FILE$)+15,205):PRINT
510  INPUT " Do you want the DATAFILE printed in SORTED or INPUT order? (S or I)  ",A$
515  IF A$="i" OR A$="I" THEN BSRT=0:GOTO 525 ELSE IF A$="s" OR A$="S" THEN BSRT=1 ELSE BEEP:GOTO 510
520  IF A>1 THEN PRINT TAB(15);:PRINT "Which sample number do you wish to SORT by?";:AR=CSRLIN:AC=60:GOSUB 4200
525  PRINT:PRINT TAB(8);:INPUT "Do you want to print data on SCREEN or PRINTER? (S or P)   ",A$
530  IF A$="P" OR A$="p" THEN PO$="LPT1:":PMAX=PRNT-10 ELSE IF A$="S" OR A$="s" THEN PO$="SCRN:":GOSUB 350:PMAX=70:GOTO 545 ELSE BEEP:GOTO 525
535  PRINT:PRINT TAB(23); "Be sure paper is in printer.":PRINT:PRINT TAB(24);"Press any key when ready:"
540  A$=INKEY$:IF A$="" THEN 540
545  ON ERROR GOTO 5070:OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
550  IF A>1 THEN 610 ELSE IF A=0 THEN BEEP:PRINT:PRINT TAB(18);"There is no data in this datafile.":CLOSE #1:GOTO 765
555  PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,
560  PRINT #1,"Sample Name = ";N$(1):PRINT #1,:TB=1:IF BSRT=1 THEN 580
565  FOR Z=1 TO C:PRINT #1,USING "###";Z;:PRINT #1,": ";D(1,Z);
570  TB=TB+13:IF TB>PMAX THEN TB=1
575  PRINT #1,TAB(TB);:NEXT:GOTO 595
580  FOR Z=1 TO T(1):PRINT #1,USING "###";CS(1,Z);:PRINT #1,": ";D(1,CS(1,Z));
585  TB=TB+13:IF TB>PMAX THEN TB=1
590  PRINT #1,TAB(TB);:NEXT
595  IF T(1)=0 THEN MN=0 ELSE MN=X(1)/T(1)
600  PRINT #1,:PRINT #1,:PRINT #1,TAB(5);"TOTAL =";T(1);TAB(26);"MEAN =";MN;TAB(55);"MEDIAN =";MD(1)
605  PRINT #1,:PRINT #1,TAB(20);"STANDARD DEVIATION =";SD(1):CLOSE #1:GOTO 765
610  AR=CSRLIN:FOR AS=0 TO INT((A-1)*10/PMAX):A2=(AS+1)*PMAX/10:IF A2>A THEN A2=A
615  A1=AS*PMAX/10+1:IF PO$="SCRN:" THEN SCREEN ,,AS,AS:LOCATE AR,1
620  PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,
625  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);"Sample";T;:NEXT:PRINT #1,
630  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);N$(T);:NEXT:PRINT #1,:PRINT #1,
635  IF BSRT=1 THEN 650
640  FOR Z=1 TO C:PRINT #1,USING "###";Z;:PRINT #1,":";
645  FOR T=A1 TO A2: PRINT #1,TAB((T-A1+1)*10-3);D(T,Z);:NEXT:PRINT #1,:NEXT:GOTO 660
650  FOR Z=1 TO T(NS):PRINT #1,USING "###";CS(NS,Z);:PRINT #1,":";
655  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,CS(NS,Z));:NEXT:PRINT #1,:NEXT
660  GOSUB 665:NEXT AS:CLOSE #1:GOTO 20
665  PRINT #1,:PRINT #1,"NO.";:P$="#####"
670  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;T(T);:NEXT
675  PRINT #1,:PRINT #1,"MEAN";
680  FOR T=A1 TO A2:IF T(T)>0 THEN MN=X(T)/T(T) ELSE MN=0
685  MB=ABS(MN):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MN;:NEXT
690  PRINT #1,:PRINT #1,"MED";
695  FOR T=A1 TO A2:MB=ABS(MD(T)):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MD(T);:NEXT
700  PRINT #1,:PRINT #1,"SDEV";
705  FOR T=A1 TO A2:MB=SD(T):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;SD(T);:NEXT
710  PRINT #1,:PRINT:IF A2=A THEN 725
715  IF PO$="LPT1:" THEN PRINT #1,CHR$(12)
720  LOCATE 24,28:PRINT "Press `P' to print next page:";
725  LOCATE 25,26:PRINT "Press space bar to return to menu.";
730  A$=INKEY$:IF A$="" THEN 730 ELSE IF A$="p" OR A$="P" THEN LOCATE 24,1:PRINT TAB(80):LOCATE 25,1:PRINT TAB(79):RETURN ELSE IF A$=CHR$(32) THEN CLOSE #1:GOTO 20 ELSE BEEP:GOTO 730
735  CLS:PRINT TAB(28);"SAVING DATA TO DISK":PRINT TAB(28);STRING$(19,205)
740  PRINT:AR=CSRLIN:GOSUB 4100
745  PRINT:PRINT:PRINT TAB(24); "Your data has been saved in: ";FILE$:GOTO 765
750  CLS:PRINT TAB(29);"LOADING DATA FROM DISK":PRINT TAB(29);STRING$(22,205)
755  PRINT:GOSUB 4000
760  PRINT:PRINT:PRINT TAB(24); FILE$;" has been loaded from disk."
765  LOCATE 25,10:PRINT TAB(22);"Press any key to return to main menu:";TAB(75);
770  A$=INKEY$:IF A$="" THEN 770 ELSE SCREEN ,,0:GOTO 20
775  PRINT:PRINT TAB(10);:INPUT "Have you saved your current data to disk? (Y or N)    ",A$
780  IF A$<>"y" AND A$<>"Y" THEN 20 ELSE 3000
800  LOCATE AR,AC:PRINT SPACE$(8);:LOCATE AR,AC,1,5,7:CL=0:JF=0
805  I$=INKEY$:IF I$="" THEN 805
810  IF I$>CHR$(31) AND CL<8 THEN CL=CL+1:MID$(IT$,CL,1)=I$:PRINT I$;:GOTO 805
815  IF I$=CHR$(13) THEN IP$=MID$(IT$,1,CL):RETURN
820  IF I$=CHR$(8) THEN IF CL>0 THEN CL=CL-1:PRINT CHR$(29);" ";CHR$(29);:GOTO 805
825  IF I$<>CHR$(9) OR NOT AFI OR T<=A1 THEN 835
826  LOCATE AR,AC:PRINT SPACE$(8);:IF A>1 THEN T=T-1:GOTO 828
827  IF C<=1 THEN BEEP:GOTO 800 ELSE C=C-1
828  IF D(T,C)="" THEN 833
829  VC=VAL(D(T,C)):X(T)=X(T)-VC:X2(T)=X2(T)-VC*VC
830  FOR ZX=1 TO T(T)-1:IF CS(T,ZX)<>C THEN NEXT ZX
831  FOR TZ=ZX TO T(T)-1:CS(T,TZ)=CS(T,TZ+1):NEXT:T(T)=T(T)-1
833  IF A=1 THEN RETURN 87 ELSE RETURN 260
835  IF AFI AND LEN(I$)=2 THEN AI=ASC(MID$(I$,2,1)):IF AI=68 THEN JF=-1:IP$=MID$(IT$,1,CL):RETURN
840  BEEP:GOTO 805
4025  ERASE D,CS,T,N$,X,X2,MD,SD
4030  DIM D(A,2000/A),CS(A,2000/A),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
5000  BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 2,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010  ON ERROR GOTO 0:END