home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / HISTOGRM.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  4.3 KB  |  93 lines
  1. 1  '                   HISTOGRAM 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),N$(1),X(1),X2(1),T(1),MD(1),SD(1),CT(1),EX(1),BP(201)
  6. 22  DATA "HISTOGRAM GRAPHING PROGRAM",26,28
  7. 30  GOSUB 4000
  8. 35  PRINT:AR=CSRLIN:PRINT TAB(9);"What is the SAMPLE NUMBER of the variable you want to graph?";:AC=71:GOSUB 4200
  9. 40  CLS:PRINT TAB(29);DTTL;:PRINT TAB(29);STRING$(26,205):AR=CSRLIN+1
  10. 45  LOCATE 25,35:COLOR CLR2,CLR1:PRINT " F1 = PRINT COPY ";:LOCATE 25,55:PRINT " F10 = RETURN ";:COLOR CLR1,CLR2:LOCATE AR,1
  11. 50  N=T(NS):D1=D(NS,CS(NS,1)):D2=D(NS,CS(NS,N)):FD=VAL(D2)-VAL(D1)
  12. 55  PRINT TAB(8);"The";N;"VALUES in ";N$(NS);" range from ";D1;" to ";D2;":"
  13. 60  PRINT TAB(27);"The difference between these values is";FD;"."
  14. 65  PRINT:PRINT TAB(8);:INPUT "Enter the full name of the variable to be graphed:   ",DV
  15. 70  PRINT TAB(23);"What are the units of ";DV;"?";TAB(65);:INPUT "",DU
  16. 75  PRINT:AR=CSRLIN:LOCATE 24,12:PRINT "The maximum number of intervals I can graph is 60.";
  17. 80  LOCATE AR,23:PRINT "Enter WIDTH of each cell (in ";DU;")";:AC=65:GOSUB 4800:FU=VAL(IP$)
  18. 85  IF FD/FU>65 THEN BEEP:GOTO 75
  19. 90  LOCATE 22,35:COLOR 23:PRINT "CALCULATING";:COLOR CLR1
  20. 95  EZ=VAL(D1)-3*FU:HD=1:IF VAL(D1)>=0 AND EZ<=0 THEN EZ=0:SN=FU ELSE SN=EZ
  21. 100  EN=VAL(D2)
  22. 105  IF EN>99 THEN HD=HD*10:SN=SN/10:EN=EN/10:GOTO 105
  23. 110  IF ABS(SN)<0.1 THEN HD=HD/10:SN=SN*10:GOTO 110
  24. 115  IF SN<-99 THEN HD=HD*10:SN=SN/10:GOTO 115
  25. 120  IF EZ<>0 THEN EZ=INT(SN*10)*(HD/10)
  26. 125  FD=VAL(D2)-EZ:BT=INT(FD/FU)+4:CC=1:ERASE CT,EX:DIM CT(BT),EX(BT)
  27. 130  EX(1)=EZ:FOR T=1 TO N:VX=VAL(D(NS,CS(NS,T)))
  28. 135  IF VX<EX(CC) THEN CT(CC)=CT(CC)+1:NEXT:GOTO 145
  29. 140  CC=CC+1:EX(CC)=EX(CC-1)+FU:GOTO 135
  30. 145  FOR Z=CC TO BT:EX(Z)=EX(Z-1)+FU:NEXT
  31. 150  CMX=1:FOR Z=1 TO BT:IF CT(Z)>CMX THEN CMX=CT(Z)
  32. 155  NEXT
  33. 160  SCREEN 2,1:OUT 985,(CLR1-(CLR1=0)):CLS:PRINT TAB(35);FILE$
  34. 165  XI=20/CMX:CIX=1:CI=INT(XI):IF XI>5 THEN CI=5 ELSE IF XI<1 THEN CIX=INT(1/XI+1):CI=1
  35. 170  LV=(CMX+1)*CI/CIX:LINE(34,171)-(34,171-LV*8)
  36. 175  FOR Z=1 TO CMX/CIX:HL=171-Z*8*CI:LINE (30,HL)-(34,HL):NEXT:NH=0
  37. 180  FOR Z=1 TO CMX/CIX:HL=22-Z*CI:NH=NH+CIX:IF CI=1 THEN IF Z MOD 2=0 THEN 190
  38. 185  LOCATE HL,1:PRINT USING "###";NH
  39. 190  NEXT
  40. 195  CH=INT(70/BT):IF CH>5 THEN CH=5 ELSE IF CH<1 THEN CH=1
  41. 200  LH=(BT+1)*CH:LINE (34,171)-(LH*8+34,171):ZH=5/CH:IF CH=4 THEN ZH=2
  42. 205  FOR Z=1 TO BT:HL=34+8*CH*Z:IF Z MOD ZH=1 THEN LINE (HL,171)-(HL,175) ELSE LINE (HL,171)-(HL,173)
  43. 210  NEXT
  44. 215  EXH=EX(BT)/HD:IF ABS(EXH)<10 THEN P$="###.##" ELSE P$="###.#"
  45. 220  FOR Z=1 TO BT:IF (Z-1) MOD ZH<>0 THEN 230
  46. 225  HL=2+CH*Z:LOCATE 23,HL:PRINT USING P$;EX(Z)/HD;
  47. 230  NEXT
  48. 235  TB=LEN(DV)+LEN(DU)-8*(HD<>1):LOCATE 25,HL/2-TB/2+3:PRINT DV;"  (";DU;:IF HD<>1 THEN PRINT " x";:PRINT USING "##^^^^";HD;
  49. 240  PRINT ")";:CHP=CH*8
  50. 245  FOR Z=1 TO BT:LLC=34+CHP*(Z-1):RLC=LLC+CHP:UC=171-INT(CT(Z)*CI*8/CIX):LINE (LLC,171)-(RLC,UC),,BF:NEXT
  51. 250  A$=INKEY$:IF A$="" THEN 250 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN 370 ELSE IF AI=59 THEN 260
  52. 255  BEEP:GOTO 250
  53. 260  ON ERROR GOTO 5070:OPEN "LPT1:" AS #1:WIDTH #1,255:DEF SEG=&HB800
  54. 265  ON PMAK GOTO 270,270,310,340
  55. 270  PRINT #1,CHR$(27)+"@";CHR$(13);CHR$(27)+"3"+CHR$(23);CHR$(27)+"U"+CHR$(1);
  56. 275  FOR Z=0 TO 79:PRINT #1,CHR$(27)+"L"+CHR$(32)+CHR$(3);
  57. 280  FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
  58. 285  FOR AY=100 TO 1 STEP -1:BQ=BP(AY+100):BR=BP(AY):IF BQ=13 THEN BQ=9
  59. 286  IF BR=13 THEN BR=9
  60. 287  PRINT #1,STRING$(4,BQ);STRING$(4,BR);:NEXT
  61. 290  PRINT #1,CHR$(13);CHR$(10);:NEXT
  62. 295  PRINT #1,CHR$(27)+"3"+CHR$(36);CHR$(13);CHR$(12);
  63. 300  PRINT #1,CHR$(27)+"U"+CHR$(0);TYP$;
  64. 305  PLAY "MS O3 L64 G O2 GE L9 E":CLOSE #1:DEF SEG:GOTO 250
  65. 310  PRINT #1,CHR$(27)+"0";CHR$(30);CHR$(3);
  66. 315  FOR Z=79 TO 0 STEP -1
  67. 320  FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
  68. 325  FOR AY=1 TO 100:BQ=BP(AY):BR=BP(AY+100):NQ=2:NR=2:IF BQ=3 THEN NQ=4
  69. 326  IF BR=3 THEN NR=4
  70. 327  PRINT #1,STRING$(NQ,BQ);STRING$(NR,BR);:NEXT
  71. 330  PRINT #1,CHR$(3);CHR$(14);:NEXT
  72. 335  PRINT #1,CHR$(3);CHR$(2);CHR$(27)+"6";TYP$;:GOTO 305
  73. 340  PRINT #1,CHR$(27)+"N";CHR$(27)+"T16";CHR$(27)+"L005";CHR$(27)+">";
  74. 345  FOR Z=79 TO 0 STEP -1:PRINT #1,CHR$(27)+"S0600";
  75. 350  FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
  76. 355  FOR AY=1 TO 100:PRINT #1,STRING$(3,BP(AY));STRING$(3,BP(AY+100));:NEXT
  77. 360  PRINT #1,CHR$(13);CHR$(10);:NEXT
  78. 365  PRINT #1,CHR$(27)+"<";CHR$(27)+"L000";CHR$(27)+"A";TYP$;:GOTO 305
  79. 370  SCREEN 0,SCRN:COLOR CLR1,CLR2,CLR3:CLS
  80. 375  DQ="Would you like another HISTOGRAM using ":LOCATE 25,8:PRINT DQ;:INPUT "the SAME sample?  ",A$
  81. 380  IF A$="y" OR A$="Y" THEN 40 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP:GOTO 370
  82. 385  LOCATE 25,47:INPUT "a DIFFERENT sample?  ",A$
  83. 390  IF A$="N" OR A$="n" THEN 405 ELSE IF A$<>"y" AND A$<>"Y" THEN BEEP:GOTO 385
  84. 395  LOCATE 25,5:PRINT TAB(75):LOCATE 25,20:PRINT "Is the sample you want in ";FILE$;:INPUT;A$
  85. 400  IF A$="Y" OR A$="y" THEN LOCATE 2,1:GOTO 35 ELSE IF A$="n" OR A$="N" THEN 20 ELSE BEEP:GOTO 395
  86. 405  GOTO 3000
  87. 4025  ERASE D,CS,N$,X,X2,T,MD,SD
  88. 4030  DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),T(A),MD(A),SD(A)
  89. 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:"
  90. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  91. 5010  ON ERROR GOTO 0:END
  92. 5072  A$=INKEY$:IF A$="" THEN 5072 ELSE CLOSE #1:RESUME 160
  93.