Re: [U2] QSORT (Or something like that)
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.1EL = MAR1(LN)CL LIST.ARRAY.2EL = MAR2(LN)CL CASE DELIM = @VM LIST.ARRAY.11,EL = MAR1(LN)CL LIST.ARRAY.21,EL = MAR2(LN)CL CASE DELIM = @SVM LIST.ARRAY.11,1,EL = MAR1(LN)CL LIST.ARRAY.21,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
[U2] QSORT (Or something like that)
I read a post from Charlie thanking Tony for the QSORT tip. I remember using something like this a long time ago... What I am looking for is a way to sort the values of a dynamic array. Lets say that attributes 1,2,3 of the variable A are all associated. I want to sort the values of A1 and ensure the associated values follow... For example, I want to take this array... A1 = 1:@VM:2:@VM:4:@VM:3 A2 = INFO1:@VMINFO2@VMINFO4@VMINFO3 A3 = MORE.INFO1:@VMMORE.INFO2@VMMORE.INFO4@VMMORE.INFO3 and end up with this array A1 = 1:@VM:2:@VM:3:@VM:4 A2 = INFO1:@VMINFO2@VMINFO3@VMINFO4 A3 = MORE.INFO1:@VMMORE.INFO2@VMMORE.INFO3@VMMORE.INFO4 Is there a function out there that does this? Thanks - Shawn 'We act as though comfort and luxury were the chief requirements of life, when all that we need to make us happy is something to be enthusiastic about.' ___ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users
Re: [U2] QSORT (Or something like that)
You can find these subroutines on PickWiki.com: CALL ROW2COL(A) ;* flip fields to values CALL QUICKSORT(A, 1, AR) ;* sort on first value CALL ROW2COL(A) ;* flip back rex ___ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users
Re: [U2] QSORT (Or something like that)
Shawn, Betcha Tony's is faster ;^) (it's scary fast). Charlie On 05-24-2010 2:40 PM, Shawn Hayes wrote: Thanks Rex... I just created a little routine to do this also. I thought that it might have been built in to the Unibasic language. Anyways, here is the code I came up with (not fully tested) if anyone is interested... SUBROUTINE QSORT(ARRAY, ATTRIBUTE.LIST, MAIN.SORT, SORT.TYPE, ERR) * * ARRAY - This is the dynamic array iwth the attributes that needs to be sorted. * ATTRIBUTE.LIST - This is a list of attributes to sort. * MAIN.SORT - This is the main sort attribute position * SORT.TYPE - This is the sort type AL, AR, DL, DR * ERR - This allows the calling routine to handle any errors. * MAIN PROGAM: * * Initialization HOLD.ARRAY = ARRAY ERR = * * Setup checks. LOCATE MAIN.SORT IN ATTRIBUTE.LIST1 SETTING POS ELSE ERR = Your MAIN.SORT must be included in the ATTRIBUTE.LIST RETURN END SORT.LIST = AL:@VM:AR:@VM:DL:@VM:DR LOCATE SORT.TYPE IN SORT.LIST1 SETTING POS ELSE ERR = Your SORT.TYPE must be 'AL', 'AR', 'DL', OR 'DR' RETURN END * * Clear the values in the HOLD.ARRAY. The HOLD.ARRAY is going to be where we * rebuild the array. NUM.OF.LIST.ATT = DCOUNT(ATTRIBUTE.LIST,@VM) FOR ATTRIBUTE.CNT = 1 TO NUM.OF.LIST.ATT ATTRIBUTE.POS = ATTRIBUTE.LIST1,ATTRIBUTE.CNT HOLD.ARRAYATTRIBUTE.POS = NEXT ATTRIBUTE.POS * * Restructuring ARRAY to HOLD.ARRAY. NUM.OF.MAIN.SORT.VALUES = DCOUNT(ARRAYMAIN.SORT,@VM) FOR SORT.VALUE.POS = 1 TO NUM.OF.MAIN.SORT.VALUES * * Get the first value from the main sorting list and locate it in the new list (HOLD.ARRAY). MAIN.SORT.VALUE = ARRAYMAIN.SORT,SORT.VALUE.POS LOCATE MAIN.SORT.VALUE IN HOLD.ARRAYMAIN.SORT BY SORT.TYPE SETTING INSERT.POS ELSE NULL * * Loop through the ATTRIBUTE.LIST and load values in HOLD.ARRAY in their new positions. NUM.OF.ATTRIBUTES = DCOUNT(ATTRIBUTE.LIST,@VM) FOR ATTRIBUTE.NUM = 1 TO NUM.OF.ATTRIBUTES ATTRIBUTE.POS = ATTRIBUTE.LIST1,ATTRIBUTE.NUM ATTRIBUTE.VALUE = ARRAYATTRIBUTE.POS,SORT.VALUE.POS HOLD.ARRAY = INSERT(HOLD.ARRAY,ATTRIBUTE.POS,INSERT.POS,0,ATTRIBUTE.VALUE) NEXT ATTRIBUTE.NUM NEXT SORT.VALUE.POS * * Load sorted array. IF NOT(ERR) THEN ARRAY = HOLD.ARRAY END * RETURN * * END OF QSORT 'We act as though comfort and luxury were the chief requirements of life, when all that we need to make us happy is something to be enthusiastic about.' - Original Message From: Rex Gozar rgo...@gmail.com To: U2 Users List u2-users@listserver.u2ug.org Sent: Mon, May 24, 2010 1:27:32 PM Subject: Re: [U2] QSORT (Or something like that) You can find these subroutines on PickWiki.com: CALL ROW2COL(A) ;* flip fields to values CALL QUICKSORT(A, 1, AR) ;* sort on first value CALL ROW2COL(A) ;* flip back rex ___ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users ___ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users ___ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users
Re: [U2] QSORT (Or something like that)
I probably ought to qualify the importance of speed here. We use QSORT to sort thousands of entries, with a dozen or more associated arrays. QSORT's relative speed doesn't drop with heavy volume as some sort routines can. We've all probably written sort routines, implementing various algorithms, and most work well if the load is light. It's when the load is heavy that the best algorithms really shine. No, I don't work for Tony, and he's not paying me to say this. I wouldn't mind a beer if our paths cross, though, Tony. Charlie On 05-24-2010 6:15 PM, Charlie Noah wrote: Shawn, Betcha Tony's is faster ;^) (it's scary fast). Charlie On 05-24-2010 2:40 PM, Shawn Hayes wrote: Thanks Rex... I just created a little routine to do this also. I thought that it might have been built in to the Unibasic language. Anyways, here is the code I came up with (not fully tested) if anyone is interested... SUBROUTINE QSORT(ARRAY, ATTRIBUTE.LIST, MAIN.SORT, SORT.TYPE, ERR) * * ARRAY - This is the dynamic array iwth the attributes that needs to be sorted. * ATTRIBUTE.LIST - This is a list of attributes to sort. * MAIN.SORT - This is the main sort attribute position * SORT.TYPE - This is the sort type AL, AR, DL, DR * ERR - This allows the calling routine to handle any errors. * MAIN PROGAM: * * Initialization HOLD.ARRAY = ARRAY ERR = * * Setup checks. LOCATE MAIN.SORT IN ATTRIBUTE.LIST1 SETTING POS ELSE ERR = Your MAIN.SORT must be included in the ATTRIBUTE.LIST RETURN END SORT.LIST = AL:@VM:AR:@VM:DL:@VM:DR LOCATE SORT.TYPE IN SORT.LIST1 SETTING POS ELSE ERR = Your SORT.TYPE must be 'AL', 'AR', 'DL', OR 'DR' RETURN END * * Clear the values in the HOLD.ARRAY. The HOLD.ARRAY is going to be where we * rebuild the array. NUM.OF.LIST.ATT = DCOUNT(ATTRIBUTE.LIST,@VM) FOR ATTRIBUTE.CNT = 1 TO NUM.OF.LIST.ATT ATTRIBUTE.POS = ATTRIBUTE.LIST1,ATTRIBUTE.CNT HOLD.ARRAYATTRIBUTE.POS = NEXT ATTRIBUTE.POS * * Restructuring ARRAY to HOLD.ARRAY. NUM.OF.MAIN.SORT.VALUES = DCOUNT(ARRAYMAIN.SORT,@VM) FOR SORT.VALUE.POS = 1 TO NUM.OF.MAIN.SORT.VALUES * * Get the first value from the main sorting list and locate it in the new list (HOLD.ARRAY). MAIN.SORT.VALUE = ARRAYMAIN.SORT,SORT.VALUE.POS LOCATE MAIN.SORT.VALUE IN HOLD.ARRAYMAIN.SORT BY SORT.TYPE SETTING INSERT.POS ELSE NULL * * Loop through the ATTRIBUTE.LIST and load values in HOLD.ARRAY in their new positions. NUM.OF.ATTRIBUTES = DCOUNT(ATTRIBUTE.LIST,@VM) FOR ATTRIBUTE.NUM = 1 TO NUM.OF.ATTRIBUTES ATTRIBUTE.POS = ATTRIBUTE.LIST1,ATTRIBUTE.NUM ATTRIBUTE.VALUE = ARRAYATTRIBUTE.POS,SORT.VALUE.POS HOLD.ARRAY = INSERT(HOLD.ARRAY,ATTRIBUTE.POS,INSERT.POS,0,ATTRIBUTE.VALUE) NEXT ATTRIBUTE.NUM NEXT SORT.VALUE.POS * * Load sorted array. IF NOT(ERR) THEN ARRAY = HOLD.ARRAY END * RETURN * * END OF QSORT 'We act as though comfort and luxury were the chief requirements of life, when all that we need to make us happy is something to be enthusiastic about.' - Original Message From: Rex Gozar rgo...@gmail.com To: U2 Users List u2-users@listserver.u2ug.org Sent: Mon, May 24, 2010 1:27:32 PM Subject: Re: [U2] QSORT (Or something like that) You can find these subroutines on PickWiki.com: CALL ROW2COL(A) ;* flip fields to values CALL QUICKSORT(A, 1, AR) ;* sort on first value CALL ROW2COL(A) ;* flip back rex ___ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users ___ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users ___ U2-Users mailing list U2-Users@listserver.u2ug.org http://listserver.u2ug.org/mailman/listinfo/u2-users
