1 '                      SCATTERGRAM GRAPHING PROGRAM
2 '                   Written by Tracy L. Gustafson, M.D.
3 '                  Round Rock, Texas.  Version 3.0, 1984
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),NS(2),MN(2),MX(2),BT(2),SW(2),FD(2),HD(2),XR(2),XC(2),BP(201)
22 DATA "SCATTERGRAM GRAPHING PROGRAM",22,30
30 LOCATE 6,1:GOSUB 4000
35 DQ="What is the SAMPLE NUMBER of the variable you want on the "
40 PRINT:AR=CSRLIN:PRINT DQ;"X-axis?":AC=68:GOSUB 4200:NS(1)=NS
45 PRINT:AR=CSRLIN:PRINT DQ;"Y-axis?":GOSUB 4200:NS(2)=NS
50 N=T(NS(1)):IF N<>T(NS(2)) THEN BEEP:PRINT:PRINT "These 2 samples do not have the same number of elements------":PRINT TAB(47);"a scattergram cannot be drawn.":GOTO 405
55 CLS:PRINT TAB(25);DTTL:PRINT TAB(25);STRING$(28,205):AR=CSRLIN+1
60 LOCATE 25,3:COLOR CLR2,CLR1:PRINT " F1 = PRINT COPY ";:LOCATE ,28:PRINT " F5 = LINEAR REGRESSION ";:LOCATE ,60:PRINT " F10 = RETURN ";
65 COLOR CLR1,CLR2:LOCATE AR,25:PRINT "X-AXIS";TAB(50);"Y-AXIS"
70 PRINT "Sample NAME:";TAB(25);N$(NS(1));TAB(50);N$(NS(2))
75 PRINT "MINIMUM value:";:FOR T=1 TO 2:MN(T)=VAL(D(NS(T),CS(NS(T),1))):PRINT TAB(25*T);MN(T);:NEXT:PRINT
80 PRINT "MAXIMUM value:";:FOR T=1 TO 2:MX(T)=VAL(D(NS(T),CS(NS(T),N))):PRINT TAB(25*T);MX(T);:NEXT:PRINT
85 PRINT "  Axis LABELS:";TAB(24);:INPUT;"",DV1:PRINT TAB(49);:INPUT "",DV2
90 PRINT "Measurement UNITS:";TAB(24);:INPUT;"",DU1:PRINT TAB(49);:INPUT "",DU2
95 AR=CSRLIN:LOCATE 23,5:PRINT "The maximum number of intervals I can graph is":PRINT TAB(33);"60 on the X-axis and 20 on the Y-axis.";
100 LOCATE AR,1:PRINT "Labeling interval:";
105 T=1:HD(1)=1:LOCATE AR,26:INPUT "",SW(1):GOSUB 120:IF BT(1)>60 THEN BEEP:GOTO 105 ELSE EX=EE
110 T=2:HD(2)=1:LOCATE AR,51:INPUT "",SW(2):GOSUB 120:IF BT(2)>20 THEN BEEP:GOTO 110 ELSE EY=EE
115 GOTO 160
120 EE=MN(T)-3*SW(T):EN=MX(T)+SW(T):IF MN(T)>=0 AND EE<=0 THEN EE=0:SN=SW(T) ELSE SN=EE
125 IF EN>99 THEN HD(T)=HD(T)*10:SN=SN/10:EN=EN/10:GOTO 125
130 IF ABS(SN)<.1 THEN HD(T)=HD(T)/10:SN=SN*10:GOTO 130
135 IF SN<-99 THEN HD(T)=HD(T)*10:SN=SN/10:GOTO 135
140 IF EE<>0 THEN EE=INT(SN*10)*(HD(T)/10)
145 BT(T)=(MX(T)-EE)/SW(T)+1:RETURN
150 IF ABS(EE)<10 THEN P$="###.##" ELSE P$="###.#"
155 RETURN
160 SCREEN 2,1:OUT 985,(CLR1-(CLR1=0)):CLS:PRINT TAB(35);FILE$
165 CH=INT(60/BT(1)):IF CH>5 THEN CH=5
170 LH=BT(1)*CH*8+114:LINE (110,171)-(LH,171):ZH=5/CH:IF CH=4 THEN ZH=2
175 FOR Z=1 TO BT(1):HL=114+8*CH*Z:IF Z MOD ZH=0 THEN LINE (HL,171)-(HL,175) ELSE LINE (HL,171)-(HL,173)
180 NEXT Z
185 EMX=EX+BT(1)*SW(1):EE=EMX/HD(1):GOSUB 150
190 FOR Z=0 TO BT(1):IF Z MOD ZH=0 THEN HL=12+CH*Z:LOCATE 23,HL:PRINT USING P$;(EX+Z*SW(1))/HD(1);
195 NEXT Z
200 TB=LEN(DV1)+LEN(DU1)-8*(HD(1)<>1):LOCATE 25,BT(1)*CH/2+12-TB/2:PRINT DV1;" (";DU1;:IF HD(1)<>1 THEN PRINT " x";:PRINT USING"##^^^^";HD(1);
205 PRINT ")";
210 CI=INT(20/BT(2)):IF CI>5 THEN CI=5
215 LV=171-BT(2)*CI*8:LINE (114,175)-(114,LV)
220 FOR Z=1 TO BT(2):HL=171-Z*CI*8:IF CI=1 THEN IF Z MOD 2<>0 THEN LINE(112,HL)-(114,HL):GOTO 230
225 LINE (110,HL)-(114,HL)
230 NEXT Z
235 EMY=(EY+SW(2)*BT(2)):EE=EMY/HD(2):GOSUB 150
240 FOR Z=0 TO BT(2):HL=22-Z*CI:IF CI=1 THEN IF Z MOD 2<>0 THEN 250
245 LOCATE HL,9:PRINT USING P$;(EY+Z*SW(2))/HD(2);
250 NEXT Z
255 TB=LEN(DV2)+2-2*(HD(2)<>1):AR=22-BT(2)*CI/2-TB/2
260 FOR Z=1 TO LEN(DV2):LOCATE AR,4:PRINT MID$(DV2,Z,1):AR=AR+1:NEXT
265 LOCATE AR+1,1:PRINT MID$(DU2,1,8):IF LEN(DU2)>8 THEN PRINT " ";MID$(DU2,9,6)
270 IF HD(2)<>1 THEN PRINT "   x":PRINT USING "##^^^^";HD(2)
275 FOR Z=1 TO N:XC=VAL(D(NS(1),Z))-EX:XC=114+XC*CH*8/SW(1)
280 XR=VAL(D(NS(2),Z))-EY:XR=171-XR*CI*8/SW(2):CIRCLE (XC,XR),2:NEXT
285 A$=INKEY$:IF A$="" THEN 285 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN 400 ELSE IF AI=63 THEN 295 ELSE IF AI=59 THEN 350
290 BEEP:GOTO 285
295 XC=0:FOR Z=1 TO N:XC=XC+VAL(D(NS(1),Z))*VAL(D(NS(2),Z)):NEXT
300 SC=XC-X(NS(1))*X(NS(2))/N:SX=X2(NS(1))-X(NS(1))*X(NS(1))/N
305 SY=X2(NS(2))-X(NS(2))*X(NS(2))/N:SB=SC/SX:IA=(X(NS(2))-SB*X(NS(1)))/N
310 CC=1:YT=IA+SB*EX:IF YTEMY THEN 320
315 XC(1)=114:XR(1)=171-(YT-EY)/SW(2)*CI*8:CC=2
320 XT=(EY-IA)/SB:IF XT<=EX OR XT>=EMX THEN 330
325 XC(CC)=114+CH*8*(XT-EX)/SW(1):XR(CC)=171:IF CC=2 THEN 345 ELSE CC=CC+1
330 YT=IA+SB*EMX:IF YTEMY THEN 340
335 XC(CC)=114+CH*8*(EMX-EX)/SW(1):XR(CC)=171-CI*8*(YT-EY)/SW(2):IF CC=2 THEN 345
340 XT=(EMY-IA)/SB:XR(2)=171-CI*8*(EMY-EY)/SW(2):XC(2)=114+CH*8*(XT-EX)/SW(1)
345 LINE (XC(1),XR(1))-(XC(2),XR(2)):GOTO 285
350 ON ERROR GOTO 5070:OPEN "LPT1:" AS #1:WIDTH #1,255:DEF SEG=&HB800
355 PRINT #1,CHR$(27)+"@";CHR$(13);CHR$(27)+"3"+CHR$(23);CHR$(27)+"U"+CHR$(1);
360 FOR Z=0 TO 79:PRINT #1,CHR$(27)+"L"+CHR$(32)+CHR$(3);
365 FOR AY=0 TO 99:AX=AY*80+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(AX+8192):NEXT
370 FOR AY=100 TO 1 STEP -1:PRINT #1,STRING$(4,BP(AY+100));STRING$(4,BP(AY));:NEXT
375 PRINT #1,CHR$(13);CHR$(10);:NEXT
380 FOR Z=41 TO 26 STEP -1:PLAY "MB L32 N=Z;":NEXT:PLAY "MB L3 N18"
385 PRINT #1,CHR$(27)+"3"+CHR$(36);CHR$(13);CHR$(12)
390 PRINT #1,CHR$(27)+"U"+CHR$(0);CHR$(27)+"@"
395 CLOSE #1:DEF SEG:GOTO 285
400 SCREEN 0,1:COLOR CLR1,CLR2,CLR3:CLS
405 LOCATE 25,4:DQ="Do you want another SCATTERGRAM using ":PRINT DQ;:INPUT;"the SAME two samples?  ",A$
410 IF A$="y" OR A$="Y" THEN 55 ELSE IF A$<>"n" AND A$<>"N" THEN BEEP:GOTO 405
415 LOCATE 25,4:PRINT "    ";DQ;:INPUT;"DIFFERENT samples?  ",A$
420 IF A$="N" OR A$="n" THEN 435 ELSE IF A$<>"Y" AND A$<>"y" THEN BEEP:GOTO 415
425 LOCATE 25,3:PRINT TAB(75):LOCATE 25,20:PRINT "Are the samples you want in ";FILE$;:INPUT;A$
430 IF A$="y" OR A$="Y" THEN CLS:LOCATE 2,1:GOTO 35 ELSE IF A$="n" OR A$="N" THEN 20 ELSE BEEP:GOTO 425
435 LOCATE 23,1:END
4025 ERASE D,CS,T,N$,X,X2,MD,SD
4030 DIM D(A,C),CS(A,C),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
5000 BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,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
5072 A$=INKEY$:IF A$="" THEN 5072 ELSE CLOSE #1:RESUME 160