10  COM X[103,22],M[19,19],U[19,19],Q[20],V[20],P[78]
30  COM M$[60],N$[72]
40  COM N,K,N8,K8,N9,K9,Q9,Q7,Q5,Q4,Q3,Q2,Q1
45  COM I3,I4,U9,X$[20]
50  REM:2NOV73
52  REM:>SORT
60  DIM W[16],H[450],A$[12],C$[12],C[16]
61  DIM R$[6]
62  IF Q[1]#0 THEN 70
64  CHAIN "$IDA29",210
70  MAT H=ZER[N]
80  MAT W=ZER
90  MAT C=ZER
100  GOTO Q9 OF 110,120,140
110  PRINT "* GIVE VARIABLE NAME OR COLUMN NUMBER FOR THE "
120  PRINT "  VARIABLE TO BE SORTED : ";
130  GOTO 150
140  PRINT "* VARIABLE : ";
150  ENTER 30,Q8,C$
155  PRINT 
160  IF Q8>0 THEN 190
170  GOSUB 4000
180  GOTO 140
190  GOSUB 4500
195  I9=Z9
200  IF I9=0 THEN 170
210  GOTO Q9 OF 220,230,250
220  PRINT "* GIVE COLUMN NAME OR COLUMN NUMBER FOR "
230  PRINT "  COLUMN RECEIVING SORTED OBSERVATIONS : ";
240  GOTO 260
250  PRINT "* RECEIVING COLUMN : ";
260  ENTER 30,Q8,C$
265  PRINT 
270  IF Q8>0 THEN 300
280  PRINT "AFTER THE COLUMN IS SORTED IN ASCENDING ORDER, WHICH COLUMN"
285  PRINT "IN THE DATA MATRIX DO YOU WANT  TO REPLACE WITH IT? IT CAN BE"
290  PRINT "ANY COLUMN IN THE ACTIVE DATA MATRIX EXCEPT THE ONE BEING"
292  PRINT "SORTED, OR IT CAN BE A NEW VARIABLE IN COLUMN";K+1
294  PRINT 
295  GOTO 250
300  GOSUB 4500
310  J9=Z9
312  IF I9#J9 THEN 320
314  PRINT "RECEIVING COLUMN CANNOT OCCUPY THE SAME COLUMN AS THAT"
316  PRINT "OF THE VARIABLE TO BE SORTED.  PLEASE RE-ENTER."
318  GOTO 250
320  IF J9=0 OR J9>K+1 THEN 325
321  IF J9=K+1 THEN 395
322  GOTO 330
325  PRINT "YOU HAVE SPECIFIED AN INVALID COLUMN, PLEASE SELECT A"
326  PRINT "DIFFERENT COLUMN LESS THAN OR EQUAL TO ";K+1
327  PRINT 
329  GOTO 250
330  PRINT "REQUEST WILL DESTROY OLD DATA IN RECEIVING COLUMN."
335  PRINT "WANT TO PROCEED ?";
340  ENTER 60,Q8,R$
342  IF Q8<0 THEN 280
344  IF R$[1,1]="Y" THEN 400
365  PRINT 
370  GOTO 250
395  K=K+1
400  N0=0
410  FOR I=Q4 TO N
420  IF X[I,K9+2]=0 THEN 450
430  N0=N0+1
440  H[N0]=X[I,I9]
450  NEXT I
460  GOSUB 6000
500  Q[3]=1
510  FOR I=1 TO 3
520  X[N9+I,J9]=X[N9+I,I9]
530  NEXT I
535  N5=0
540  FOR I=Q4 TO N
550  IF X[I,K9+2]=0 THEN 580
560  N5=N5+1
570  X[I,J9]=H[N5]
580  NEXT I
3000  IF Q3#1 THEN 9998
3010  PRINT LIN(1);"NAME OF NEW VARIABLE = ";
3020  INPUT C$
3030  IF J9>10 THEN 3060
3040  M$[6*J9-5,6*J9]=C$[1,6]
3050  GOTO 9998
3060  N$[6*J9-65,6*J9-60]=C$[1,6]
3070  GOTO 9998
4000  IF Q3=1 THEN 4100
4010  PRINT LIN(1),"FOR YOUR REFERENCE :"
4040  PRINT LIN(1),"COLUMN  1ST OBSERVATION"
4045  PRINT 
4050  FOR J=1 TO K
4060  PRINT  USING "2X,DD,6X,D.5DE";J,X[Q4,J]
4070  NEXT J
4080  GOTO 4185
4100  PRINT LIN(1),"THESE ARE THE VARIABLES IN THE DATA MATRIX :"
4110  PRINT "COLUMN   NAME"
4115  PRINT 
4120  FOR J=1 TO K
4130  IF J>10 THEN 4170
4140  PRINT  USING 4150;J,M$[6*J-5,6*J]
4150  IMAGE 2X,DD,4X,6A
4160  GOTO 4180
4170  PRINT  USING 4150;J,N$[6*(J-10)-5,6*(J-10)]
4180  NEXT J
4185  PRINT 
4190  RETURN 
4500  FOR I=1 TO 10
4510  IF M$[6*I-5,6*I]=C$[1,6] THEN 4730
4520  NEXT I
4530  FOR I=1 TO 11
4540  IF N$[6*I-5,6*I]=C$[1,6] THEN 4750
4550  NEXT I
4560  RESTORE 
4670  FOR I=1 TO 20
4680  READ A$
4690  IF A$=C$ THEN 4730
4700  NEXT I
4710  Z9=0
4720  GOTO 4760
4730  Z9=I
4740  GOTO 4760
4750  Z9=10+I
4760  RETURN 
6000  I=1
6001  M1=1
6003  J=N0
6005  IF I >= J THEN 6070
6010  K1=I
6011  I2=(J+I)/2
6012  T=H[I2]
6013  IF H[I] <= T THEN 6020
6014  H[I2]=H[I]
6015  H[I]=T
6016  T=H[I2]
6020  L1=J
6021  IF H[J] >= T THEN 6040
6022  H[I2]=H[J]
6023  H[J]=T
6024  T=H[I2]
6025  IF H[I] <= T THEN 6040
6026  H[I2]=H[I]
6027  H[I]=T
6028  T=H[I2]
6029  GOTO 6040
6030  H[L1]=H[K1]
6031  H[K1]=T1
6040  L1=L1-1
6041  IF H[L1]>T THEN 6040
6042  T1=H[L1]
6050  K1=K1+1
6051  IF H[K1]<T THEN 6050
6052  IF K1 <= L1 THEN 6030
6053  IF (L1-I) <= (J-K1) THEN 6060
6054  W[M1]=I
6055  C[M1]=L1
6056  I=K1
6057  M1=M1+1
6058  GOTO 6080
6060  W[M1]=K1
6061  C[M1]=J
6062  J=L1
6063  M1=M1+1
6064  GOTO 6080
6070  M1=M1-1
6071  IF M1=0 THEN 6100
6072  I=W[M1]
6073  J=C[M1]
6080  IF (J-I) >= 11 THEN 6010
6082  IF I=1 THEN 6005
6083  I=I-1
6090  I=I+1
6091  IF I=J THEN 6070
6092  T=H[I+1]
6093  IF H[I] <= T THEN 6090
6094  K1=I
6095  H[K1+1]=H[K1]
6096  K1=K1-1
6097  IF T<H[K1] THEN 6095
6098  H[K1+1]=T
6099  GOTO 6090
6100  RETURN 
9000  DATA "1","2","3","4","5","6","7","8","9","10","11","12"
9010  DATA "13","14","15","16","17","18","19","20","21"
9998  CHAIN "$IDA",150
9999  END 
