home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / SELECT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  6.5 KB  |  122 lines
  1. 1  '                    SELECT SPECIFIC RECORDS
  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),CZ(1),NN(10),NA(10),NB(10),SA(10)
  6. 22  DATA "SELECT SPECIFIC RECORDS",27,25
  7. 30  LOCATE 5,1:GOSUB 4000
  8. 35  AR=CSRLIN:LOCATE 25,1:PRINT "1";:FOR Z=2 TO 10:PRINT TAB(Z*7-1);Z;:NEXT
  9. 40  RESTORE 45:COLOR CLR2,CLR1:FOR Z=1 TO 10:READ AC,DC:LOCATE 25,AC:PRINT DC;:NN(Z)=1:NEXT:COLOR CLR1,CLR2
  10. 45  DATA 2," Sample # ",15," = ",22," > ",29," >= ",36," < ",43," <= ",50," <> ",57," AND ",64," OR ",72," DONE "
  11. 50  LOCATE AR,1:PRINT:PRINT TAB(14);"1.) Use FORMAT  (A) SELECT IF: Sample #1 >= NUMBER"
  12. 55  PRINT TAB(26);"or  (B) SELECT IF: Sample #1 >= Sample #2"
  13. 60  PRINT TAB(14);"2.) Press RETURN after entering a NUMBER."
  14. 65  PRINT TAB(14);"3.) Press Key F10 when selection criteria are complete."
  15. 70  PRINT:PRINT "SELECT IF: ";:ZS=0:DS="SELECTED ON: "
  16. 75  GOSUB 145:IF AI=59 THEN ZS=ZS+1:PRINT "Sample #";:AR=CSRLIN:AC=POS(0):GOSUB 180:NA(ZS)=VAL(DZ):DS=DS+N$(VAL(DZ)) ELSE IF AI=68 AND ZS=0 THEN DS="":CC=C:FOR Z=1 TO C:CZ(Z)=Z:NEXT:GOTO 190 ELSE BEEP:GOTO 75
  17. 80  GOSUB 145:IF AI<60 OR AI>65 THEN BEEP:GOTO 80 ELSE AO=AI-59:NB(ZS)=AO
  18. 85  IF AO=1 THEN DZ="=" ELSE IF AO=2 THEN DZ=">" ELSE IF AO=3 THEN DZ=">=" ELSE IF AO=4 THEN DZ="<" ELSE IF AO=5 THEN DZ="<=" ELSE IF AO=6 THEN DZ="<>"
  19. 90  PRINT DZ;" ";:DS=DS+" "+DZ+" "
  20. 95  GOSUB 145:IF AI=59 THEN NB(ZS)=NB(ZS)+6:PRINT "Sample #";:AR=CSRLIN:AC=POS(0):GOSUB 180:SA(ZS)=VAL(DZ):DS=DS+N$(VAL(DZ)):GOTO 135 ELSE IF AI<>0 THEN BEEP:GOTO 95
  21. 100  PRINT A$;:DZ=A$:L=1:GOSUB 160:SA(ZS)=VAL(DZ):N=NA(ZS)
  22. 105  ON AO GOTO 110,115,115,120,120,130
  23. 110  IF SA(ZS)<VAL(D(N,CS(N,1))) OR SA(ZS)>VAL(D(N,CS(N,T(N)))) THEN 125 ELSE 130
  24. 115  IF SA(ZS)>VAL(D(N,CS(N,T(N)))) THEN 125 ELSE 130
  25. 120  IF SA(ZS)<VAL(D(N,CS(N,1))) THEN 125 ELSE 130
  26. 125  LOCATE 24,15:PRINT "There are no records satisfying this criterion.";:BEEP:FOR Z=1 TO 5000:NEXT:LOCATE ,15:PRINT TAB(70):LOCATE AR,AC:PRINT "       ":LOCATE AR,AC:GOTO 95
  27. 130  DS=DS+DZ:PRINT " ";
  28. 135  GOSUB 145:IF ZS=10 THEN 190 ELSE IF AI=66 THEN NN(ZS)=2:DZ="AND " ELSE IF AI=67 THEN NN(ZS)=3:DZ="OR " ELSE IF AI=68 THEN 190 ELSE BEEP:GOTO 135
  29. 140  PRINT DZ;:DS=DS+" "+DZ:GOTO 75
  30. 145  AR=CSRLIN:AC=POS(0):L=0:LOCATE ,,1
  31. 150  A$=INKEY$:IF A$="" THEN 150 ELSE AI=0:IF A$=CHR$(13) THEN BEEP:GOTO 150 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1))
  32. 155  RETURN
  33. 160  LOCATE ,,1:A$=INKEY$:IF A$="" THEN 160 ELSE IF A$=CHR$(13) THEN RETURN
  34. 165  IF A$=CHR$(8) THEN IF L>0 THEN L=L-1:PRINT CHR$(29);" ";CHR$(29);:DZ=LEFT$(DZ,L):GOTO 160 ELSE BEEP:GOTO 160
  35. 170  IF A$>"-" AND A$<":" THEN PRINT A$;:DZ=DZ+A$:L=L+1 ELSE BEEP
  36. 175  GOTO 160
  37. 180  DZ="":GOSUB 160:IF VAL(DZ)>0 AND VAL(DZ)<=A THEN PRINT " ";:RETURN
  38. 185  LOCATE 24,25:PRINT FILE$;" has only";A;"samples.";:BEEP:LOCATE 24,20:LOCATE AR,AC:PRINT "    ":LOCATE AR,AC:GOTO 180
  39. 190  PRINT:PRINT:INPUT "Do you want Selected Records written to SCREEN (S),PRINTER (P), or DISK (D)? ",A$
  40. 195  PO$="":IF A$="D" OR A$="d" THEN 215 ELSE IF A$="s" OR A$="S" THEN PO$="SCRN:" ELSE IF A$="p" OR A$="P" THEN PO$="LPT1:" ELSE BEEP:GOTO 190
  41. 200  INPUT " Do you want the records printed in SORTED or in INPUT order? (S or I)  ",A$
  42. 205  IF A$="i" OR A$="I" THEN BSRT=0:GOTO 215 ELSE IF A$="s" OR A$="S" THEN BSRT=1 ELSE BEEP:GOTO 200
  43. 210  IF A>1 THEN PRINT TAB(19);"Which sample number do you wish to SORT by?";:AR=CSRLIN:AC=65:GOSUB 4800:NS=VAL(IP$):IF NS<1 OR NS>A THEN BEEP:GOTO 210
  44. 215  PRINT:PRINT:AR=CSRLIN:IF DS="" THEN 350 ELSE COLOR 23:LOCATE AR,32:PRINT "SELECTING RECORDS";:COLOR CLR1
  45. 220  CC=0:FOR Z=1 TO C:FOR TZ=1 TO ZS:VX=VAL(D(NA(TZ),Z)):VY=SA(TZ)
  46. 225  ON NB(TZ) GOTO 235,240,245,250,255,260,230,230,230,230,230,230
  47. 230  VY=VAL(D(SA(TZ),Z)):ON NB(TZ) GOTO 1,1,1,1,1,1,235,240,245,250,255,260
  48. 235  IF VX=VY THEN 275 ELSE 265
  49. 240  IF VX>VY THEN 275 ELSE 265
  50. 245  IF VX>=VY THEN 275 ELSE 265
  51. 250  IF VX<VY THEN 275 ELSE 265
  52. 255  IF VX<=VY THEN 275 ELSE 265
  53. 260  IF VX<>VY THEN 275 ELSE 265
  54. 265  ON NN(TZ) GOTO 290,270,280
  55. 270  TZ=TZ+1:GOTO 265
  56. 275  IF NN(TZ)<>2 THEN 285
  57. 280  NEXT TZ
  58. 285  CC=CC+1:CZ(CC)=Z
  59. 290  NEXT Z
  60. 295  IF CC=0 THEN BEEP:LOCATE AR,19:PRINT "There are no records meeting these selection criteria.":GOTO 545
  61. 300  FOR T=1 TO A:T(T)=0:X(T)=0:X2(T)=0:MD(T)=0:SD(T)=0:NEXT
  62. 305  FOR TT=1 TO CC:FOR T=1 TO A:DT=D(T,CZ(TT)):D(T,TT)=DT:IF DT="" THEN 330 ELSE VC=VAL(DT)
  63. 310  FOR Z=1 TO T(T):VX=VAL(D(T,CS(T,Z))):IF VX<=VC THEN 320
  64. 315  FOR TZ=T(T)+1 TO Z+1 STEP -1:CS(T,TZ)=CS(T,TZ-1):NEXT:GOTO 325
  65. 320  NEXT Z
  66. 325  CS(T,Z)=TT:T(T)=T(T)+1:X(T)=X(T)+VC:X2(T)=X2(T)+VC*VC
  67. 330  NEXT T:NEXT TT
  68. 335  FOR T=1 TO A:N=T(T):IF N>1 THEN IF X2(T)>X(T)*X(T)/N THEN SD(T)=SQR((X2(T)-X(T)*X(T)/N)/(N-1))
  69. 340  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)))
  70. 345  NEXT
  71. 350  IF PO$="LPT1:" THEN PMAX=PRNT-10 ELSE IF PO$="SCRN:" THEN PMAX=70:FOR T=0 TO INT((A-1)/7):SCREEN ,,T,0:CLS:NEXT:SCREEN ,,0:GOTO 365 ELSE 560
  72. 355  LOCATE AR,23:PRINT "Be sure paper is in printer.":PRINT TAB(24);"Press space bar when ready:":ON ERROR GOTO 5070
  73. 360  A$=INKEY$:IF A$="" THEN 360 ELSE IF A$<>CHR$(32) THEN BEEP:GOTO 360
  74. 365  OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
  75. 370  IF A>1 THEN 425
  76. 375  PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,:PRINT #1,DS
  77. 380  PRINT #1,:PRINT #1,"Sample Name = ";N$(1):PRINT #1,:TB=1:IF BSRT=1 THEN 400
  78. 385  FOR Z=1 TO CC:PRINT #1,USING "###";Z;PRINT #1,":";D(1,Z);
  79. 390  TB=TB+13:IF TB>PMAX THEN TB=1
  80. 395  PRINT #1,TAB(TB);:NEXT:GOTO 415
  81. 400  FOR Z=1 TO CC:PRINT #1,USING "###";CS(1,Z);:PRINT #1,":";D(1,CS(1,Z));
  82. 405  TB=TB+13:IF TB>PMAX THEN TB=1
  83. 410  PRINT #1,TAB(TB);:NEXT
  84. 415  PRINT #1,:PRINT #1,TAB(5);"TOTAL =";T(1);TAB(26);"MEAN =";X(1)/T(1);TAB(55);"MEDIAN =";MD(1)
  85. 420  PRINT #1,:PRINT #1,TAB(20);"STANDARD DEVIATION =";SD(1):PRINT:PRINT:GOTO 545
  86. 425  AR=CSRLIN:FOR AS=0 TO INT((A-1)*10/PMAX):A2=(AS+1)*PMAX/10:IF A2>A THEN A2=A
  87. 430  A1=AS*PMAX/10+1:IF PO$="SCRN:" THEN SCREEN,,AS,AS:LOCATE AR,1
  88. 435  PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,:PRINT #1,DS:PRINT #1,
  89. 440  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);"Sample";T;:NEXT:PRINT #1,
  90. 445  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);N$(T);:NEXT:PRINT #1,:PRINT #1,
  91. 450  IF BSRT=1 THEN 465
  92. 455  FOR Z=1 TO CC:PRINT #1,USING "###";Z;:PRINT #1,":";
  93. 460  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,Z);:NEXT:PRINT #1,:NEXT:GOTO 475
  94. 465  FOR Z=1 TO CC:PRINT #1,USING "###";CS(NS,Z);:PRINT #1,":";
  95. 470  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,CS(NS,Z));:NEXT:PRINT #1,:NEXT
  96. 475  PRINT #1,:PRINT #1,"NO.";:P$="#####"
  97. 480  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;T(T);:NEXT
  98. 485  PRINT #1,:PRINT #1,"MEAN";
  99. 490  FOR T=A1 TO A2:IF T(T)>0 THEN MN=X(T)/T(T) ELSE MN=0
  100. 495  MB=ABS(MN):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MN;:NEXT
  101. 500  PRINT #1,:PRINT #1,"MED";
  102. 505  FOR T=A1 TO A2:MB=ABS(MD(T)):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MD(T);:NEXT
  103. 510  PRINT #1,:PRINT #1,"SDEV";
  104. 515  FOR T=A1 TO A2:MB=SD(T):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;SD(T);:NEXT
  105. 520  PRINT #1,:PRINT:IF A2=A THEN 540
  106. 525  IF PO$="LPT1:" THEN PRINT #1,CHR$(12)
  107. 530  LOCATE 25,12:PRINT TAB(75):LOCATE 25,12:PRINT "Press `P' to print next page, space bar to quit:";
  108. 535  A$=INKEY$:IF A$="" THEN 535 ELSE IF A$="p" OR A$="P" THEN NEXT AS ELSE IF A$<>CHR$(32) THEN BEEP:GOTO 530
  109. 540  CLOSE #1:IF PO$="SCRN:" THEN AR=CSRLIN:LOCATE 25,16:INPUT;"Do you want a hard copy of selected records?  ",A$:IF A$="y" OR A$="Y" THEN PO$="LPT1:":GOTO 355
  110. 545  LOCATE 25,1:PRINT TAB(79):LOCATE 25,16:INPUT;"Do you want to perform another record selection?  ",A$
  111. 550  IF A$="y" OR A$="Y" THEN SCREEN ,,0:GOTO 20
  112. 555  GOTO 3000
  113. 560  C=CC:GOSUB 4100
  114. 565  LOCATE 24,17:PRINT "Selected data has been saved in ";FILE$;:GOTO 545
  115. 570  IF MB>9999 THEN P$="#######.#" ELSE IF MB>99 THEN P$="#####.###" ELSE IF MB>=10 THEN P$="###.#####" ELSE P$="##.######"
  116. 575  RETURN
  117. 4025  ERASE D,CS,T,N$,X,X2,MD,SD,NN,CZ
  118. 4030  DIM D(A,C),CS(A,C),T(A),N$(A),X(A),X2(A),MD(A),SD(A),CZ(C)
  119. 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:"
  120. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  121. 5010  ON ERROR GOTO 0:END
  122.