home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / table.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-03-06  |  9.0 KB  |  159 lines
  1. 1  '           TABULATION  ---  TABLE.BAS  ---  by  Dr Russell Langley
  2. 2  GOTO 400
  3. 4  '<UNK! {000A}>--- Press Enter ---
  4. 5  IF PR THEN RETURN ELSE PRINT TAB(40);:PRINT "Press <Enter> to continue.";:IN$=INKEY$:WHILE INKEY$<>CHR$(13):WEND:LOCATE,40:PRINT SPACE$(26):RETURN
  5. 6  PRINT TAB(14);:PRINT "Press <Enter> to continue, or `/' to end viewing.";:IN$=INKEY$:WHILE IN$<>CHR$(13) AND IN$<>"/":IN$=INKEY$:WEND:LOCATE ,14:PRINT SPACE$(50):IF IN$="/" THEN I=N:PR=1:RETURN ELSE RETURN
  6. 7  '<UNK! {000A}>*** Redirect to Block ***
  7. 9  ON QB GOTO 400,177,500,30 '=start,printout,menu,quit.<UNK! {000A}>*** Finish up ***
  8. 10  CLOSE:IF HD$="" THEN LPRINT STRING$(79,61)STRING$(4,10)
  9. 11  GOTO 30
  10. 19  '<UNK! {000A}>--- Yes/No? ---
  11. 20  PRINT:PRINT"Do you want to "+DO$;
  12. 21  INPUT" (Y/N)";Z$:IF Z$="" THEN Z$="N":RETURN ELSE Z$=CHR$(ASC(Z$) AND 95):IF Z$="Y" OR Z$="N" THEN RETURN ELSE PRINT"WHAT?  ";:GOTO 21
  13. 29  '<UNK! {000A}>--- Errors & End ---
  14. 30  IF ERR THEN BEEP ELSE RUN"MENU"
  15. 32  IF ERR=71 THEN INPUT"That drive is empty or its gate is open.  Fix, then press <Enter>.";Z$:RESUME
  16. 39  ON ERROR GOTO 0:END'<UNK! {000A}><UNK! {000A}>*** Messages ***
  17. 46  ZZ$=STRING$(37-LEN(Z$)\2,177):LOCATE 1,1:PRINT ZZ$"  ";:COLOR 15,0:PRINT Z$;:COLOR 7,0:PRINT"  "ZZ$:RETURN 'Display brightened Z$ at top of screen
  18. 109  '<UNK! {000A}>*** Get Filespec ***
  19. 111  LINE INPUT "Filename (I will add .ASC extension)? ";FL$:IF FL$="" THEN 111 ELSE IF MID$(FL$,2,1)=":" THEN DR$=LEFT$(FL$,1):FL$=MID$(FL$,3)
  20. 112  ER=0:FOR I=1 TO LEN(FL$):Z$=MID$(FL$,I,1):IF INSTR(" .,/\|?*:;[]+="+CHR$(34),Z$) THEN ER=1
  21. 113  NEXT I
  22. 114  IF ER=0 AND FL$>"" AND LEN(FL$)<9 THEN FL$=FL$+".ASC" ELSE BEEP:PRINT "Invalid filename.  Will you try again";:GOSUB 21:IF Z$="Y" THEN 111 ELSE 2
  23. 115  INPUT "Which drive (A,B,C,D)";DR$:IF DR$="" THEN 115
  24. 116  DR$=CHR$(ASC(DR$) AND 95):IF INSTR("ABCD",DR$)=0 THEN 115
  25. 117  INPUT "Which directory (e.g. WORK, MYDATA, or Null Entry if root) ";DR2$:IF DR2$="" THEN DR$=DR$+":" ELSE DR$=DR$+":\"+DR2$+"\"
  26. 129  '<UNK! {000A}>*** Open File if poss ***
  27. 134  ON ERROR GOTO 136:OPEN DR$+FL$ FOR INPUT AS #1
  28. 135  ON ERROR GOTO 30:CLOSE:RETURN 'it exists
  29. 136  PRINT FL$" not found on Drive "DR$:RESUME 137
  30. 137  GOSUB 5:ON ERROR GOTO 30:CLS:SHELL "DIR "+DR$+"/W":GOSUB 5:GOTO 111
  31. 159  '<UNK! {000A}>--- Show/Print Answers ---
  32. 160  QB=3:PR=0:CLOSE:OPEN "SCRN:" FOR OUTPUT AS #2:RETURN
  33. 161  DO$="print these results":GOSUB 20:IF Z$="N" THEN PR=0:RETURN
  34. 162  PR=1:IF ID$="" THEN LINE INPUT "Problem ID? ";ID$:GOTO 164
  35. 163  LINE INPUT"Problem ID (null = unchanged)? ";Z$:IF Z$>"" THEN ID$=Z$
  36. 164  RETURN
  37. 165  QB=2:CLS:LOCATE 8,1
  38. 166  PRINT TAB(12)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  39. 167  PRINT TAB(12)"OPEN                                                       OPEN"
  40. 168  PRINT TAB(12)"OPEN                TURN  PRINTER  ON.                     OPEN"
  41. 169  PRINT TAB(12)"OPEN                                                       OPEN"
  42. 170  PRINT TAB(12)"OPEN    Then PRESS <ENTER> to start printing ..... or ..   OPEN"
  43. 171  PRINT TAB(12)"OPEN                                                       OPEN"
  44. 172  PRINT TAB(12)"OPEN    To send Printer Codes in Basic before printing,    OPEN"
  45. 173  PRINT TAB(12)"OPEN    press <Ctrl-Break>, & start printing by GOTO 9.    OPEN"
  46. 174  PRINT TAB(12)"OPEN                                                       OPEN"
  47. 175  PRINT TAB(12)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":IN$=INKEY$
  48. 176  IN$=INKEY$:IF IN$<>CHR$(13) THEN 176
  49. 177  CLS:PRINT"Printing .....":LOCATE 4,1:CLOSE:OPEN "LPT1:" FOR OUTPUT AS #2
  50. 178  IF HD$>"" THEN PRINT #2,STRING$(79,61):PRINT #2,DAT$;TAB(42-LEN(HD$)\2);HD$;TAB(73)VER$:PRINT #2,STRING$(79,61):HD$=""
  51. 179  PRINT #2,CHR$(10)"Problem: "ID$;CHR$(10)
  52. 180  RETURN
  53. 193  PR=0:PRINT #2,:CLOSE:RETURN
  54. 339  '<UNK! {000A}>--- Date ---
  55. 340  DAT$=MID$(DATE$,4,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",-2+3*VAL(LEFT$(DATE$,2)),3)+" "+RIGHT$(DATE$,4):RETURN
  56. 399  '<UNK! {000A}>--- Start ---
  57. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  58. 401  HD$="  TABULATING  QUESTIONNAIRE  DATA  ":VER$="(RL,2)"
  59. 402  QB=4:CLOSE:CLS:GOSUB 340:PRINT DAT$;TAB(40-LEN(HD$)\2);:COLOR 0,7:PRINT HD$;:COLOR 7,0:PRINT TAB(73)VER$:LOCATE 4,1
  60. 403  READ Z$:IF Z$="<end>" THEN K=12 ELSE 421
  61. 404  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  62. 405  PRINT TAB(K)"OPEN                                                       OPEN"
  63. 406  PRINT TAB(K)"OPEN   This program tallies questionnaire responses into   OPEN"
  64. 407  PRINT TAB(K)"OPEN     1-way frequency &/or 2-way contingency tables.    OPEN"
  65. 408  PRINT TAB(K)"OPEN                                                       OPEN"
  66. 409  PRINT TAB(K)"OPEN        The questionnaire data will only be read       OPEN"
  67. 410  PRINT TAB(K)"OPEN             from a special kind of datafile.          OPEN"
  68. 411  PRINT TAB(K)"OPEN                                                       OPEN"
  69. 412  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  70. 413  PRINT TAB(K)"OPEN                                                       OPEN"
  71. 414  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE 17,1,1
  72. 415  INPUT"Do you want Instructions, or to Merge a datafile (I or M)";Z$:IF Z$>"" THEN Z$=CHR$(ASC(Z$) AND 95):IF Z$="I" THEN RUN"TABDOC.BAS" ELSE IF Z$="M" THEN 418
  73. 416  GOTO 415
  74. 417  '<UNK! {000A}>--- Get filespec & Merge ---
  75. 418  QB=1:PRINT:GOSUB 111
  76. 419  PRINT:PRINT"Ok, merging......    When `Ok' appears, enter `RUN'.":MERGE DR$+FL$
  77. 420  '<UNK! {000A}>--- Restart with Datafile ---
  78. 421  DEFINT A-Z:MAX=20000
  79. 422  INPUT"Allow for how many persons";MP:INPUT"<UNK! {000A}>Allow for how many questions";MQ:IF MP*MQ>MAX THEN PRINT"Sorry, but that exceeds present capacity of"MAX"responses.":PRINT:GOTO 422
  80. 423  DIM I,J,K,M,N,Q,CK,NQ,ROW,COL,A(MP,MQ),F(10,10),ID$(MP),LAB$(MQ),NO(MQ),HD$(11)
  81. 424  S$=" ":EN$="END":LAB$="LABELS":F$=" ### ":TANS$="Tallying Answers of Person #":MM$="   Return to Main Menu.<UNK! {000A}>":ER$=CHR$(10)+"=====> ERROR."
  82. 425  FOR I=1 TO 9:HD$(I)=" ("+MID$(STR$(I),2)+") ":NEXT I:HD$(10)="NoAns":HD$(11)=" Sums"
  83. 426  PRINT"<UNK! {000A}>Choose type of tabulation:<UNK! {000A}>"TAB(12)"1   1-way frequency table.<UNK! {000A}>"TAB(12)"2   Both 1-way &/or 2-way tables."
  84. 427  INPUT "Which (1 or 2)";KIND:IF KIND<1 OR KIND>2 THEN 427
  85. 428  '<UNK! {000A}>--- Read Data ---
  86. 429  RESTORE:I=0:N=0
  87. 430  I=I+1:READ ID$(I):IF ID$(I)=EN$ THEN 439 ELSE IF ID$(I)=LAB$ THEN 440
  88. 431  LOCATE 16,1:PRINT"Reading Data of Person #"I:READ Z$:IF Z$="" THEN 441 ELSE Q=0:CK=0
  89. 432  FOR J=1 TO LEN(Z$):IF MID$(Z$,J,1)=S$ THEN 434 ELSE Q=Q+1:IF Q>MQ THEN 438 ELSE Q$=MID$(Z$,J,1):IF INSTR("0123456789",Q$)=0 THEN 437
  90. 433  A(I,Q)=VAL(Q$):IF I>1 THEN CK=CK+1
  91. 434  NEXT J:IF I=1 THEN NQ=Q ELSE IF CK<>NQ THEN 441
  92. 435  IF I<MP THEN 430 ELSE N=MP:READ Z$:IF Z$=EN$ THEN 439 ELSE IF Z$=LAB$ THEN 440 ELSE 442
  93. 436  '<UNK! {000A}>--- Checks & N ---
  94. 437  PRINT ER$:PRINT"Row"I"of datafile contains an invalid character.":GOTO 443
  95. 438  PRINT ER$:PRINT"Person #"I"has more than"MQ"questions!":GOTO 443
  96. 439  IF KIND=2 THEN PRINT ER$:PRINT"`LABELS' missing and needed for 2-way tables.":GOTO 443
  97. 440  N=-(N=0)*(I-1)-(N=MP)*MP:IF KIND=1 THEN 500 ELSE 445
  98. 441  PRINT ER$:PRINT"Number of answers from Person #"I"differs from Person #1.":GOTO 443
  99. 442  PRINT"Data statement with `END' or `LABELS' not found after"MP"persons."
  100. 443  PRINT"Please correct this by editing & re-saving your datafile!":END
  101. 444  '<UNK! {000A}>--- Read Labels ---
  102. 445  FOR J=1 TO NQ:LOCATE 18,1:PRINT"Reading Label #"J:READ LAB$(J):IF LAB$(J)=EN$ THEN 450 ELSE IF LAB$(J)="" THEN 448
  103. 446  READ NO(J):IF NO(J)>1 AND NO(J)<10 THEN NEXT J:READ Z$:IF Z$=EN$ THEN 500 ELSE 449
  104. 447  PRINT"Question"J"has "NO(J)" options.  It MUST have 2 to 9 options.":GOTO 443
  105. 448  PRINT"Question"J"has NO LABEL!":GOTO 443
  106. 449  PRINT ER$:PRINT"Too many entries in LABEL list!":GOTO 443
  107. 450  PRINT ER$:PRINT"Not enough entries in LABEL list!":GOTO 443
  108. 499  '<UNK! {000A}>--- Menu ---
  109. 500  QB=3:PR=0:CLOSE:CLS:PRINT TAB(30)"M E N U<UNK! {000A}>"TAB(29)STRING$(9,45)"<UNK! {000A}>"
  110. 501  PRINT"<UNK! {000A}>"TAB(26)"1   Show Data<UNK! {000A}>"TAB(26)"2   Print Data<UNK! {000A}>"TAB(26)"3   Tally & Show 1-Way Table";
  111. 502  IF KIND=1 THEN PRINT"<UNK! {000A}>"TAB(26)"4"MM$:M=4 ELSE PRINT"<UNK! {000A}>"TAB(26)"4   Show Labels<UNK! {000A}>"TAB(26)"5   Print Labels<UNK! {000A}>"TAB(26)"6   Tally & Show 2-Way Tables<UNK! {000A}>"TAB(26)"7"MM$:M=7
  112. 503  PRINT TAB(19)"---->  Which (1-"MID$(STR$(M),2)") ";:INPUT OP$:OP=VAL(OP$):IF OP<1 OR OP>M THEN BEEP:GOTO 503
  113. 504  ON OP GOTO 506,512,600:IF KIND=1 AND OP=4 THEN 10 ELSE ON OP-3 GOTO 610,614,700,10
  114. 505  '<UNK! {000A}>--- Show/Print Data ---
  115. 506  CLS:GOSUB 160:IF NQ<51 THEN SHO=20 ELSE SHO=10
  116. 507  PRINT #2,"Data read was:<UNK! {000A}>  #     ID     Answers (in blocks of 5)"
  117. 508  FOR I=1 TO N:PRINT #2,USING"### \        \ ";I;ID$(I);
  118. 509  FOR J=1 TO NQ:PRINT #2,MID$(STR$(A(I,J)),2);:IF J MOD 5=0 THEN PRINT #2,S$;
  119. 510  NEXT J:PRINT #2,:IF PR=0 THEN IF I MOD SHO=0 THEN IF I<N THEN GOSUB 6
  120. 511  NEXT I:GOSUB 5:GOSUB 193:GOTO 500
  121. 512  PRINT:GOSUB 162:GOSUB 165:SHO=1:GOTO 507
  122. 599  '<UNK! {000A}>--- 1-Way Tables ---
  123. 600  CLS:ERASE F:DIM F(NQ,10):PRINT TANS$;:FOR I=1 TO N:LOCATE 1,29:PRINT I:FOR J=1 TO NQ:K=A(I,J):IF K=0 THEN K=10
  124. 601  F(J,K)=F(J,K)+1:NEXT J:NEXT I:CLS:GOSUB 160
  125. 602  PRINT #2,"1-WAY FREQUENCY TABLE & Row Percentages based on"N"Persons."
  126. 603  PRINT #2,:PRINT #2,"Question. ";:FOR K=1 TO 9:PRINT #2," Ans"MID$(STR$(K),2);:NEXT K:PRINT #2," Null":PRINT #2,STRING$(64,45)
  127. 604  SHO=10:FOR I=1 TO NQ:PRINT #2,USING"  ###     ";I;:FOR K=1 TO 10:PRINT #2,USING F$;F(I,K);:NEXT K:PRINT #2,
  128. 605  PRINT #2,SPACE$(10);:FOR K=1 TO 10:PRINT #2,USING" ###%";F(I,K)*100/N;:NEXT K:PRINT #2,:IF I MOD SHO=0 THEN IF I<NQ THEN GOSUB 5
  129. 606  NEXT I
  130. 607  IF PR THEN GOSUB 193 ELSE GOSUB 161:IF PR THEN GOSUB 165:GOTO 602
  131. 608  GOTO 500
  132. 609  '<UNK! {000A}>--- Show/Print Labels ---
  133. 610  CLS:GOSUB 160:SHO=20
  134. 611  PRINT #2,"Question #       Label         # of Options"
  135. 612  FOR I=1 TO NQ:PRINT #2,USING"   ##            \        \          #";I;LAB$(I);NO(I):IF I MOD SHO=0 THEN IF I<NQ THEN GOSUB 5
  136. 613  NEXT I:GOSUB 5:GOSUB 193:GOTO 500
  137. 614  PRINT:GOSUB 162:GOSUB 165:SHO=1:GOTO 611
  138. 699  '<UNK! {000A}>--- 2-Way Tables ---
  139. 700  ERASE F:DIM F(10,10)
  140. 701  INPUT "Enter (in Free Format) a pair of question numbers to be cross-tabulated,<UNK! {000A}>or Null Entry to regain Menu";Z$
  141. 702  IF Z$="" THEN 500 ELSE IF LEN(Z$)<3 THEN PRINT"No, try again.":GOTO 701
  142. 703  FOR I=2 TO LEN(Z$):IF MID$(Z$,I,1)=S$ THEN ROW=VAL(LEFT$(Z$,I)):COL=VAL(MID$(Z$,I)):I=99
  143. 704  NEXT I:IF I=100 THEN IF ROW<1 OR ROW>NQ OR COL<1 OR COL>NQ THEN Z$=S$:GOTO 702
  144. 705  FOR I=1 TO NO(ROW):FOR K=1 TO NO(COL):F(I,K)=0:NEXT K:F(I,10)=0:RT(I)=0:NEXT I
  145. 706  FOR K=1 TO NO(COL):F(10,K)=0:CT(K)=0:NEXT K:F(10,10)=0:RT(10)=0:CT(10)=0:TOT=0
  146. 707  CLS:PRINT TANS$;:FOR I=1 TO N:LOCATE 1,29:PRINT I;:IF A(I,ROW)>NO(ROW) OR A(I,COL)>NO(COL) THEN 711
  147. 708  IF A(I,ROW) THEN J=A(I,ROW) ELSE J=10
  148. 709  IF A(I,COL) THEN K=A(I,COL) ELSE K=10
  149. 710  F(J,K)=F(J,K)+1:RT(J)=RT(J)+1:CT(K)=CT(K)+1:TOT=TOT+1
  150. 711  NEXT I:CLS:GOSUB 160
  151. 712  PRINT #2,TAB(13)"2-WAY FREQUENCY TABLE<UNK! {000A}>"TAB(18)LAB$(COL):PRINT #2,USING"\        \ ";LAB$(ROW);:FOR K=1 TO NO(COL):PRINT #2,HD$(K);:NEXT K:PRINT #2,HD$(10)HD$(11);:IF NO(COL)<9 OR PR=1 THEN PRINT #2,
  152. 713  FOR J=1 TO NO(ROW)+1:IF J>NO(ROW) THEN J=10
  153. 714  PRINT #2,TAB(7)HD$(J);:FOR K=1 TO NO(COL)+1:IF K>NO(COL)THEN K=10
  154. 715  PRINT #2,USING F$;F(J,K);:NEXT K:PRINT #2,USING F$;RT(J):NEXT J
  155. 716  PRINT #2,TAB(7)HD$(11);:FOR K=1 TO NO(COL):PRINT #2,USING F$;CT(K);:NEXT K:PRINT #2,USING F$+F$;CT(10);TOT
  156. 717  IF PR THEN GOSUB 193 ELSE GOSUB 161:IF PR THEN GOSUB 165:GOTO 712
  157. 718  INPUT"<UNK! {000A}>Enter another pair of question numbers (Null = No More)";Z$:GOTO 702
  158. 1000  DATA <end>
  159.