Hello, I adapted a Heapsort algorithm a while back that I had obtained from a book (Turbo Algorithms circa 1989). The original had been written in Turbo Basic or Turbo Pascal, I forget which. I adapted it so that I could use work dimmed arrays (even if they were smaller than the dynamic arrays I was sorting). This was to take advantage of the faster access time to access a dimmentionned array. The dynamic array was basically folded on the dimmentionned array. For example, if I wanted to sort 100,000 items I could use a dimmed matrix of 10,000 items.
It is fairly fast however I've only used in one shot data migration project so use at your own risk. SUBROUTINE HDSORT(MAT MAR1, MAT MAR2, MAR.SIZE, LIST.ARRAY.1, LIST.ARRAY.2, NUMDATA,ASCENDING,MASK,DELIM) * * *--------------< Heapsort Program for dynamic arrays >-----------------* * MAR1: Large Work Matrix provided for by calling pgm must be same size as MAR2: Used for LIST.ARRAY.1 * MAR2: Large Work Matrix provided for by calling pgm must be same size as MAR1: Used for LIST.ARRAY.2 * MAR.SIZE: Size of MAR1 & MAR2 * LIST.ARRAY.1: Dynamic list of elements (keys) to be sorted * LIST.ARRAY.2: Dynamic list of tag-along elements * NUMDATA : Number of attributes in the list arrays (Can be bigger than MAR.SIZE) * ASCENDING : Ex: AR, AL, DL, DR * DELIM : Delimiter used for LIST.ARRAY.1 and LIST.ARRAY.2. Must be one of @AM, @VM, @SVM * : Only the specified delimiter is allowed in the LIST.ARRAY.1 and LIST.ARRAY.2 as * the remove command is used to extract the elements quickly in the parse subroutine * MAT MAR1 = '' ; MAT MAR2 = '' IF NUMDATA <= 1 THEN RETURN GOSUB parse ;* Parse the contents into the DIMMED arrays LEFT.OR.RIGHT = UPCASE(ASCENDING[1]) ORDER = UPCASE(ASCENDING[1,1]) I = 0 TEMPO = "" HALF.NUM.DATA = DIV(NUMDATA,2) FOR I = HALF.NUM.DATA -1 TO 1 STEP -1 ROOT.ARG = I NODE.ARG = NUMDATA -1 GOSUB sift NEXT I FOR I = NUMDATA -1 TO 1 STEP -1 EL = I+1 LN = 1 + MOD(EL-1,MAR.SIZE) CL = 1 + DIV(EL-1,MAR.SIZE) * TEMPO = MAR1(LN)<CL> TEMPO.2 = MAR2(LN)<CL> * MAR1(LN)<CL> = MAR1(1)<1> MAR1(1)<1> = TEMPO * MAR2(LN)<CL> = MAR2(1)<1> MAR2(1)<1> = TEMPO.2 * ROOT.ARG = 1 ; NODE.ARG = I ; GOSUB sift NEXT I GOSUB matbuild RETURN sift: RESUME.LOOP = 1 LN = 1 + MOD(ROOT.ARG-1,MAR.SIZE) CL = 1 + DIV(ROOT.ARG-1,MAR.SIZE) PIVOT = MAR1(LN)<CL> PIVOT.2 = MAR2(LN)<CL> J = 2 * ROOT.ARG FOR SL = 1 TO (SL+1) WHILE (J<= NODE.ARG) AND RESUME.LOOP IF J < NODE.ARG THEN LN = 1 + MOD(J-1,MAR.SIZE) CL = 1 + DIV(J-1,MAR.SIZE) V1 = MAR1(LN)<CL> LN = 1 + MOD(J,MAR.SIZE) CL = 1 + DIV(J,MAR.SIZE) V2 = MAR1(LN)<CL> IF MASK NE '' THEN V1 = V1 MASK V2 = V2 MASK END IF ORDER = 'A' THEN VAL.CMP = COMPARE(V1,V2,LEFT.OR.RIGHT) END ELSE VAL.CMP = 0 - COMPARE(V1,V2,LEFT.OR.RIGHT) END IF VAL.CMP < 0 THEN J+= 1 END W1 = PIVOT LN = 1 + MOD(J-1,MAR.SIZE) CL = 1 + DIV(J-1,MAR.SIZE) W2 = MAR1(LN)<CL> IF MASK NE '' THEN W1 = W1 MASK W2 = W2 MASK END IF ORDER = 'A' THEN VAL.CMP = COMPARE(W1,W2,LEFT.OR.RIGHT) END ELSE VAL.CMP = 0 - COMPARE(W1,W2,LEFT.OR.RIGHT) END IF VAL.CMP < 0 THEN MID.LN = 1 + MOD(DIV(J,2)-1,MAR.SIZE) MID.CL = 1 + DIV(DIV(J,2)-1,MAR.SIZE) LN = 1 + MOD(J-1,MAR.SIZE) CL = 1 + DIV(J-1,MAR.SIZE) MAR1(MID.LN)<MID.CL> = MAR1(LN)<CL> MAR2(MID.LN)<MID.CL> = MAR2(LN)<CL> J = J * 2 END ELSE RESUME.LOOP = 0 NEXT SL LN = 1 + MOD(DIV(J,2)-1,MAR.SIZE) CL = 1 + DIV(DIV(J,2)-1,MAR.SIZE) MAR1(LN)<CL> = PIVOT MAR2(LN)<CL> = PIVOT.2 RETURN *-------------------------------------------------------* * Parse the elements into the dimmed arrays *-------------------------------------------------------* parse: FOR EL = 1 TO NUMDATA REMOVE ELEMENT FROM LIST.ARRAY.1 SETTING TYPE LN = 1 + MOD(EL-1,MAR.SIZE) CL = 1 + DIV(EL-1,MAR.SIZE) MAR1(LN)<CL> = ELEMENT NEXT EL FOR EL = 1 TO NUMDATA REMOVE TAG FROM LIST.ARRAY.2 SETTING TYPE LN = 1 + MOD(EL-1,MAR.SIZE) CL = 1 + DIV(EL-1,MAR.SIZE) MAR2(LN)<CL> = TAG ;* Tag along NEXT EL RETURN *-------------------------------------------------------* * Rebuild the element from the matrice *-------------------------------------------------------* matbuild: FOR EL = 1 TO NUMDATA LN = 1 + MOD(EL-1,MAR.SIZE) CL = 1 + DIV(EL-1,MAR.SIZE) BEGIN CASE CASE DELIM = @AM LIST.ARRAY.1<EL> = MAR1(LN)<CL> LIST.ARRAY.2<EL> = MAR2(LN)<CL> CASE DELIM = @VM LIST.ARRAY.1<1,EL> = MAR1(LN)<CL> LIST.ARRAY.2<1,EL> = MAR2(LN)<CL> CASE DELIM = @SVM LIST.ARRAY.1<1,1,EL> = MAR1(LN)<CL> LIST.ARRAY.2<1,1,EL> = MAR2(LN)<CL> END CASE NEXT EL RETURN _______________________________________________ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users