home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / anovk.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-03-06  |  18.6 KB  |  195 lines
  1. 1  '         ANOVA by RANKS  ---  ANOVK.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:RETURN ELSE RETURN
  6. 7  '<UNK! {000A}>*** Redirect to Block ***
  7. 8  QD=1:GOTO 523
  8. 9  ON QB GOTO 404,177,8,624:STOP  '=start,printout,K-W,Fried.<UNK! {000A}><UNK! {000A}>--- Another go? ---
  9. 10  CLOSE:IF HD$="" THEN LPRINT STRING$(79,61)STRING$(4,10)
  10. 11  GOTO 400
  11. 19  '<UNK! {000A}>--- Yes/No? ---
  12. 20  PRINT:PRINT"Do you want to "+DO$;
  13. 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
  14. 29  '<UNK! {000A}>--- Errors & End ---
  15. 30  IF ERR THEN BEEP ELSE RUN"MENU"
  16. 31  IF ERR=70 THEN INPUT"Can't write to that disk.  Remove its Write-Protect tab, then press <Enter>.";Z$:RESUME
  17. 32  IF ERR=71 THEN INPUT"That drive is empty or its gate is open.  Fix, then press <Enter>.";Z$:RESUME
  18. 33  IF ERR=210 THEN RESUME 9  'from #86
  19. 39  ON ERROR GOTO 0:END'<UNK! {000A}><UNK! {000A}>*** Messages ***
  20. 40  BEEP:PRINT "---> Sorry, that entry is illegal.":RETURN
  21. 43  PRINT:PRINT"Working ";:RETURN
  22. 44  LOCATE,1:PRINT"Ok, done.";:GOTO 5
  23. 45  BEEP:PRINT"Error.  Each sample must have at least 2 measurements!":PRINT:RETURN
  24. 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
  25. 49  '<UNK! {000A}>*** Vetted Decoding of FF X(I,J) from X$ ***<UNK! {000A}>    Needs I, M, Q(0) from #96 or #256, & UT>0 if UT matrix.<UNK! {000A}>    Signal neg entries by NEG=1 since #351 needs pos values.
  26. 50  K=1:L=M
  27. 51  KX=0:FOR J=K TO L:Y$=SPACE$(10):KY=0
  28. 52  KX=KX+1:IF KX>LEN(X$) THEN IF J=L THEN 54 ELSE 57
  29. 53  Z$=MID$(X$,KX,1):IF INSTR("-.0123456789",Z$) THEN KY=KY+1:MID$(Y$,KY,1)=Z$:GOTO 52 ELSE IF Z$<>" " THEN 58 ELSE IF KY=0 THEN 52
  30. 54  IF Q(0) THEN Q(J)=VAL(Y$) ELSE X(I,J)=VAL(Y$):IF X(I,J)<0 THEN NEG=1
  31. 55  NEXT J:IF KX>=LEN(X$) THEN 60
  32. 56  PLAY"L8O3CO2C":PRINT"Only the first"L"values have been read in that line.  Re-do it";:GOSUB 21:IF Z$="Y" THEN 59 ELSE 60
  33. 57  PLAY"L32O4CEG>C":PRINT"Not enough values in the line above.  Please re-do whole line.":GOTO 59
  34. 58  PLAY"L16O3CEL4>B":PRINT"That line contains a `non-numeric' entry.  Please re-do whole line."
  35. 59  PRINT"Row"STR$(I-KN(Q-1));:INPUT X$:IF RIGHT$(X$,1)<>"/" THEN 51 ELSE X$=LEFT$(X$,LEN(X$)-1):N=I+(X$=""):IF X$>"" THEN 51
  36. 60  RETURN
  37. 69  '<UNK! {000A}>--- K/b Input of all X(I,J) in FF ---<UNK! {000A}>    Needs first I, M, Q>0 (sample #), KN(Q), & if UT matrix UT>0.  Returns N.
  38. 70  PRINT"Enter data from keyboard, ";:IF M=1 THEN PRINT "pressing <Enter> after each number.":GOTO 72
  39. 71  PRINT"in Free Format, pressing <Enter> at end of each row.":IF UT THEN 73
  40. 72  PRINT"Null entry duplicates previous row.  Signal `end-of-data' by entering a `/'"
  41. 73  PRINT "Row"STR$(I-KN(Q-1));:INPUT X$:IF X$=""THEN IF I>1 THEN FOR J=1 TO M:X(I,J)=X(I-1,J):NEXT J:I=I+1:LOCATE CSRLIN-1,POS(0)+9:PRINT"Ditto":GOTO 73
  42. 74  IF RIGHT$(X$,1)="/" THEN X$=LEFT$(X$,LEN(X$)-1):N=I+(X$=""):IF X$="" THEN 76
  43. 75  GOSUB 50:IF N=0 THEN IF I<MXR THEN I=I+1:GOTO 73 ELSE N=MXR
  44. 76  RETURN
  45. 79  '<UNK! {000A}>--- Disk Input of X(I,J), N, M, etc ---<UNK! {000A}>    Needs MNR, MNC, & NEEDVARS.  Also ZZ$="UTOK" if UT is acceptable.
  46. 80  QD=1:IO$="I":GOSUB 110:CLS:PRINT "Loading data from disk.":INPUT #1,FL$,VR$
  47. 81  IF LEFT$(VR$,4)<>"(RL," THEN BEEP:PRINT "Unreadable file --- not made by our Data Filer/Editor program.":GOTO 86
  48. 82  INPUT #1,DT$,ID$,N,M,UT,VN$:PRINT "Filename: "FL$,"Made: "DT$,"Version: "VR$:PRINT"ID: "ID$:PRINT
  49. 83  IF UT>0 AND ZZ$<>"UTOK" THEN PRINT "This file is an upper triangular matrix, which this program can't use!":GOTO 86
  50. 84  PRINT"File has"N"rows of data. ";:IF N<MNR THEN PRINT "--- Not enough!":GOTO 86 ELSE IF N>MXR THEN PRINT"--- Too many!":GOTO 86
  51. 85  PRINT:PRINT"File has"M"column variables. ";:IF M<MNC THEN PRINT "--- Not enough!" ELSE IF M>MXC THEN PRINT"Too many!" ELSE 88
  52. 86  CLOSE:BEEP:GOSUB 5:ERROR 210
  53. 87  '   Select variables
  54. 88  PRINT:IF VN$="N" THEN PRINT "The"M"variables are not named.":GOTO 90
  55. 89  PRINT "Variables in file are:":FOR J=1 TO M:INPUT #1,VN$(J):PRINT J;VN$(J),:NEXT J:PRINT
  56. 90  IF M=MNC OR UT>0 THEN 100 ELSE PRINT
  57. 91  IF NEEDVARS=0 THEN PRINT"How many filed column variables are to be IGNORED (0-"MID$(STR$(M-MNC),2)")";:INPUT ND:IF ND<0 OR ND>M-MNC THEN 91 ELSE IF ND=0 THEN 100
  58. 92  IF NEEDVARS=1 THEN PRINT"This test analyses only 1 column variable at a time.":ND=M-1
  59. 93  IF NEEDVARS=2 THEN PRINT"This test analyses only 2 column variables.":ND=M-2
  60. 94  IF ND=1 THEN PRINT "Number of the variable to be IGNORED (1-"MID$(STR$(M),2)")";:INPUT X$:Q(1)=VAL(X$):IF Q(1)<1 OR Q(1)>M THEN GOSUB 40:GOTO 94 ELSE 97
  61. 95  PRINT MID$(STR$(ND),2)" numbers of variables to be IGNORED (in ascending order & Free Format):":INPUT X$:IF VAL(X$)<1 THEN GOSUB 40:GOTO 95
  62. 96  Q(0)=1:MM=M:M=ND:GOSUB 50:Q(0)=0:M=MM
  63. 97  KK=1:L=1:FOR J=1 TO M:IF J=Q(KK) THEN KK=KK+1 ELSE VN$(L)=VN$(J):L=L+1
  64. 98  NEXT J
  65. 99  '   Now read numerical data from disk
  66. 100  PRINT:COLOR 23,0:PRINT"Loading numbers";:COLOR 7,0:FOR I=1 TO N:KK=1:LL=1:L=M
  67. 101  FOR J=1 TO L:INPUT #1,Z
  68. 102  IF J=Q(KK) THEN KK=KK+1 ELSE X(I,LL)=Z:LL=LL+1
  69. 103  NEXT J:NEXT I:CLOSE:LOCATE,1:PRINT SPACE$(15):M=M-ND:RETURN
  70. 109  '<UNK! {000A}>--- Get Filespec ---
  71. 110  IF IO$="O" AND FL$>"" THEN PRINT "Will you file this data under the name "FL$;:GOSUB 21:IF Z$="Y" THEN 115
  72. 111  LINE INPUT "Filename (I will add .DAT extension)? ";FL$:IF FL$="" THEN 111 ELSE IF MID$(FL$,2,1)=":" THEN DR$=LEFT$(FL$,1):FL$=MID$(FL$,3)
  73. 112  ER=0:FOR I=1 TO LEN(FL$):Z$=MID$(FL$,I,1):IF INSTR(" .,/\|?*:;[]+="+CHR$(34),Z$) THEN ER=1
  74. 113  NEXT I
  75. 114  IF ER=0 AND FL$>"" AND LEN(FL$)<9 THEN FL$=FL$+".DAT" ELSE BEEP:PRINT "Invalid filename.  Will you try again";:GOSUB 21:IF Z$="Y" THEN 111 ELSE 2
  76. 115  INPUT "Which drive (A,B,C,D)";DR$:IF DR$="" THEN 115
  77. 116  DR$=CHR$(ASC(DR$) AND 95):IF INSTR("ABCD",DR$)=0 THEN 115
  78. 117  INPUT "Which directory (e.g. WORK, MYDATA, or Null Entry if root) ";DR2$:IF DR2$="" THEN DR$=DR$+":" ELSE DR$=DR$+":\"+DR2$+"\"
  79. 129  '<UNK! {000A}>*** Open File, IO$= "I" ***
  80. 130  IF IO$="O" THEN STOP
  81. 131  '
  82. 132  '
  83. 133  '
  84. 134  ON ERROR GOTO 136:OPEN DR$+FL$ FOR INPUT AS #1  'for input
  85. 135  ON ERROR GOTO 30:RETURN   'input #1,A$,B$:close
  86. 136  PRINT FL$" not found on Drive "DR$:RESUME 137
  87. 137  GOSUB 5:ON ERROR GOTO 30:CLS:ERASE X:SHELL "DIR "+DR$+"/W":GOSUB 5:DIM X(MXR,MXC):GOTO 110 ' or replace MXC ....
  88. 159  '<UNK! {000A}>--- Show/Print Answers ---
  89. 160  PR=0:CLOSE:OPEN "SCRN:" FOR OUTPUT AS #2:RETURN
  90. 161  DO$="print these results":GOSUB 20:IF Z$="N" THEN PR=0:RETURN
  91. 162  PR=1:IF ID$="" THEN LINE INPUT "Problem ID? ";ID$:GOTO 164
  92. 163  LINE INPUT"Problem ID (null = unchanged)? ";Z$:IF Z$>"" THEN ID$=Z$
  93. 164  RETURN
  94. 165  QB=2:CLS:LOCATE 8,1
  95. 166  PRINT TAB(12)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  96. 167  PRINT TAB(12)"OPEN                                                       OPEN"
  97. 168  PRINT TAB(12)"OPEN                TURN  PRINTER  ON.                     OPEN"
  98. 169  PRINT TAB(12)"OPEN                                                       OPEN"
  99. 170  PRINT TAB(12)"OPEN    Then PRESS <ENTER> to start printing ..... or ..   OPEN"
  100. 171  PRINT TAB(12)"OPEN                                                       OPEN"
  101. 172  PRINT TAB(12)"OPEN    To send Printer Codes in Basic before printing,    OPEN"
  102. 173  PRINT TAB(12)"OPEN    press <Ctrl-Break>, & start printing by GOTO 9.    OPEN"
  103. 174  PRINT TAB(12)"OPEN                                                       OPEN"
  104. 175  PRINT TAB(12)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":IN$=INKEY$
  105. 176  IN$=INKEY$:IF IN$<>CHR$(13) THEN 176
  106. 177  CLS:PRINT"Printing .....":LOCATE 4,1:CLOSE:OPEN "LPT1:" FOR OUTPUT AS #2
  107. 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$=""
  108. 179  PRINT #2,CHR$(10)"Problem: "ID$;CHR$(10)
  109. 180  RETURN
  110. 189  '<UNK! {000A}>*** Print Data ***<UNK! {000A}>   Needs X( , ) & NEEDVARS=1, NS,N( ),KN( ,1) else J,K,VN$( ).
  111. 190  DO$="print all the data used":GOSUB 20:IF Z$="N" THEN 193
  112. 191  PRINT #2,STRING$(2,10)"DATA USED: ":IF NEEDVARS=1 THEN FOR J=1 TO NS:PRINT #2,"Sample "CHR$(J+64)":":FOR I=1 TO N(J):PRINT #2,X(I+KN(J-1),1)+CONST;:NEXT I:PRINT #2,:NEXT J
  113. 192  '
  114. 193  PR=0:PRINT #2,:CLOSE:RETURN
  115. 199  '<UNK! {000A}>--- Show a Row of Data ---
  116. 200  PRINT"Row"STR$(I)": ";:FOR J=1 TO M:PRINT X(I,J);:NEXT J:PRINT:RETURN
  117. 279  '<UNK! {000A}>--- Rank & Tie Corr Sub ---<UNK! {000A}>    Ranks input X(II,Q), II=1 to NN, Q= a constant (e.g. 0).<UNK! {000A}>    Returns ranks in RK(II), ave ranks if tied, & usually tie correction (TC).<UNK! {000A}>    Alters II, JJ, LK(II), SM, EQ, AR!, & KT.
  118. 280  ERASE RK,LK:DIM RK(NN),LK(NN):FOR II=1 TO NN:IF RK(II)>0 THEN 284 ELSE SM=0:EQ=0:FOR JJ=1 TO NN:IF X(JJ,Q)<X(II,Q) THEN SM=SM+1 ELSE IF X(JJ,Q)=X(II,Q) THEN EQ=EQ+1:RK(JJ)=-1
  119. 281  NEXT JJ:IF EQ<2 THEN RK(II)=SM+1:GOTO 284
  120. 282  AR!=SM+(EQ+1)/2:FOR JJ=II TO NN:IF RK(JJ)=-1 THEN RK(JJ)=AR!
  121. 283  NEXT JJ
  122. 284  NEXT II:IF NO.TC THEN RETURN
  123. 285  '  Tie Correction
  124. 286  TC=0:FOR II=1 TO NN-1:IF LK(II) THEN 288 ELSE KT=1:FOR JJ=II+1 TO NN:IF ABS(RK(II)-RK(JJ))<0.1 THEN KT=KT+1:LK(JJ)=1
  125. 287  NEXT JJ:IF KT>1 THEN TC=TC+KT*KT*KT-KT
  126. 288  NEXT II:RETURN  'can have "TC=TC/12" before RETURN.
  127. 339  '<UNK! {000A}>--- Date ---
  128. 340  DAT$=MID$(DATE$,4,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",-2+3*VAL(LEFT$(DATE$,2)),3)+" "+RIGHT$(DATE$,4):RETURN
  129. 349  '<UNK! {000A}>--- Number Sorter ---<UNK! {000A}>Convert numbers to sortable strings, then sort string array by:<UNK! {000A}>      DEF SEG: STRSORT=VARPTR(STRSORT%(0)):CALL STRSORT(n,x$(0))<UNK! {000A}>where n = no. of elements, & x$(0) = 1st element of string array (J. Dorner).
  130. 350  PRINT:INPUT"Maximum number of decimal places in your data (0-5)";NDP:IF NDP<0 OR NDP>5 THEN 350 ELSE I=NDP-(NDP>0)+(NDP=5):DP#=10^I    'DP enhanced if NDP=1-4 to ensure accurate estimates of medians
  131. 351  DEF FNNUM2STR$(X#,DP#,MXDIG%)=MID$("-0",(X#<0)+2,1)+RIGHT$(STRING$(MXDIG%,"0")+MID$(STR$(INT(X#*DP#)),2),MXDIG%)'<UNK! {000A}>    X=number, DP=dec factor, MXDIG=max digits/number (L. Rosenfelder)
  132. 352  DEC=10^(NDP+1):DEF FNROUND(X)=INT(X*DEC+0.5)/DEC  'Rounds to 1 dec more than in data entered.
  133. 353  DIM STRSORT%(33):RESTORE 354:FOR I=0 TO 33:READ STRSORT%(I):NEXT I:DEF SEG:STRSORT=VARPTR(STRSORT%(0)):RETURN
  134. 354  DATA &H5590,&HEC8B,&H1BA,&H8B00,&H876,&HC8B,&H7449,&H8B30
  135. 355  DATA &H676,&HDB33,&H1C8A,&H5646,&H8B51,&H37C,&H348B,&HCB8B
  136. 356  DATA &H5756,&HA6F3,&H5E5F,&HC7E,&HCB8B,&H58A,&H88A4,&HFF44
  137. 357  DATA &HF8E2,&HD233,&H5E59,&H4646,&HE246,&HBDC,&H74D2,&H5DC5
  138. 358  DATA &H4CA,&H0
  139. 399  '<UNK! {000A}>--- Start ---
  140. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  141. 401  DEFINT I-N,Q:Q$=CHR$(34):MXC=10
  142. 402  DIM I,J,K,L,M,N,Q,Z,X$,Y$,Z$,X#,CONST#,SM,EQ,AR,TC,KT,AV,CT,VN$(20),Q(20),ED$(1)
  143. 403  P5=0.5:S$=SPACE$(6):F$="#####.###":ED$(0)="C#=Change, D#=Delete, X=Extra data, Null=Proceed":ED$(1)="C#=Change, Null=Proceed"
  144. 404  QB=1:CLOSE:CLS:Z$="M E N U   F O R   A N O V A   B Y   R A N K S":GOSUB 46
  145. 405  LOCATE 3,8:PRINT"Press the NUMBER of your choice, and then press <ENTER> to run it.":PRINT STRING$(80,196)
  146. 406  LOCATE 6,1:K=10:PRINT"<UNK! {000A}>"TAB(K)"1   Kruskal & Wallis' Test for Independent Samples.<UNK! {000A}><UNK! {000A}>"TAB(K)"2   Friedman's Test for Matched Samples.<UNK! {000A}><UNK! {000A}>"TAB(K)"3   Return to Main Menu."
  147. 407  PRINT:LOCATE ,K-2:INPUT"===>  Option (1-3) ";OP:ON OP GOTO 500,600,30:PRINT"No, please enter 1, 2, or 3":GOTO 407
  148. 499  '<UNK! {000A}>-------<<< Kruskal & Wallis >>>
  149. 500  QB=3:HD$=" K R U S K A L   &   W A L L I S'   T E S T ":VER$="(RL,5)"
  150. 501  NEEDVARS=1:MXR=400:DIM X(MXR,1),Z$(MXR),N(MXC),KN(MXC),RK(MXR),LK(MXR),SR(MXC),SX(MXC),XMED(MXC)
  151. 502  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,0:K=12
  152. 503  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  153. 504  PRINT TAB(K)"OPEN                                                       OPEN"
  154. 505  PRINT TAB(K)"OPEN  Compares MEDIANS of 3-10 INDEPENDENT sample groups.  OPEN"
  155. 506  PRINT TAB(K)"OPEN  Min sample size = 2.  Max total measurements = 400.  OPEN"
  156. 507  PRINT TAB(K)"OPEN     Enter & edit the data of 1 sample at a time.      OPEN"
  157. 508  PRINT TAB(K)"OPEN   Only simple editing if data comes from disk file.   OPEN"
  158. 509  PRINT TAB(K)"OPEN       Printouts available after viewing answers.      OPEN"
  159. 510  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  160. 511  PRINT TAB(K)"OPEN                                                       OPEN"
  161. 512  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE,,1
  162. 513  '<UNK! {000A}>--- Get Data ---
  163. 514  DO$="enter data from disk":GOSUB 20:PRINT:IF Z$="N" THEN 521
  164. 515  '<UNK! {000A}>--- Disk Entry ---
  165. 516  QD=1:MNR=6:MNC=1:GOSUB 80
  166. 517  PRINT"How many samples are there (3-"MID$(STR$(MXC),2)") ";:INPUT NS:IF NS<3 OR NS>MXC THEN 517
  167. 518  FOR Q=1 TO NS:PRINT"How many measurements belong to Sample "CHR$(Q+64);:INPUT N(Q):IF N(Q)<2 OR N(Q)>N-KN(Q-1)THEN GOSUB 40:GOTO 518
  168. 519  KN(Q)=KN(Q-1)+N(Q):NEXT Q:IF N=KN(Q-1) THEN 523 ELSE BEEP:PRINT"Hey, those sample sizes don't add up to"N:GOTO 517
  169. 520  '<UNK! {000A}>--- K/b Entry ---
  170. 521  PRINT"How many samples (3-"MID$(STR$(MXC),2)") ";:INPUT NS:IF NS<3 OR NS>MXC THEN 521
  171. 522  PRINT"Ok, press <Enter> after each measurement.  Null entry duplicates previous value.Signal `end-of-each-sample' by entering a `/'."
  172. 523  CLOSE:Q=1:M=1
  173. 524  IF QD THEN 527
  174. 525  PRINT:PRINT"Sample "CHR$(Q+64)" ---"
  175. 526  I=N+1:N=0:GOSUB 73:N(Q)=N-KN(Q-1):IF N(Q)>1 THEN KN(Q)=N ELSE GOSUB 45:N=KN(Q-1):GOTO 526
  176. 527  PRINT:PRINT"Sample "CHR$(Q+64)" --- Data read was:"
  177. 528  L=1:FOR I=KN(Q-1)+1 TO KN(Q):PRINT TAB(L)"#"MID$(STR$(I-KN(Q-1)),2)"= "X(I,1);:L=L+16:IF L>65 THEN L=1:PRINT
  178. 529  IF I MOD 100=0 THEN GOSUB 6
  179. 530  NEXT I:PRINT
  180. 531  '<UNK! {000A}>--- Edit ---
  181. 532  PRINT ED$(QD);:INPUT Z$:IF Z$="" THEN 543 ELSE LZ$=CHR$(ASC(Z$) AND 95):I=VAL(MID$(Z$,2))
  182. 533  IF LZ$="C" THEN 535 ELSE IF QD THEN 534 ELSE IF LZ$="D" THEN 538 ELSE IF LZ$="X" THEN 540
  183. 534  BEEP:IF QD=0 AND (LZ$="C" OR LZ$="D") THEN PRINT"C or D need a valid datum number.":GOTO 532 ELSE PRINT"WHAT?":GOTO 532
  184. 535  IF I<1 OR I>N(Q) THEN 534 ELSE I=I+KN(Q-1)
  185. 536  PRINT"Old value = "X(I,1)"     New value";:INPUT X$:IF X$="" THEN 532 ELSE FOR L=1 TO LEN(X$):IF INSTR("-.0123456789",MID$(X$,L,1))=0 THEN PLAY"L16O3CEL4>B":PRINT"That contains a `non-numeric' entry.  Please re-do it.":GOTO 536
  186. 537  NEXT L:X(I,1)=VAL(X$):IF X(I,1)<0 THEN NEG=1:GOTO 527 ELSE 527
  187. 538  IF I<1 OR I>N(Q) THEN 534 ELSE IF KN(Q)-KN(Q-1)<3 THEN GOSUB 45:GOTO 532 ELSE GOSUB 43:FOR L=I+KN(Q-1) TO N:X(L,1)=X(L+1,1):NEXT L:N(Q)=N(Q)-1:KN(Q)=KN(Q)-1:N=N-1
  188. 539  LOCATE ,1:PRINT"Ok, value #"I"deleted.":GOSUB 5:GOTO 527
  189. 540  IF N=MXR THEN PRINT"Total N is already maximum,"N;:GOTO 532
  190. 541  PRINT"You can append up to"MXR-N"extra measurements, 1 per line, with `/' end-signal:"
  191. 542  I=N+1:N=0:GOSUB 73:N(Q)=N-KN(Q-1):KN(Q)=N:GOTO 527
  192. 543  IF Q<NS THEN Q=Q+1:GOTO 524
  193. 544  '<UNK! {000A}>--- Calc ---
  194. 545  GOSUB 350:CLS:GOSUB 43:CONST#=0
  195.