home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / SCATRGRM.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  5.5 KB  |  111 lines
  1. 1  '                      SCATTERGRAM GRAPHING PROGRAM
  2. 2  '                   Copyright Tracy L. Gustafson, M.D.
  3. 3  '                  Round Rock, Texas.  Version 3.2, 1985
  4. 4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
  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)
  6. 22  DATA "SCATTERGRAM GRAPHING PROGRAM",26,30
  7. 30  LOCATE 6,1:GOSUB 4000
  8. 35  DQ="What is the SAMPLE NUMBER of the variable you want on the "
  9. 40  PRINT:AR=CSRLIN:PRINT DQ;"X-axis?":AC=68:GOSUB 4200:NS(1)=NS
  10. 45  PRINT:AR=CSRLIN:PRINT DQ;"Y-axis?":GOSUB 4200:NS(2)=NS
  11. 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 465
  12. 55  CLS:PRINT TAB(25);DTTL:PRINT TAB(25);STRING$(28,205):AR=CSRLIN+1
  13. 60  LOCATE 25,5:COLOR CLR2,CLR1:PRINT " F1 = PRINT COPY ";:LOCATE ,30:PRINT " F5 = LINEAR REGRESSION ";:LOCATE ,62:PRINT " F10 = RETURN ";
  14. 65  COLOR CLR1,CLR2:LOCATE AR,25:PRINT "X-AXIS";TAB(50);"Y-AXIS"
  15. 70  PRINT "Sample NAME:";TAB(25);N$(NS(1));TAB(50);N$(NS(2))
  16. 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
  17. 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
  18. 85  PRINT "  Axis LABELS:";TAB(24);:INPUT;"",DV1:PRINT TAB(49);:INPUT "",DV2
  19. 90  PRINT "Measurement UNITS:";TAB(24);:INPUT;"",DU1:PRINT TAB(49);:INPUT "",DU2
  20. 95  AR=CSRLIN:LOCATE 23,5:PRINT "The maximum number of intervals I can graph is":PRINT TAB(37);"60 on the X-axis and 20 on the Y-axis.";
  21. 100  LOCATE AR,1:PRINT "Labeling interval:";
  22. 105  T=1:HD(1)=1:AC=26:GOSUB 4800:SW(1)=VAL(IP$):GOSUB 120:IF BT(1)>60 THEN BEEP:GOTO 105 ELSE EX=EE
  23. 110  T=2:HD(2)=1:AC=51:GOSUB 4800:SW(2)=VAL(IP$):GOSUB 120:IF BT(2)>20 THEN BEEP:GOTO 110 ELSE EY=EE
  24. 115  GOTO 160
  25. 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
  26. 125  IF EN>99 THEN HD(T)=HD(T)*10:SN=SN/10:EN=EN/10:GOTO 125
  27. 130  IF ABS(SN)<0.1 THEN HD(T)=HD(T)/10:SN=SN*10:GOTO 130
  28. 135  IF SN<-99 THEN HD(T)=HD(T)*10:SN=SN/10:GOTO 135
  29. 140  IF EE<>0 THEN EE=INT(SN*10)*(HD(T)/10)
  30. 145  BT(T)=(MX(T)-EE)/SW(T)+1:RETURN
  31. 150  IF ABS(EE)<10 THEN P$="###.##" ELSE P$="###.#"
  32. 155  RETURN
  33. 160  SCREEN 2,1:OUT 985,(CLR1-(CLR1=0)):CLS:PRINT TAB(35);FILE$
  34. 165  CH=INT(60/BT(1)):IF CH>5 THEN CH=5
  35. 170  LH=BT(1)*CH*8+114:LINE (110,171)-(LH,171):ZH=5/CH:IF CH=4 THEN ZH=2
  36. 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)
  37. 180  NEXT Z
  38. 185  EMX=EX+BT(1)*SW(1):EE=EMX/HD(1):GOSUB 150
  39. 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);
  40. 195  NEXT Z
  41. 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);
  42. 205  PRINT ")";
  43. 210  CI=INT(20/BT(2)):IF CI>5 THEN CI=5
  44. 215  LV=171-BT(2)*CI*8:LINE (114,175)-(114,LV)
  45. 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
  46. 225  LINE (110,HL)-(114,HL)
  47. 230  NEXT Z
  48. 235  EMY=(EY+SW(2)*BT(2)):EE=EMY/HD(2):GOSUB 150
  49. 240  FOR Z=0 TO BT(2):HL=22-Z*CI:IF CI=1 THEN IF Z MOD 2<>0 THEN 250
  50. 245  LOCATE HL,9:PRINT USING P$;(EY+Z*SW(2))/HD(2);
  51. 250  NEXT Z
  52. 255  TB=LEN(DV2)+2-2*(HD(2)<>1):AR=22-BT(2)*CI/2-TB/2
  53. 260  FOR Z=1 TO LEN(DV2):LOCATE AR,4:PRINT MID$(DV2,Z,1):AR=AR+1:NEXT
  54. 265  LOCATE AR+1,1:PRINT MID$(DU2,1,8):IF LEN(DU2)>8 THEN PRINT " ";MID$(DU2,9,6)
  55. 270  IF HD(2)<>1 THEN PRINT "   x":PRINT USING "##^^^^";HD(2)
  56. 275  FOR Z=1 TO N:XC=VAL(D(NS(1),Z))-EX:XC=114+XC*CH*8/SW(1)
  57. 280  XR=VAL(D(NS(2),Z))-EY:XR=171-XR*CI*8/SW(2):CIRCLE (XC,XR),2:NEXT
  58. 285  A$=INKEY$:IF A$="" THEN 285 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN 460 ELSE IF AI=63 THEN 295 ELSE IF AI=59 THEN 350
  59. 290  BEEP:GOTO 285
  60. 295  XC=0:FOR Z=1 TO N:XC=XC+VAL(D(NS(1),Z))*VAL(D(NS(2),Z)):NEXT
  61. 300  SC=XC-X(NS(1))*X(NS(2))/N:SX=X2(NS(1))-X(NS(1))*X(NS(1))/N
  62. 305  SY=X2(NS(2))-X(NS(2))*X(NS(2))/N:SB=SC/SX:IA=(X(NS(2))-SB*X(NS(1)))/N
  63. 310  CC=1:YT=IA+SB*EX:IF YT<EY OR YT>EMY THEN 320
  64. 315  XC(1)=114:XR(1)=171-(YT-EY)/SW(2)*CI*8:CC=2
  65. 320  XT=(EY-IA)/SB:IF XT<=EX OR XT>=EMX THEN 330
  66. 325  XC(CC)=114+CH*8*(XT-EX)/SW(1):XR(CC)=171:IF CC=2 THEN 345 ELSE CC=CC+1
  67. 330  YT=IA+SB*EMX:IF YT<EY OR YT>EMY THEN 340
  68. 335  XC(CC)=114+CH*8*(EMX-EX)/SW(1):XR(CC)=171-CI*8*(YT-EY)/SW(2):IF CC=2 THEN 345
  69. 340  XT=(EMY-IA)/SB:XR(2)=171-CI*8*(EMY-EY)/SW(2):XC(2)=114+CH*8*(XT-EX)/SW(1)
  70. 345  LINE (XC(1),XR(1))-(XC(2),XR(2)):GOTO 285
  71. 350  ON ERROR GOTO 5070:OPEN "LPT1:" AS #1:WIDTH #1,255:DEF SEG=&HB800
  72. 355  ON PMAK GOTO 360,360,400,430
  73. 360  PRINT #1,CHR$(27)+"@";CHR$(13);CHR$(27)+"3"+CHR$(23);CHR$(27)+"U"+CHR$(1);
  74. 365  FOR Z=0 TO 79:PRINT #1,CHR$(27)+"L"+CHR$(32)+CHR$(3);
  75. 370  FOR AY=0 TO 99:AX=AY*80+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(AX+8192):NEXT
  76. 375  FOR AY=100 TO 1 STEP -1:BQ=BP(AY+100):BR=BP(AY):IF BQ=13 THEN BQ=9
  77. 376  IF BR=13 THEN BR=9
  78. 377  PRINT #1,STRING$(4,BQ);STRING$(4,BR);:NEXT
  79. 380  PRINT #1,CHR$(13);CHR$(10);:NEXT
  80. 385  PRINT #1,CHR$(27)+"3"+CHR$(36);CHR$(13);CHR$(12)
  81. 390  PRINT #1,CHR$(27)+"U"+CHR$(0);TYP$;
  82. 395  PLAY "MS O3 L64 G O2 GE L9 E":CLOSE #1:DEF SEG:GOTO 285
  83. 400  PRINT #1,CHR$(27)+"0";CHR$(30);CHR$(3);
  84. 405  FOR Z=79 TO 0 STEP -1
  85. 410  FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
  86. 415  FOR AY=1 TO 100:BQ=BP(AY):BR=BP(AY+100):NQ=2:NR=2:IF BQ=3 THEN NQ=4
  87. 416  IF BR=3 THEN NR=4
  88. 417  PRINT #1,STRING$(NQ,BQ);STRING$(NR,BR);:NEXT
  89. 420  PRINT #1,CHR$(3);CHR$(14);:NEXT
  90. 425  PRINT #1,CHR$(3);CHR$(2);CHR$(27)+"6";TYP$;:GOTO 395
  91. 430  PRINT #1,CHR$(27)+"N";CHR$(27)+"T16";CHR$(27)+"L005";CHR$(27)+">";
  92. 435  FOR Z=79 TO 0 STEP -1:PRINT #1,CHR$(27)+"S0600";
  93. 440  FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
  94. 445  FOR AY=1 TO 100:PRINT #1,STRING$(3,BP(AY));STRING$(3,BP(AY+100));:NEXT
  95. 450  PRINT #1,CHR$(13);CHR$(10);:NEXT
  96. 455  PRINT #1,CHR$(27)+"<";CHR$(27)+"L000";CHR$(27)+"A";TYP$;:GOTO 395
  97. 460  SCREEN 0,1:COLOR CLR1,CLR2,CLR3:CLS
  98. 465  LOCATE 25,9:DQ="Do you want another SCATTERGRAM using ":PRINT DQ;:INPUT;"the SAME two samples?  ",A$
  99. 470  IF A$="y" OR A$="Y" THEN 55 ELSE IF A$<>"n" AND A$<>"N" THEN BEEP:GOTO 465
  100. 475  LOCATE 25,7:PRINT "    ";DQ;:INPUT;"DIFFERENT samples?  ",A$
  101. 480  IF A$="N" OR A$="n" THEN 495 ELSE IF A$<>"Y" AND A$<>"y" THEN BEEP:GOTO 475
  102. 485  LOCATE 25,3:PRINT TAB(75):LOCATE 25,20:PRINT "Are the samples you want in ";FILE$;:INPUT;A$
  103. 490  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 485
  104. 495  GOTO 3000
  105. 4025  ERASE D,CS,T,N$,X,X2,MD,SD
  106. 4030  DIM D(A,C),CS(A,C),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
  107. 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:"
  108. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  109. 5010  ON ERROR GOTO 0:END
  110. 5072  A$=INKEY$:IF A$="" THEN 5072 ELSE CLOSE #1:RESUME 160
  111.