home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / educ / math / 023 / wilcx.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-03-20  |  18.1 KB  |  196 lines
  1. 1  '          WILCOXON'S TESTS  ---  WILCX.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 521
  8. 9  ON QB GOTO 404,177,8,619:STOP  '=start,printout,Sum,Signed.<UNK! {000A}><UNK! {000A}>--- Another go? ---
  9. 10  CLOSE:IF HD$="" THEN LPRINT STRING$(79,61)STRING$(4,10)
  10. 11  GOTO 2
  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 3 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=0:L=M
  67. 101  FOR J=1 TO L:INPUT #1,Z
  68. 102  IF J=Q(KK) THEN KK=KK+1 ELSE LL=LL+1:X(I,LL)=Z:IF X(I,LL)<0 THEN NEG=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,NEEDVARS):GOTO 110 ' *** MXC replaced ***
  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 or 2: if=1, then NS,N( ),KN( ,1) else VN$(1 & 2).
  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);:NEXT I:PRINT #2,:NEXT J:GOTO 193
  113. 192  IF NEEDVARS=2 THEN GOSUB 210:PRINT #2,VN$(1)", & "VN$(2):FOR I=1 TO N:PRINT #2,X(I,1);X(I,2):NEXT I
  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. 209  '<UNK! {000A}>--- Varnames ---
  118. 210  IF VN$="Y" THEN RETURN ELSE FOR J=1 TO M:IF J<10 THEN VN$(J)="Var #"+STR$(J) ELSE VN$(J)="Var #"+MID$(STR$(J),2)
  119. 211  NEXT J:RETURN
  120. 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.
  121. 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
  122. 281  NEXT JJ:IF EQ<2 THEN RK(II)=SM+1:GOTO 284
  123. 282  AR!=SM+(EQ+1)/2:FOR JJ=II TO NN:IF RK(JJ)=-1 THEN RK(JJ)=AR!
  124. 283  NEXT JJ
  125. 284  NEXT II:IF NO.TC THEN RETURN
  126. 285  '  Tie Correction
  127. 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
  128. 287  NEXT JJ:IF KT>1 THEN TC=TC+KT*KT*KT-KT
  129. 288  NEXT II:RETURN  'can have "TC=TC/12" before RETURN.
  130. 339  '<UNK! {000A}>--- Date ---
  131. 340  DAT$=MID$(DATE$,4,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",-2+3*VAL(LEFT$(DATE$,2)),3)+" "+RIGHT$(DATE$,4):RETURN
  132. 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).
  133. 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
  134. 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)
  135. 352  DEC=10^(NDP+1):DEF FNROUND(X)=INT(X*DEC+0.5)/DEC  'Rounds to 1 dec more than in data entered.
  136. 353  DIM STRSORT%(33):RESTORE 354:FOR I=0 TO 33:READ STRSORT%(I):NEXT I:DEF SEG:STRSORT=VARPTR(STRSORT%(0)):RETURN
  137. 354  DATA &H5590,&HEC8B,&H1BA,&H8B00,&H876,&HC8B,&H7449,&H8B30
  138. 355  DATA &H676,&HDB33,&H1C8A,&H5646,&H8B51,&H37C,&H348B,&HCB8B
  139. 356  DATA &H5756,&HA6F3,&H5E5F,&HC7E,&HCB8B,&H58A,&H88A4,&HFF44
  140. 357  DATA &HF8E2,&HD233,&H5E59,&H4646,&HE246,&HBDC,&H74D2,&H5DC5
  141. 358  DATA &H4CA,&H0
  142. 399  '<UNK! {000A}>--- Start ---
  143. 400  KEY OFF:CLEAR:SCREEN 0,0,0,0:CLS:ON ERROR GOTO 30
  144. 401  DEFINT I-N,Q:Q$=CHR$(34):MXC=20
  145. 402  DIM I,J,K,L,M,N,Q,Z,X$,Y$,Z$,X#,CONST#,SM,EQ,AR,TC,KT,AV,CT,VN$(MXC),Q(MXC),N(2),KN(2),ED$(1)
  146. 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"
  147. 404  QB=1:CLS:Z$="M E N U   F O R   W I L C O X O N' S   T E S T S":GOSUB 46
  148. 405  LOCATE 3,8:PRINT"Press the NUMBER of your choice, and then press <ENTER> to run it.":PRINT STRING$(80,196)
  149. 406  LOCATE 6,1:K=10:PRINT"<UNK! {000A}>"TAB(K)"1   Wilcoxon's Sum of Ranks Test for 2 Independent Samples.<UNK! {000A}><UNK! {000A}>"TAB(K)"2   Wilcoxon's Signed Ranks Test for 2 Matched Samples.<UNK! {000A}><UNK! {000A}>"TAB(K)"3   Return to Main Menu."
  150. 407  PRINT:LOCATE ,8:INPUT"===>  Option (1-3) ";OP:ON OP GOTO 500,600,30:PRINT"No, please enter 1, 2, or 3":GOTO 407
  151. 499  '<UNK! {000A}>-------<<< Sum of Ranks >>>
  152. 500  QB=3:HD$=" W I L C O X O N' S   S U M   O F   R A N K S   T E S T ":VER$="(RL,6)":IF NEEDVARS=2 THEN NEEDVARS=1:GOTO 545
  153. 501  NEEDVARS=1:MXR=400:DIM X(MXR,1),Z$(MXR),RK(MXR),LK(MXR),SR(2),AV(2),XMED(2)
  154. 502  CLS:GOSUB 340:PRINT DAT$;TAB(42-LEN(HD$)\2);:COLOR 0,7:PRINT HD$;:COLOR 7,0:PRINT TAB(73)VER$:LOCATE 4,1,0:K=12
  155. 503  PRINT TAB(K)"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  156. 504  PRINT TAB(K)"OPEN                                                       OPEN"
  157. 505  PRINT TAB(K)"OPEN    Compares MEDIANS of 2 INDEPENDENT sample groups.   OPEN"
  158. 506  PRINT TAB(K)"OPEN  Min sample sizes = 3.  Max total measurements = 400. OPEN"
  159. 507  PRINT TAB(K)"OPEN   Reads data of 1st sample, then data of 2nd sample.  OPEN"
  160. 508  PRINT TAB(K)"OPEN   Only simple editing if data comes from disk file.   OPEN"
  161. 509  PRINT TAB(K)"OPEN       Printouts available after viewing answers.      OPEN"
  162. 510  PRINT TAB(K)"OPEN         If trouble, try <Ctrl-Break> & GOTO 9.        OPEN"
  163. 511  PRINT TAB(K)"OPEN                                                       OPEN"
  164. 512  PRINT TAB(K)"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD":LOCATE,,1
  165. 513  '<UNK! {000A}>--- Get Data ---
  166. 514  NS=2:DO$="enter data from disk":GOSUB 20:PRINT:IF Z$="N" THEN 520
  167. 515  '<UNK! {000A}>--- Disk Entry ---
  168. 516  QD=1:MNR=6:MNC=1:GOSUB 80
  169. 517  FOR Q=1 TO NS:PRINT"How many measurements belong to Sample "CHR$(Q+64);:INPUT N(Q):IF N(Q)<3 OR N(Q)>N-KN(Q-1)THEN GOSUB 40:GOTO 517
  170. 518  KN(Q)=KN(Q-1)+N(Q):NEXT Q:IF N=KN(Q-1) THEN 521 ELSE BEEP:PRINT"Hey, those sample sizes don't add up to"N:GOTO 517
  171. 519  '<UNK! {000A}>--- K/b Entry ---
  172. 520  PRINT"Ok, press <Enter> after each measurement.  Null entry duplicates previous value.Signal `end-of-each-sample' by entering a `/'."
  173. 521  CLOSE:Q=1:M=1
  174. 522  IF QD THEN 525
  175. 523  PRINT:PRINT"Sample "CHR$(Q+64)" ---"
  176. 524  I=N+1:N=0:GOSUB 73:N(Q)=N-KN(Q-1):IF N(Q)>2 THEN KN(Q)=N ELSE GOSUB 45:N=KN(Q-1):GOTO 524
  177. 525  PRINT:PRINT"Sample "CHR$(Q+64)" --- Data read was:"
  178. 526  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 PRINT:L=1
  179. 527  IF I MOD 100 =0 THEN GOSUB 6
  180. 528  NEXT I:PRINT
  181. 529  '<UNK! {000A}>--- Edit ---
  182. 530  PRINT ED$(QD);:INPUT Z$:IF Z$="" THEN 541 ELSE LZ$=CHR$(ASC(Z$) AND 95):I=VAL(MID$(Z$,2))
  183. 531  IF LZ$="C" THEN 533 ELSE IF QD THEN 532 ELSE IF LZ$="D" THEN 536 ELSE IF LZ$="X" THEN 538
  184. 532  BEEP:IF QD=0 AND (LZ$="C" OR LZ$="D") THEN PRINT"C or D need a valid datum number.":GOTO 530 ELSE PRINT"WHAT?":GOTO 530
  185. 533  IF I<1 OR I>N(Q) THEN 532 ELSE I=I+KN(Q-1)
  186. 534  PRINT"Old value = "X(I,1)"     New value";:INPUT X$:IF X$="" THEN 530 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 534
  187. 535  NEXT L:X(I,1)=VAL(X$):IF X(I,1)<0 THEN NEG=1:GOTO 525 ELSE 525
  188. 536  IF I<1 OR I>N(Q) THEN 532 ELSE IF KN(Q)-KN(Q-1)<4 THEN GOSUB 45:GOTO 530 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
  189. 537  LOCATE ,1:PRINT"Ok, value #"I"deleted.":GOSUB 5:GOTO 525
  190. 538  IF N=MXR THEN PRINT"Total N is already maximum,"N;:GOTO 530
  191. 539  PRINT"You can append up to"MXR-N"extra measurements, 1 per line, with `/' end-signal:"
  192. 540  I=N+1:N=0:GOSUB 73:N(Q)=N-KN(Q-1):KN(Q)=N:GOTO 525
  193. 541  IF Q<NS THEN Q=Q+1:GOTO 522
  194. 542  '<UNK! {000A}>--- Calc ---
  195. 543  GOSUB 350:CLS:GOSUB 43:CONST#=0
  196.