home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / XTAB.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1994-02-04  |  4.1 KB  |  81 lines
  1. 1  '                          CROSSTABS
  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(3),NN(3),MN(3),MX(3),DR(1),DC(1),DP(1),CX(1)
  6. 22  DATA "CROSSTAB REPORTS",30,18
  7. 30  GOSUB 4000:AR=CSRLIN
  8. 35  LOCATE 24,20:PRINT "Do you want 1,2 or 3-way CROSSTABS?";:AR=24:AC=58:GOSUB 4800:NB=VAL(IP$):IF ABS(NB-2)>1 THEN BEEP:GOTO 35
  9. 40  LOCATE 24,8:INPUT;"Do you want the report printed on SCREEN or PRINTER? (S or P)  ",A$
  10. 45  LOCATE 24,1:PRINT TAB(79):IF A$="s" OR A$="S" THEN PO$="SCRN:":PMAX=80 ELSE IF A$="p" OR A$="P" THEN PO$="LPT1:":PMAX=PRNT-5 ELSE BEEP:GOTO 40
  11. 50  LOCATE 6,28:PRINT FILE$;" has";A;"samples.":PRINT:AR=7
  12. 55  FOR T=1 TO NB:LOCATE AR,22*T-1:PRINT "Sample ";:AC=T*22+6:GOSUB 4200:NS(T)=NS:NEXT
  13. 60  PRINT:PRINT "Sample NAME:";:FOR T=1 TO NB:PRINT TAB(22*T);N$(NS(T));:NEXT
  14. 65  PRINT:PRINT "MINIMUM value:";:FOR T=1 TO NB:MN(T)=VAL(D(NS(T),CS(NS(T),1))):PRINT TAB(22*T);MN(T);:NEXT
  15. 70  PRINT:PRINT "MAXIMUM value:";:FOR T=1 TO NB:NS=NS(T):MX(T)=VAL(D(NS,CS(NS,T(NS)))):PRINT TAB(22*T);MX(T);:NEXT
  16. 75  PRINT:PRINT "Interval WIDTH:";:FOR T=1 TO NB:AR=CSRLIN
  17. 80  AC=T*22:GOSUB 4800:SW(T)=VAL(IP$):IF SW(T)>0 THEN NEXT ELSE BEEP:GOTO 80
  18. 85  RESTORE 90:AR=CSRLIN+1:LOCATE 24,15:PRINT "Do you want to specify";:FOR T=1 TO NB:READ D1,D2:PRINT D1;D2;:NEXT:INPUT;" headings?  ",A$
  19. 90  DATA ""," ROW"," & ","COLUMN"," &"," PAGE"
  20. 95  RESTORE 90:T=1:FOR Z=1 TO 3:NN(Z)=1:NZ(Z)=1:NEXT
  21. 100  LOCATE 24,12:PRINT TAB(75);:IF A$="y" OR A$="Y" THEN 110 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP:GOTO 85
  22. 105  BF=0:FOR T=1 TO NB:GOSUB 115:NEXT:GOTO 185
  23. 110  BF=1:READ D1,D2:LOCATE AR,T*22-3:PRINT D2;" HEADINGS":GOSUB 115:GOTO 135
  24. 115  CW=0:SW=SW(T)
  25. 120  IF ABS(SW)>=10 THEN SW=SW/10:CW=CW+1:GOTO 120
  26. 125  IF ABS(SW)<1 THEN SW=SW*10:CW=CW-1:GOTO 125
  27. 130  IF MN(T)>0 THEN MN(T)=FIX(MN(T)*10^CW)/10^CW
  28. 132  NN(T)=INT((MX(T)-MN(T))/SW(T))+1:VM=MN(T):RETURN
  29. 135  LOCATE ,T*22-7:PRINT MN(T):ON T GOTO 140,145,150
  30. 140  ERASE DR:DIM DR(NN(1)):GOTO 155
  31. 145  ERASE DC:DIM DC(NN(2)):GOTO 155
  32. 150  ERASE DP:DIM DP(NN(3))
  33. 155  FOR Z=1 TO NN(T):LOCATE ,T*22-8:VM=VM+SW(T):PRINT "-";VM-10^CW/100;:LOCATE ,T*22+3
  34. 160  ON T GOTO 165,170,175
  35. 165  INPUT "",DR(Z):GOTO 180
  36. 170  INPUT "",DC(Z):GOTO 180
  37. 175  INPUT "",DP(Z)
  38. 180  NEXT Z:T=T+1:IF T<=NB THEN 110
  39. 185  ERASE CX:DIM CX(NN(3),NN(2),NN(1))
  40. 190  LOCATE 25,28:COLOR 23:PRINT "CALCULATING CROSSTABS";:COLOR CLR1:MS=0
  41. 195  FOR Z=1 TO C:FOR TZ=1 TO NB:NS=NS(TZ):IF D(NS,Z)="" THEN MS=MS+1:GOTO 210 ELSE VX=VAL(D(NS,Z))
  42. 200  NZ(TZ)=INT((VX-MN(TZ))/SW(TZ))+1:NEXT TZ
  43. 205  CX(NZ(3),NZ(2),NZ(1))=CX(NZ(3),NZ(2),NZ(1))+1
  44. 210  NEXT Z
  45. 215  LOCATE 25,23:PRINT "Press space bar when ready to print.";
  46. 220  A$=INKEY$:IF A$<>CHR$(32) THEN 220
  47. 225  BP=0:P$="#####":ON ERROR GOTO 5070:OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
  48. 230  IF PO$="SCRN:" THEN CLS
  49. 235  PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:BB=3:BP=BP+1
  50. 240  PRINT #1,TAB(PMAX/2-4*NB);:PRINT #1,N$(NS(1));:FOR ZZ=2 TO NB:PRINT #1," by ";N$(NS(ZZ));:NEXT ZZ
  51. 245  IF NB<3 THEN PRINT #1,:PRINT #1,:GOTO 255
  52. 250  PRINT #1,TAB(PMAX-25);N$(NS(3));"= ";:IF BF=1 THEN PRINT #1,DP(BP) ELSE T=3:GOSUB 115:PRINT #1,VM+SW(3)*(BP-1);"-";VM+SW(3)*BP-10^CW/100:PRINT #1,
  53. 255  BB=2:TB=PMAX/(NN(2)+3):IF TB>18 THEN TB=18
  54. 260  IF NB=1 THEN TZ=2:GOTO 280 ELSE PRINT #1,TAB(TB+TB*NN(2)/2);N$(NS(2)):PRINT #1,N$(NS(1));
  55. 265  IF BF=1 THEN FOR TZ=1 TO NN(2):PRINT #1,TAB(TB*TZ+5);DC(TZ);:NEXT:GOTO 280
  56. 270  T=2:GOSUB 115:FOR TZ=1 TO NN(2):PRINT #1,TAB(TB*TZ+5);VM;"-";:VM=VM+SW(2):NEXT TZ
  57. 275  PRINT #1,:VM=MN(2)+SW(2)-10^CW/100:FOR TZ=1 TO NN(2):PRINT #1,TAB(TB*TZ+5);VM;:VM=VM+SW(2):NEXT TZ
  58. 280  PRINT #1,TAB(TB*TZ+6);"TOTAL"
  59. 285  IF BF=0 THEN T=1:GOSUB 115
  60. 290  BB=1:FOR Z=1 TO NN(1):RR=0
  61. 295  IF BF=1 THEN PRINT #1,DR(Z); ELSE PRINT #1,VM;"-":PRINT #1,VM+SW(1)-10^CW/100;:VM=VM+SW(1)
  62. 300  FOR TZ=1 TO NN(2):TA=CX(BP,TZ,Z):IF TA>0 THEN RR=RR+TA:IF NB>1 THEN PRINT #1,TAB(TB*TZ+7);TA;
  63. 305  NEXT TZ
  64. 310  PRINT #1,TAB(TB*TZ+7);RR:NEXT Z:RR=0:PRINT #1,:PRINT #1,"TOTAL";
  65. 315  FOR TZ=1 TO NN(2):TA=0:FOR Z=1 TO NN(1):TA=TA+CX(BP,TZ,Z):NEXT Z:RR=RR+TA:IF NB>1 THEN PRINT #1,TAB(TB*TZ+7);TA;
  66. 320  NEXT TZ:PRINT #1,TAB(TB*TZ+7);RR:PRINT #1,
  67. 325  PRINT #1,:PRINT #1,TAB(5);"Missing values: ";MS:IF PO$="LPT1:" THEN PRINT #1,CHR$(12)
  68. 330  IF BP=NN(3) THEN 340 ELSE LOCATE 25,22:PRINT "Press space bar to print next page.     ";
  69. 335  A$=INKEY$:IF A$<>CHR$(32) THEN 335 ELSE 230
  70. 340  CLOSE #1:DQ="Do you want another crosstab report using "
  71. 345  LOCATE 25,10:PRINT DQ;:INPUT;"this DATAFILE?  ",A$
  72. 350  IF A$="y" OR A$="Y" THEN CLS:PRINT TAB(30);"DATAFILE ";FILE$:AR=CSRLIN:GOTO 35 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP:GOTO 345
  73. 355  LOCATE 25,7:PRINT DQ;:INPUT;"a different DATAFILE? ",A$
  74. 360  IF A$="y" OR A$="Y" THEN 20 ELSE IF A$<>"n" AND A$<>"N" THEN BEEP:GOTO 355
  75. 365  GOTO 3000
  76. 4025  ERASE D,CS,T,N$,X,X2,MD,SD
  77. 4030  DIM D(A,C),CS(A,C),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
  78. 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:"
  79. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  80. 5010  ON ERROR GOTO 0:END
  81.