Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Sorting 2 variables: one ascending, one descending
#7
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
Reply


Messages In This Thread
My Submission - by Meg - 11-08-2004, 10:26 PM
Hey!.. - by ToohTooh - 11-08-2004, 11:16 PM
Now this is serious. - by ToohTooh - 11-10-2004, 07:13 PM

Forum Jump:


Users browsing this thread: 2 Guest(s)