Sorting 2 variables: one ascending, one descending Moneo Posting Freak Posts: 1,956 Threads: 65 Joined: Jun 2003 11-07-2004, 06:44 AM In the Newbie Help section Licentia recently posted a problem regarding sorting in descending order. This reminded me of similar problem about sorting 2 different keys where one must be ascending and the other descending. If you're not using a Quick sort, you could do two sorts on the data, one for each key. But that's kinda like cheating. So here's the challenge. GIVEN: * Data records containing a LAST NAME string, left justified, in positions 1 to 10 of each record. * Also in each record we have an AGE string, right justified, in positions 11 to 12. * There should be at least 10 records, and at least 2 or more should have the same NAME with different AGES. PROBLEM: * Write any sort routine you like to sort, in one pass, the NAME fields in ascending order, and to also sort the AGE fields in descending order. Example: If there are 3 SMITH records with ages 10, 15 and 20, then the sorted output for these should show: SMITH 20 SMITH 15 SMITH 10 Get it? HINT: The solution is not in having a tricky sort routine, but in setting up your sort key properly. ***** Neo Posting Freak Posts: 1,845 Threads: 44 Joined: Aug 2002 11-07-2004, 05:06 PM Ok, here's my entry on this challenge. The algorithm used is a relatively simple Double Insertion Sort, upgraded from the normal Insertion Sort. [syntax="QBasic"]'*- These are the declaration of the routines needed for Double Insertion Sort -*' '*- For explanation of these routines refer to the routines themselves -*' DECLARE SUB DoubleInsertionSort (Array() AS ANY) DECLARE SUB ShiftDown (Array() AS ANY, FromPlace AS INTEGER, ToPlace AS INTEGER) '*- Some standard conventions -*' DEFINT A-Z '\$DYNAMIC '*- The record we'll use -*' TYPE Record LASTNAME AS STRING * 10 AGE AS STRING * 2 END TYPE '*- Create an array of 10 of these records -*' DIM PersonData(9) AS Record '*- Fill Array with Test Data -*' PersonData(0).LASTNAME = "SMITH" PersonData(0).AGE = "34" PersonData(1).LASTNAME = "ANDERSON" PersonData(1).AGE = "29" PersonData(2).LASTNAME = "MYERSCOUGH" PersonData(2).AGE = "18" PersonData(3).LASTNAME = "RIETVELD" PersonData(3).AGE = "18" PersonData(4).LASTNAME = "SMITH" PersonData(4).AGE = "22" PersonData(5).LASTNAME = "ANDERSON" PersonData(5).AGE = "35" PersonData(6).LASTNAME = "SMITH" PersonData(6).AGE = "99" PersonData(7).LASTNAME = "RIETVELD" PersonData(7).AGE = "74" PersonData(8).LASTNAME = "SMITH" PersonData(8).AGE = "88" PersonData(9).LASTNAME = "ANDERSON" PersonData(9).AGE = "34" '*- Print out data before sorting -*' FOR I = LBOUND(PersonData) TO UBOUND(PersonData) PRINT PersonData(I).LASTNAME, PersonData(I).AGE NEXT I '*- To separate both lists -*' PRINT '*- Sort the array -*' CALL DoubleInsertionSort( PersonData() ) '*- Print out data after sorting -*' FOR I = LBOUND(PersonData) TO UBOUND(PersonData) PRINT PersonData(I).LASTNAME, PersonData(I).AGE NEXT I '*- Exit the program -*' SUB DoubleInsertionSort (Array() AS Record) '+--------------------------------------------------------------+' '| SUB DoubleInsertionSort (Array() AS Record) |' '| |' '| This routine sorts the Array passed to this function. The |' '| sort algorithm will first sort on LASTNAME, then on AGE. |' '| All in one run. Respectively ascending and descending. |' '| The algorithm is a relatively simple Double Insertion Sort |' '| upgraded from the normal Insertion Sort. |' '| It's not the fastest algorithm available, but it works. |' '| |' '| NOTE: Arrays of any size can be passed to this function, as |' '| long as they are one-dimensional and declared of type |' '| "Record". |' '| |' '| Neo |' '+--------------------------------------------------------------+' '*- Get the upper and lower bound to prevent repetitive calls -*' lowbound% = LBOUND(Array) upbound% = UBOUND(Array) '*- The outer loop determines which data is to be sorted -*' FOR dataloop = lowbound% TO upbound% '*- A variable which indicates when the insertion place has been reached -*' StillFits% = -1 '*- To prevent repetitive calls to RTRIM\$ and VAL -*' tmplastname\$ = RTRIM\$(Array(dataloop).LASTNAME) tmpage% = VAL(RTRIM\$(Array(dataloop).AGE)) '*- The inner loop scans all possible places for the data to be sorted -*' FOR findloop = lowbound% TO dataloop - 1 '*- To prevent repetitive calls to RTRIM\$ and VAL -*' tmplastname2\$ = RTRIM\$(Array(findloop).LASTNAME) tmpage2% = VAL(RTRIM\$(Array(findloop).AGE)) '*- Check whether this place is suitable for the data -*' IF tmplastname2\$ > tmplastname\$ THEN StillFits = 0 ELSEIF tmplastname2\$ = tmplastname\$ AND tmpage2% < tmpage% THEN StillFits = 0 END IF '*- If it's suitable insert the data here and stop the inner loop -*' IF NOT StillFits THEN ShiftDown Array(), findloop, dataloop EXIT FOR END IF NEXT findloop NEXT dataloop END SUB SUB ShiftDown (Array() AS Record, FromPlace AS INTEGER, ToPlace AS INTEGER) '+--------------------------------------------------------------+' '| SUB ShiftDown (Array() AS Record, FromPlace%, ToPlace%) |' '| |' '| This routine shifts a part of the record array down to make |' '| place for the data which is to be inserted at the beginning. |' '+--------------------------------------------------------------+' FOR shiftloop = ToPlace TO FromPlace + 1 STEP -1 SWAP Array(shiftloop), Array(shiftloop - 1) NEXT shiftloop END SUB[/syntax] Moneo Posting Freak Posts: 1,956 Threads: 65 Joined: Jun 2003 11-08-2004, 02:57 AM Neo, your solution is not what I was hinting at, but it does look interesting. Give me a few days to test it. ***** Neo Posting Freak Posts: 1,845 Threads: 44 Joined: Aug 2002 11-08-2004, 03:04 AM I must not have completely understood your hint. Anyway, the above code does what it should do, sorting on LASTNAME, and then on AGE... all in one run. Test it if you wish Thanks. Meg Senior Member Posts: 480 Threads: 24 Joined: Mar 2003 11-08-2004, 10:26 PM Here's my entry. This code performs a QuickSort on the data using LastName & (100-Age) as the sort key. NOTE: The QuickSort algorithm is largely not my own original code, I took an existing QuickSort algorithm and changed a few things in it. EDIT: I have changed a 100 to 99 in my code, as per Neo's suggestion in the thread below. I do not deserve the credit for this. *peace* Meg. [syntax="QBASIC"]DECLARE SUB QuickSort (SortArray() AS ANY, Low AS INTEGER, High AS INTEGER) CLS '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Record declaration as given by challenge. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ TYPE PersonType LastName AS STRING * 10 Age AS STRING * 2 SortKey AS STRING * 12 END TYPE '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'How many records of sample data are we reading? '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ MaxPeople% = 14 '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Pull the sample data into an array '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ DIM People(1 TO MaxPeople%) AS PersonType FOR i% = 1 TO MaxPeople% READ People(i%).LastName, People(i%).Age '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Since we want ages sorted in reverse order, subtract their age from 99 'Check for single and double digits to be safe. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ IF VAL(People(i%).Age) > 89 THEN SortAge\$ = "0" + LTRIM\$(RTRIM\$(STR\$(99 - VAL(People(i%).Age)))) ELSE SortAge\$ = LTRIM\$(RTRIM\$(STR\$(99 - VAL(People(i%).Age)))) END IF '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Create the sort key by concatenating Name and SortAge\$ '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ People(i%).SortKey = People(i%).LastName + SortAge\$ NEXT i% '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Perform a QuickSort on the array, using the SortKey as an index. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ QuickSort People(), 1, MaxPeople% '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Print the resulting array '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ FOR i% = 1 TO MaxPeople% PRINT People(i%).LastName; People(i%).Age NEXT i% SYSTEM '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Sample Data '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ DATA Williams, 7 DATA Baker, 45 DATA Williams, 12 DATA Adams, 10 DATA Dillon, 12 DATA Williams, 8 DATA "Bloom, Jr.", 18 DATA Connor, 50 DATA Albright, 12 DATA Connor, 1 DATA Williams, 8 DATA Dillon, 78 DATA Connor, 99 DATA Williams, 99 SUB QuickSort (SortArray() AS PersonType, Low AS INTEGER, High AS INTEGER) DIM Lower AS INTEGER DIM Higher AS INTEGER DIM RandIndex AS INTEGER DIM Partition AS STRING * 12 '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Quicksort selects a pivot point, putting smaller elements on one side and 'larger elements on the other. Then it calls itself recursively on each 'side. It repeats this until each subdivion contains at most 2 elements. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ IF Low < High THEN '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'At this point, only two elements remain in the subdivision. Sort 'them, and end the recursion line. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ IF High - Low = 1 THEN IF SortArray(Low).SortKey > SortArray(High).SortKey THEN SWAP SortArray(Low), SortArray(High) END IF ELSE '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Pick a random pivot '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ RandIndex = INT(RND * (High - Low + 1)) + Low SWAP SortArray(High), SortArray(RandIndex) Partition = SortArray(High).SortKey DO '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Move in from both sides towards the pivot '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ Lower = Low Higher = High DO WHILE (Lower < Higher) AND (SortArray(Lower).SortKey <= Partition) Lower = Lower + 1 LOOP DO WHILE (Higher > Lower) AND (SortArray(Higher).SortKey >= Partition) Higher = Higher - 1 LOOP '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'If we hit the pivot, the two elements on either side 'are out of order. Swap them. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ IF Lower < Higher THEN SWAP SortArray(Lower), SortArray(Higher) END IF LOOP WHILE Lower < Higher '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Move the pivot back to its proper place '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ SWAP SortArray(Lower), SortArray(High) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'Recursively call the sort, passing the smaller subdivision 'first to save stack space '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ IF (Lower - Low) < (High - Lower) THEN QuickSort SortArray(), Low, Lower - 1 QuickSort SortArray(), Lower + 1, High ELSE QuickSort SortArray(), Lower + 1, High QuickSort SortArray(), Low, Lower - 1 END IF END IF END IF END SUB[/syntax] Neo Posting Freak Posts: 1,845 Threads: 44 Joined: Aug 2002 11-08-2004, 10:43 PM Yeah, I had the same idea of 99 - Age right after I submitted my program. Oh well, I'll just stick to my existing entry Although, 99 - Age would have been better, because then you can simply sort ascending, then convert all ages to 99 - Age again. Anyway, I'm glad someone got the same idea ToohTooh Junior Member Posts: 24 Threads: 1 Joined: Jun 2004 11-08-2004, 11:16 PM Hello, Moneo. In the code below, I extended the challenge requirements to the following: * n different keys are to be sorted, * Sorting queries are custom-deep and customizable, * Record qualifiers are customizable. For the sake of clearity of my implementation (and future-extendibility), * I left out your 'formatted field' recommendations, and * Your 'one-pass' rule wasn't adhered to. Feel free to test and tangle, and please feedback.Code:```' *** '-- Moneo's Sorting Challenge. '-- Explore under QB IDE. ' *** '-- by ToohTooh, in Istanbul City. DEFINT A-Z DECLARE FUNCTION Sort (Record\$(), Query() AS ANY, RecLimit, QualifLimit, QryLimit) CONST NAM = 0, SURNAME = 1, AGE = 2  '>> Record qualifiers CONST ASCENDING = 0, DESCENDING = 1  '>> Sorting methods TYPE queryTAG  '>> Further info in Sort().     priority AS INTEGER     method AS INTEGER END TYPE DIM qry(1) AS queryTAG '-- Construct a sorting query structure. qry(0).priority = NAM      '>> First, sort NAM field ASCENDING, qry(0).method = ASCENDING qry(1).priority = SURNAME      '>> ...then, in the case of same NAMs, qry(1).method = DESCENDING     '    go and sort the AGE field DESCENDING. '-- You may extend qry() further as number of qualifier strings permit. '-- Further rec() structure info in Sort(). DIM rec\$(9, 2)  '>> rec\$( i, z : z={NAM, SURNAME, AGE} ) '-- Build a fictitious kindergarten list (some are too old!). '    The only odd thing about this structure is that everything is STRING. rec\$(0, NAM) = "KEREM": rec\$(0, SURNAME) = "BERKERLER": rec\$(0, AGE) = "2" rec\$(1, NAM) = "GONEN": rec\$(1, SURNAME) = "GENC": rec\$(1, AGE) = "5" rec\$(2, NAM) = "AKGUN": rec\$(2, SURNAME) = "AKOVA": rec\$(2, AGE) = "7" rec\$(3, NAM) = "CAN": rec\$(3, SURNAME) = "TURKER": rec\$(3, AGE) = "6" rec\$(4, NAM) = "SARP": rec\$(4, SURNAME) = "TAN": rec\$(4, AGE) = "3" rec\$(5, NAM) = "KEREM": rec\$(5, SURNAME) = "AYAN": rec\$(5, AGE) = "5" rec\$(6, NAM) = "BERK": rec\$(6, SURNAME) = "SARI": rec\$(6, AGE) = "2" rec\$(7, NAM) = "CAN": rec\$(7, SURNAME) = "ALP": rec\$(7, AGE) = "6" rec\$(8, NAM) = "TUNA": rec\$(8, SURNAME) = "KON": rec\$(8, AGE) = "4" rec\$(9, NAM) = "CAN": rec\$(9, SURNAME) = "YENI": rec\$(9, AGE) = "4" result = Sort(rec\$(), qry(), UBOUND(rec\$), UBOUND(rec\$, 2), UBOUND(qry)) CLS FOR i = 0 TO 9     PRINT rec\$(i, NAM), rec\$(i, SURNAME), rec\$(i, AGE) NEXT i FUNCTION Sort (Record\$(), Query() AS queryTAG, RecLimit, QualifLimit, QryLimit) '-- Based on the simple bubble sort of Microsoft Corporation. '    For the original version, see the BubbleSort() of SORTDEMO.bas. '-- Heavily modified by ToohTooh for the challenge. '-- Definitions and examples -- '-- Record\$(r, q) is an array which has *two* subscripts: '        r: record index '        q: qualifier depth index. '   DIM Record\$(9, 2) tells us that "there will be 10 (0..9) elements which '    all have 3 (0..2) different qualifiers." '-- Query(i) is a type which has *two* fields: query(i).priority, and '    query(i).method. '        Query(0).priority = MARK      -+  First, sort students descending by '        Query(0).method = DESCENDING   |_  their MARKs. If some happen to get '        Query(1).priority = AGE        |   the same marks, then sort those '        Query(1).method = ASCENDING   -+   ascending by their AGEs. '                                          LOGIC: If some older and younger '                                       students get the same mark, younger '                                     ones are said to be more successful. DO     Switch = 0     FOR currentRec = 0 TO (RecLimit - 1)                                     '--Modification begins         FOR nestQuery = 0 TO QryLimit             priorityField = Query(nestQuery).priority             element\$ = Record\$(currentRec, priorityField)             successor\$ = Record\$(currentRec + 1, priorityField)             '-- If two adjacent elements are equal, then continue FOR..NEXT to             '    deepen the nestQuery to sort them using a different qualifier.             IF (element\$ = successor\$) THEN GOTO Continue             '-- First switch to the appropriate sorting logic, and then see if             '    a sorting is to be done. Do so, if necessary.             SELECT CASE Query(nestQuery).method             CASE ASCENDING                 IF element\$ > successor\$ THEN                     GOSUB DoSwap                     Switch = currentRec                 END IF             CASE DESCENDING                 IF element\$ < successor\$ THEN                     GOSUB DoSwap                     Switch = currentRec                 END IF             END SELECT             '-- Sorting was either done, or was not necessary.             '    Done with the current query pass.             EXIT FOR  '>> ...to enter currentRec Continue:         NEXT nestQuery                                     '--Modification ends     NEXT currentRec     '-- Sort on next pass only to where the last switch was made.     RecLimit = Switch LOOP WHILE Switch Sort = -1  '>> Sort() default. EXIT FUNCTION DoSwap:  '>> Added to Microsoft code by ToohTooh. FOR i = 0 TO QualifLimit     '-- Swap all fields of record\$.     SWAP Record\$(currentRec, i), Record\$(currentRec + 1, i) NEXT RETURN END FUNCTION  '>> Sort()``` Don't interrupt me while I'm interrupting." - Winston S. Churchill Meg Senior Member Posts: 480 Threads: 24 Joined: Mar 2003 11-09-2004, 12:03 AM Quote:Although, 99 - Age would have been better, because then you can simply sort ascending, then convert all ages to 99 - Age again. True. 99-Age would have been better than 100-Age, since Moneo did not specify that Age 0 was off-limits. Subtracting Age 0 from 100 would leave 100 which is more than two digits, and hence out-of-bounds. Good catch, Neo! I've edited my submission and given you credit for the change. *peace* Meg. Neo Posting Freak Posts: 1,845 Threads: 44 Joined: Aug 2002 11-09-2004, 12:21 AM Ah, Meg. It wasn't that big code improvement Thanks for the credit though Hmn, I think I still have to study on QuickSort... Oh, and... *peace* Meg Senior Member Posts: 480 Threads: 24 Joined: Mar 2003 11-09-2004, 01:06 AM Well, see, I have to work hard to not come across as an overly-competitive psychopath. Really, the way I see it, even though these problems are posed as mini-competitions, ultimately we all benefit from working together towards a better solution. And in that regard, it's always nice to give credit where it's due. ::stabs the competition in their sleep:: Um.. I mean.. er.. pancakes. *peace* Meg. « Next Oldest | Next Newest »