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
